ghc-lib-parser 0.20210801 → 0.20210901
raw patch · 112 files changed
+6707/−4718 lines, 112 files
Files
- compiler/Bytecodes.h +109/−0
- compiler/ClosureTypes.h +86/−0
- compiler/CodeGen.Platform.h +1259/−0
- compiler/FunTypes.h +54/−0
- compiler/GHC/Builtin/Names.hs +26/−25
- compiler/GHC/Builtin/PrimOps.hs +22/−10
- compiler/GHC/Cmm/CLabel.hs +3/−3
- compiler/GHC/Core/Coercion.hs +50/−437
- compiler/GHC/Core/DataCon.hs +2/−2
- compiler/GHC/Core/FamInstEnv.hs +94/−104
- compiler/GHC/Core/Lint.hs +20/−14
- compiler/GHC/Core/Opt/Arity.hs +1/−1
- compiler/GHC/Core/Opt/ConstantFold.hs +312/−112
- compiler/GHC/Core/Reduction.hs +892/−0
- compiler/GHC/Core/Rules.hs +55/−48
- compiler/GHC/Core/SimpleOpt.hs +4/−3
- compiler/GHC/Core/Subst.hs +51/−32
- compiler/GHC/Core/TyCo/Rep.hs-boot +1/−0
- compiler/GHC/Core/TyCo/Subst.hs +16/−16
- compiler/GHC/Core/Unfold.hs +4/−4
- compiler/GHC/Core/Utils.hs +3/−2
- compiler/GHC/Data/Graph/Directed.hs +21/−2
- compiler/GHC/Driver/Env.hs +49/−35
- compiler/GHC/Driver/Env/KnotVars.hs +71/−0
- compiler/GHC/Driver/Env/Types.hs +2/−2
- compiler/GHC/Driver/Monad.hs +3/−3
- compiler/GHC/Driver/Session.hs +8/−8
- compiler/GHC/Hs/Binds.hs +5/−5
- compiler/GHC/Hs/Decls.hs +8/−5
- compiler/GHC/Hs/Expr.hs +18/−14
- compiler/GHC/Hs/Instances.hs +5/−0
- compiler/GHC/Hs/Lit.hs +42/−11
- compiler/GHC/Hs/Type.hs +1/−0
- compiler/GHC/Hs/Utils.hs +8/−8
- compiler/GHC/HsToCore/Errors/Ppr.hs +3/−1
- compiler/GHC/HsToCore/Errors/Types.hs +1/−0
- compiler/GHC/Parser/PostProcess.hs +3/−3
- compiler/GHC/Platform.hs +1/−1
- compiler/GHC/Platform/AArch64.hs +1/−1
- compiler/GHC/Platform/ARM.hs +1/−1
- compiler/GHC/Platform/NoRegs.hs +1/−1
- compiler/GHC/Platform/PPC.hs +1/−1
- compiler/GHC/Platform/RISCV64.hs +1/−1
- compiler/GHC/Platform/S390X.hs +1/−1
- compiler/GHC/Platform/SPARC.hs +1/−1
- compiler/GHC/Platform/X86.hs +1/−1
- compiler/GHC/Platform/X86_64.hs +1/−1
- compiler/GHC/Runtime/Heap/Layout.hs +3/−3
- compiler/GHC/Settings.hs +0/−4
- compiler/GHC/SysTools/BaseDir.hs +2/−2
- compiler/GHC/Tc/Errors/Ppr.hs +138/−0
- compiler/GHC/Tc/Errors/Types.hs +189/−1
- compiler/GHC/Tc/Solver/InertSet.hs +3/−3
- compiler/GHC/Tc/Types.hs +167/−57
- compiler/GHC/Tc/Types.hs-boot +4/−0
- compiler/GHC/Tc/Types/Constraint.hs +40/−11
- compiler/GHC/Tc/Types/Evidence.hs +21/−0
- compiler/GHC/Types/Basic.hs +75/−30
- compiler/GHC/Types/Hint.hs +4/−0
- compiler/GHC/Types/Hint/Ppr.hs +6/−0
- compiler/GHC/Types/Id/Make.hs +7/−5
- compiler/GHC/Types/Literal.hs +29/−13
- compiler/GHC/Types/Unique/DFM.hs +0/−8
- compiler/GHC/Types/Unique/DSet.hs +1/−3
- compiler/GHC/Types/Unique/FM.hs +10/−0
- compiler/GHC/Types/Var.hs-boot +1/−0
- compiler/GHC/Types/Var/Env.hs +5/−5
- compiler/GHC/Unit/Home/ModInfo.hs +15/−0
- compiler/GHC/Unit/Module/Deps.hs +21/−7
- compiler/GHC/Unit/Module/Graph.hs +5/−1
- compiler/GHC/Unit/Module/ModGuts.hs +3/−1
- compiler/GHC/Unit/Module/ModSummary.hs +0/−4
- compiler/GHC/Unit/State.hs +1/−0
- compiler/GHC/Unit/Types.hs +3/−0
- compiler/GHC/Unit/Types.hs-boot +6/−4
- compiler/GHC/Utils/Binary.hs +6/−0
- compiler/GHC/Utils/Binary/Typeable.hs +3/−20
- compiler/GHC/Utils/Logger.hs +1/−1
- compiler/Language/Haskell/Syntax/Binds.hs +18/−5
- compiler/Language/Haskell/Syntax/Expr.hs +64/−43
- compiler/Language/Haskell/Syntax/Lit.hs +5/−24
- compiler/Language/Haskell/Syntax/Type.hs +0/−4
- compiler/MachDeps.h +119/−0
- compiler/MachRegs.h +854/−0
- ghc-lib-parser.cabal +11/−6
- ghc-lib/stage0/compiler/build/GHC/Parser.hs +3/−3
- ghc-lib/stage0/compiler/build/GHC/Parser/Lexer.hs +7/−6
- ghc-lib/stage0/compiler/build/primop-can-fail.hs-incl +14/−0
- ghc-lib/stage0/compiler/build/primop-code-size.hs-incl +2/−0
- ghc-lib/stage0/compiler/build/primop-commutable.hs-incl +7/−0
- ghc-lib/stage0/compiler/build/primop-data-decl.hs-incl +46/−0
- ghc-lib/stage0/compiler/build/primop-docs.hs-incl +8/−0
- ghc-lib/stage0/compiler/build/primop-has-side-effects.hs-incl +8/−0
- ghc-lib/stage0/compiler/build/primop-list.hs-incl +46/−0
- ghc-lib/stage0/compiler/build/primop-primop-info.hs-incl +46/−0
- ghc-lib/stage0/compiler/build/primop-tag.hs-incl +1322/−1276
- ghc-lib/stage0/lib/ghcautoconf.h +3/−0
- ghc-lib/stage0/libraries/ghc-boot/build/GHC/Version.hs +4/−4
- includes/CodeGen.Platform.hs +0/−1259
- includes/MachDeps.h +0/−119
- includes/ghcconfig.h +0/−4
- includes/stg/MachRegs.h +0/−854
- libraries/ghc-heap/GHC/Exts/Heap/ClosureTypes.hs +1/−1
- libraries/ghc-heap/GHC/Exts/Heap/Closures.hs +1/−1
- libraries/ghc-heap/GHC/Exts/Heap/InfoTable/Types.hsc +1/−1
- libraries/ghc-heap/GHC/Exts/Heap/ProfInfo/Types.hs +4/−4
- libraries/ghci/GHCi/Message.hs +1/−1
- libraries/template-haskell/Language/Haskell/TH/Lib.hs +1/−0
- libraries/template-haskell/Language/Haskell/TH/Lib/Internal.hs +8/−0
- libraries/template-haskell/Language/Haskell/TH/Ppr.hs +2/−0
- libraries/template-haskell/Language/Haskell/TH/Syntax.hs +6/−0
- rts/include/ghcconfig.h +4/−0
+ 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.hs view
@@ -322,6 +322,7 @@ -- Strings and lists unpackCStringName, unpackCStringUtf8Name,+ unpackCStringAppendName, unpackCStringAppendUtf8Name, unpackCStringFoldrName, unpackCStringFoldrUtf8Name, cstringLengthName, @@ -752,14 +753,6 @@ ioDataCon_RDR :: RdrName ioDataCon_RDR = nameRdrName ioDataConName -eqString_RDR, unpackCString_RDR, unpackCStringFoldr_RDR,- unpackCStringFoldrUtf8_RDR, unpackCStringUtf8_RDR :: RdrName-eqString_RDR = nameRdrName eqStringName-unpackCString_RDR = nameRdrName unpackCStringName-unpackCStringFoldr_RDR = nameRdrName unpackCStringFoldrName-unpackCStringUtf8_RDR = nameRdrName unpackCStringUtf8Name-unpackCStringFoldrUtf8_RDR = nameRdrName unpackCStringFoldrUtf8Name- newStablePtr_RDR :: RdrName newStablePtr_RDR = nameRdrName newStablePtrName @@ -1049,14 +1042,20 @@ -- Base strings Strings unpackCStringName, unpackCStringFoldrName, unpackCStringUtf8Name, unpackCStringFoldrUtf8Name,+ unpackCStringAppendName, unpackCStringAppendUtf8Name, eqStringName, cstringLengthName :: Name-unpackCStringName = varQual gHC_CSTRING (fsLit "unpackCString#") unpackCStringIdKey-unpackCStringFoldrName = varQual gHC_CSTRING (fsLit "unpackFoldrCString#") unpackCStringFoldrIdKey-unpackCStringUtf8Name = varQual gHC_CSTRING (fsLit "unpackCStringUtf8#") unpackCStringUtf8IdKey cstringLengthName = varQual gHC_CSTRING (fsLit "cstringLength#") cstringLengthIdKey eqStringName = varQual gHC_BASE (fsLit "eqString") eqStringIdKey++unpackCStringName = varQual gHC_CSTRING (fsLit "unpackCString#") unpackCStringIdKey+unpackCStringAppendName = varQual gHC_CSTRING (fsLit "unpackAppendCString#") unpackCStringAppendIdKey+unpackCStringFoldrName = varQual gHC_CSTRING (fsLit "unpackFoldrCString#") unpackCStringFoldrIdKey++unpackCStringUtf8Name = varQual gHC_CSTRING (fsLit "unpackCStringUtf8#") unpackCStringUtf8IdKey+unpackCStringAppendUtf8Name = varQual gHC_CSTRING (fsLit "unpackAppendCStringUtf8#") unpackCStringAppendUtf8IdKey unpackCStringFoldrUtf8Name = varQual gHC_CSTRING (fsLit "unpackFoldrCStringUtf8#") unpackCStringFoldrUtf8IdKey + -- The 'inline' function inlineIdName :: Name inlineIdName = varQual gHC_MAGIC (fsLit "inline") inlineIdKey@@ -2272,9 +2271,8 @@ noMethodBindingErrorIdKey, nonExhaustiveGuardsErrorIdKey, runtimeErrorIdKey, patErrorIdKey, voidPrimIdKey, realWorldPrimIdKey, recConErrorIdKey,- unpackCStringUtf8IdKey, unpackCStringAppendIdKey,- unpackCStringFoldrIdKey, unpackCStringFoldrUtf8IdKey,- unpackCStringIdKey,+ unpackCStringUtf8IdKey, unpackCStringAppendUtf8IdKey, unpackCStringFoldrUtf8IdKey,+ unpackCStringIdKey, unpackCStringAppendIdKey, unpackCStringFoldrIdKey, typeErrorIdKey, divIntIdKey, modIntIdKey, absentSumFieldErrorIdKey, cstringLengthIdKey, raiseOverflowIdKey, raiseUnderflowIdKey, raiseDivZeroIdKey@@ -2296,20 +2294,23 @@ patErrorIdKey = mkPreludeMiscIdUnique 14 realWorldPrimIdKey = mkPreludeMiscIdUnique 15 recConErrorIdKey = mkPreludeMiscIdUnique 16+ unpackCStringUtf8IdKey = mkPreludeMiscIdUnique 17-unpackCStringAppendIdKey = mkPreludeMiscIdUnique 18-unpackCStringFoldrIdKey = mkPreludeMiscIdUnique 19+unpackCStringAppendUtf8IdKey = mkPreludeMiscIdUnique 18+unpackCStringFoldrUtf8IdKey = mkPreludeMiscIdUnique 19 unpackCStringIdKey = mkPreludeMiscIdUnique 20-unpackCStringFoldrUtf8IdKey = mkPreludeMiscIdUnique 21-voidPrimIdKey = mkPreludeMiscIdUnique 22-typeErrorIdKey = mkPreludeMiscIdUnique 23-divIntIdKey = mkPreludeMiscIdUnique 24-modIntIdKey = mkPreludeMiscIdUnique 25-cstringLengthIdKey = mkPreludeMiscIdUnique 26-raiseOverflowIdKey = mkPreludeMiscIdUnique 27-raiseUnderflowIdKey = mkPreludeMiscIdUnique 28-raiseDivZeroIdKey = mkPreludeMiscIdUnique 29+unpackCStringAppendIdKey = mkPreludeMiscIdUnique 21+unpackCStringFoldrIdKey = mkPreludeMiscIdUnique 22++voidPrimIdKey = mkPreludeMiscIdUnique 23+typeErrorIdKey = mkPreludeMiscIdUnique 24+divIntIdKey = mkPreludeMiscIdUnique 25+modIntIdKey = mkPreludeMiscIdUnique 26+cstringLengthIdKey = mkPreludeMiscIdUnique 27+raiseOverflowIdKey = mkPreludeMiscIdUnique 28+raiseUnderflowIdKey = mkPreludeMiscIdUnique 29+raiseDivZeroIdKey = mkPreludeMiscIdUnique 30 concatIdKey, filterIdKey, zipIdKey, bindIOIdKey, returnIOIdKey, newStablePtrIdKey,
compiler/GHC/Builtin/PrimOps.hs view
@@ -331,16 +331,18 @@ some effect that is not captured entirely by its result value. ---------- has_side_effects ----------------------A primop "has_side_effects" if it has some *write* effect, visible-elsewhere- - writing to the world (I/O)- - writing to a mutable data structure (writeIORef)+A primop "has_side_effects" if it has some side effect, visible+elsewhere, apart from the result it returns+ - reading or writing to the world (I/O)+ - reading or writing to a mutable data structure (writeIORef) - throwing a synchronous Haskell exception Often such primops have a type like State -> input -> (State, output)-so the state token guarantees ordering. In general we rely *only* on-data dependencies of the state token to enforce write-effect ordering+so the state token guarantees ordering. In general we rely on+data dependencies of the state token to enforce write-effect ordering,+but as the notes below make clear, the matter is a bit more complicated+than that. * NB1: if you inline unsafePerformIO, you may end up with side-effecting ops whose 'state' output is discarded.@@ -353,10 +355,20 @@ "can_fail". We must be careful about not discarding such things; see the paper "A semantics for imprecise exceptions". - * NB3: *Read* effects (like reading an IORef) don't count here,- because it doesn't matter if we don't do them, or do them more than- once. *Sequencing* is maintained by the data dependency of the state- token.+ * NB3: *Read* effects on *mutable* cells (like reading an IORef or a+ MutableArray#) /are/ included. You may find this surprising because it+ doesn't matter if we don't do them, or do them more than once. *Sequencing*+ is maintained by the data dependency of the state token. But see+ "Duplication" below under+ Note [Transformations affected by can_fail and has_side_effects]++ Note that read operations on *immutable* values (like indexArray#) do not+ have has_side_effects. (They might be marked can_fail, however, because+ you might index out of bounds.)++ Using has_side_effects in this way is a bit of a blunt instrument. We could+ be more refined by splitting read and write effects (see comments with #3207+ and #20195) ---------- can_fail ---------------------------- A primop "can_fail" if it can fail with an *unchecked* exception on
compiler/GHC/Cmm/CLabel.hs view
@@ -307,7 +307,7 @@ -- label (e.g. "extern StgWordArray(foo)"). The type is fixed to StgWordArray. -- -- Symbols from the RTS don't need "extern" declarations because they are--- exposed via "includes/Stg.h" with the appropriate type. See 'needsCDecl'.+-- exposed via "rts/include/Stg.h" with the appropriate type. See 'needsCDecl'. -- -- The fixed StgWordArray type led to "conflicting types" issues with user -- provided Cmm files (not in the RTS) that declare data of another type (#15467@@ -659,7 +659,7 @@ mkRtsCmmDataLabel str = CmmLabel rtsUnitId (NeedExternDecl False) str CmmData -- RTS symbols don't need "GHC.CmmToC" to -- generate \"extern\" declaration (they are- -- exposed via includes/Stg.h)+ -- exposed via rts/include/Stg.h) mkLocalBlockLabel :: Unique -> CLabel mkLocalBlockLabel u = LocalBlockLabel u@@ -935,7 +935,7 @@ | not external = False -- Prototypes for labels defined in the runtime system are imported- -- into HC files via includes/Stg.h.+ -- into HC files via rts/include/Stg.h. | pkgId == rtsUnitId = False -- For other labels we inline one into the HC file directly.
compiler/GHC/Core/Coercion.hs view
@@ -122,8 +122,6 @@ multToCo, - simplifyArgsWorker,- hasCoercionHoleTy, hasCoercionHoleCo, HoleSet, coercionHolesOfType, coercionHolesOfCo ) where@@ -1069,7 +1067,7 @@ | isReflCo co2 = co1 mkTransCo (GRefl r t1 (MCo co1)) (GRefl _ _ (MCo co2)) = GRefl r t1 (MCo $ mkTransCo co1 co2)-mkTransCo co1 co2 = TransCo co1 co2+mkTransCo co1 co2 = TransCo co1 co2 mkNthCo :: HasDebugCallStack => Role -- The role of the coercion you're creating@@ -1323,7 +1321,7 @@ -- | Make a "coercion between coercions". mkProofIrrelCo :: Role -- ^ role of the created coercion, "r"- -> Coercion -- ^ :: phi1 ~N phi2+ -> CoercionN -- ^ :: phi1 ~N phi2 -> Coercion -- ^ g1 :: phi1 -> Coercion -- ^ g2 :: phi2 -> Coercion -- ^ :: g1 ~r g2@@ -1790,7 +1788,8 @@ -- then ty ~ev1~ t1 ~ev2~ t2 ... ~evn~ ty' -- and ev = ev1 `plus` ev2 `plus` ... `plus` evn -- If it returns Nothing then no newtype unwrapping could happen-topNormaliseTypeX :: NormaliseStepper ev -> (ev -> ev -> ev)+topNormaliseTypeX :: NormaliseStepper ev+ -> (ev -> ev -> ev) -> Type -> Maybe (ev, Type) topNormaliseTypeX stepper plus ty | Just (tc, tys) <- splitTyConApp_maybe ty@@ -2114,12 +2113,21 @@ {- Note [liftCoSubstVarBndr] callback:- We want 'liftCoSubstVarBndrUsing' to be general enough to be reused in- FamInstEnv, therefore the input arg 'fun' returns a pair with polymorphic type- in snd.- However in 'liftCoSubstVarBndr', we don't need the snd, so we use unit and- ignore the fourth component of the return value.+ 'liftCoSubstVarBndrUsing' needs to be general enough to work in two+ situations: + - in this module, which manipulates 'Coercion's, and+ - in GHC.Core.FamInstEnv, where we work with 'Reduction's, which contain+ a coercion as well as a type.++ To achieve this, we require that the return type of the 'callback' function+ contain a coercion within it. This is witnessed by the first argument+ to 'liftCoSubstVarBndrUsing': a getter, which allows us to retrieve+ the coercion inside the return type. Thus:++ - in this module, we simply pass 'id' as the getter,+ - in GHC.Core.FamInstEnv, we pass 'reductionCoercion' as the getter.+ liftCoSubstTyVarBndrUsing: Given forall tv:k. t@@ -2152,52 +2160,56 @@ liftCoSubstVarBndr :: LiftingContext -> TyCoVar -> (LiftingContext, TyCoVar, Coercion) liftCoSubstVarBndr lc tv- = let (lc', tv', h, _) = liftCoSubstVarBndrUsing callback lc tv in- (lc', tv', h)+ = liftCoSubstVarBndrUsing id callback lc tv where- callback lc' ty' = (ty_co_subst lc' Nominal ty', ())+ callback lc' ty' = ty_co_subst lc' Nominal ty' -- the callback must produce a nominal coercion-liftCoSubstVarBndrUsing :: (LiftingContext -> Type -> (CoercionN, a))- -> LiftingContext -> TyCoVar- -> (LiftingContext, TyCoVar, CoercionN, a)-liftCoSubstVarBndrUsing fun lc old_var+liftCoSubstVarBndrUsing :: (r -> CoercionN) -- ^ coercion getter+ -> (LiftingContext -> Type -> r) -- ^ callback+ -> LiftingContext -> TyCoVar+ -> (LiftingContext, TyCoVar, r)+liftCoSubstVarBndrUsing view_co fun lc old_var | isTyVar old_var- = liftCoSubstTyVarBndrUsing fun lc old_var+ = liftCoSubstTyVarBndrUsing view_co fun lc old_var | otherwise- = liftCoSubstCoVarBndrUsing fun lc old_var+ = liftCoSubstCoVarBndrUsing view_co fun lc old_var -- Works for tyvar binder-liftCoSubstTyVarBndrUsing :: (LiftingContext -> Type -> (CoercionN, a))- -> LiftingContext -> TyVar- -> (LiftingContext, TyVar, CoercionN, a)-liftCoSubstTyVarBndrUsing fun lc@(LC subst cenv) old_var+liftCoSubstTyVarBndrUsing :: (r -> CoercionN) -- ^ coercion getter+ -> (LiftingContext -> Type -> r) -- ^ callback+ -> LiftingContext -> TyVar+ -> (LiftingContext, TyVar, r)+liftCoSubstTyVarBndrUsing view_co fun lc@(LC subst cenv) old_var = assert (isTyVar old_var) $ ( LC (subst `extendTCvInScope` new_var) new_cenv- , new_var, eta, stuff )+ , new_var, stuff ) where- old_kind = tyVarKind old_var- (eta, stuff) = fun lc old_kind- k1 = coercionLKind eta- new_var = uniqAway (getTCvInScope subst) (setVarType old_var k1)+ old_kind = tyVarKind old_var+ stuff = fun lc old_kind+ eta = view_co stuff+ k1 = coercionLKind eta+ new_var = uniqAway (getTCvInScope subst) (setVarType old_var k1) lifted = mkGReflRightCo Nominal (TyVarTy new_var) eta -- :: new_var ~ new_var |> eta new_cenv = extendVarEnv cenv old_var lifted -- Works for covar binder-liftCoSubstCoVarBndrUsing :: (LiftingContext -> Type -> (CoercionN, a))- -> LiftingContext -> CoVar- -> (LiftingContext, CoVar, CoercionN, a)-liftCoSubstCoVarBndrUsing fun lc@(LC subst cenv) old_var+liftCoSubstCoVarBndrUsing :: (r -> CoercionN) -- ^ coercion getter+ -> (LiftingContext -> Type -> r) -- ^ callback+ -> LiftingContext -> CoVar+ -> (LiftingContext, CoVar, r)+liftCoSubstCoVarBndrUsing view_co fun lc@(LC subst cenv) old_var = assert (isCoVar old_var) $ ( LC (subst `extendTCvInScope` new_var) new_cenv- , new_var, kind_co, stuff )+ , new_var, stuff ) where- old_kind = coVarKind old_var- (eta, stuff) = fun lc old_kind- k1 = coercionLKind eta- new_var = uniqAway (getTCvInScope subst) (setVarType old_var k1)+ old_kind = coVarKind old_var+ stuff = fun lc old_kind+ eta = view_co stuff+ k1 = coercionLKind eta+ new_var = uniqAway (getTCvInScope subst) (setVarType old_var k1) -- old_var :: s1 ~r s2 -- eta :: (s1' ~r s2') ~N (t1 ~r t2)@@ -2205,7 +2217,6 @@ -- eta2 :: s2' ~r t2 -- co1 :: s1' ~r s2' -- co2 :: t1 ~r t2- -- kind_co :: (s1' ~r s2') ~N (t1 ~r t2) -- lifted :: co1 ~N co2 role = coVarRole old_var@@ -2215,10 +2226,7 @@ co1 = mkCoVarCo new_var co2 = mkSymCo eta1 `mkTransCo` co1 `mkTransCo` eta2- kind_co = mkTyConAppCo Nominal (equalityTyCon role)- [ mkKindCo co1, mkKindCo co2- , co1 , co2 ]- lifted = mkProofIrrelCo Nominal kind_co co1 co2+ lifted = mkProofIrrelCo Nominal eta co1 co2 new_cenv = extendVarEnv cenv old_var lifted @@ -2697,401 +2705,6 @@ = pprPanic "buildKindCoercion" (vcat [ ppr orig_ty1, ppr orig_ty2 , ppr ty1, ppr ty2 ]) -{--%************************************************************************-%* *- Simplifying types-%* *-%************************************************************************--The function below morally belongs in GHC.Tc.Solver.Rewrite, but it is used also in-FamInstEnv, and so lives here.--Note [simplifyArgsWorker]-~~~~~~~~~~~~~~~~~~~~~~~~~-Invariant (F2) of Note [Rewriting] in GHC.Tc.Solver.Rewrite says that-rewriting is homogeneous.-This causes some trouble when rewriting a function applied to a telescope-of arguments, perhaps with dependency. For example, suppose-- type family F :: forall (j :: Type) (k :: Type). Maybe j -> Either j k -> Bool -> [k]--and we wish to rewrite the args of (with kind applications explicit)-- F a b (Just a c) (Right a b d) False--where all variables are skolems and-- a :: Type- b :: Type- c :: a- d :: k-- [G] aco :: a ~ fa- [G] bco :: b ~ fb- [G] cco :: c ~ fc- [G] dco :: d ~ fd--The first step is to rewrite all the arguments. This is done before calling-simplifyArgsWorker. We start from-- a- b- Just a c- Right a b d- False--and get-- (fa, co1 :: fa ~ a)- (fb, co2 :: fb ~ b)- (Just fa (fc |> aco) |> co6, co3 :: (Just fa (fc |> aco) |> co6) ~ (Just a c))- (Right fa fb (fd |> bco) |> co7, co4 :: (Right fa fb (fd |> bco) |> co7) ~ (Right a b d))- (False, co5 :: False ~ False)--where- co6 :: Maybe fa ~ Maybe a- co7 :: Either fa fb ~ Either a b--We now process the rewritten args in left-to-right order. The first two args-need no further processing. But now consider the third argument. Let f3 = the rewritten-result, Just fa (fc |> aco) |> co6.-This f3 rewritten argument has kind (Maybe a), due to-(F2). And yet, when we build the application (F fa fb ...), we need this-argument to have kind (Maybe fa), not (Maybe a). We must cast this argument.-The coercion to use is-determined by the kind of F: we see in F's kind that the third argument has-kind Maybe j. Critically, we also know that the argument corresponding to j-(in our example, a) rewrote with a coercion co1. We can thus know the-coercion needed for the 3rd argument is (Maybe (sym co1)), thus building-(f3 |> Maybe (sym co1))--More generally, we must use the Lifting Lemma, as implemented in-Coercion.liftCoSubst. As we work left-to-right, any variable that is a-dependent parameter (j and k, in our example) gets mapped in a lifting context-to the coercion that is output from rewriting the corresponding argument (co1-and co2, in our example). Then, after rewriting later arguments, we lift the-kind of these arguments in the lifting context that we've be building up.-This coercion is then used to keep the result of rewriting well-kinded.--Working through our example, this is what happens:-- 1. Extend the (empty) LC with [j |-> co1]. No new casting must be done,- because the binder associated with the first argument has a closed type (no- variables).-- 2. Extend the LC with [k |-> co2]. No casting to do.-- 3. Lifting the kind (Maybe j) with our LC- yields co8 :: Maybe fa ~ Maybe a. Use (f3 |> sym co8) as the argument to- F.-- 4. Lifting the kind (Either j k) with our LC- yields co9 :: Either fa fb ~ Either a b. Use (f4 |> sym co9) as the 4th- argument to F, where f4 is the rewritten form of argument 4, written above.-- 5. We lift Bool with our LC, getting <Bool>;- casting has no effect.--We're now almost done, but the new application (F fa fb (f3 |> sym co8) (f4 > sym co9) False)-has the wrong kind. Its kind is [fb], instead of the original [b].-So we must use our LC one last time to lift the result kind [k],-getting res_co :: [fb] ~ [b], and we cast our result.--Accordingly, the final result is-- F fa fb (Just fa (fc |> aco) |> Maybe (sym aco) |> sym (Maybe (sym aco)))- (Right fa fb (fd |> bco) |> Either (sym aco) (sym bco) |> sym (Either (sym aco) (sym bco)))- False- |> [sym bco]--The res_co (in this case, [sym bco])-is returned as the third return value from simplifyArgsWorker.--Note [Last case in simplifyArgsWorker]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-In writing simplifyArgsWorker's `go`, we know here that args cannot be empty,-because that case is first. We've run out of-binders. But perhaps inner_ki is a tyvar that has been instantiated with a-Π-type.--Here is an example.-- a :: forall (k :: Type). k -> k- type family Star- Proxy :: forall j. j -> Type- axStar :: Star ~ Type- type family NoWay :: Bool- axNoWay :: NoWay ~ False- bo :: Type- [G] bc :: bo ~ Bool (in inert set)-- co :: (forall j. j -> Type) ~ (forall (j :: Star). (j |> axStar) -> Star)- co = forall (j :: sym axStar). (<j> -> sym axStar)-- We are rewriting:- a (forall (j :: Star). (j |> axStar) -> Star) -- 1- (Proxy |> co) -- 2- (bo |> sym axStar) -- 3- (NoWay |> sym bc) -- 4- :: Star--First, we rewrite all the arguments (before simplifyArgsWorker), like so:-- (forall j. j -> Type, co1 :: (forall j. j -> Type) ~- (forall (j :: Star). (j |> axStar) -> Star)) -- 1- (Proxy |> co, co2 :: (Proxy |> co) ~ (Proxy |> co)) -- 2- (Bool |> sym axStar, co3 :: (Bool |> sym axStar) ~ (bo |> sym axStar)) -- 3- (False |> sym bc, co4 :: (False |> sym bc) ~ (NoWay |> sym bc)) -- 4--Then we do the process described in Note [simplifyArgsWorker].--1. Lifting Type (the kind of the first arg) gives us a reflexive coercion, so we- don't use it. But we do build a lifting context [k -> co1] (where co1 is a- result of rewriting an argument, written above).--2. Lifting k gives us co1, so the second argument becomes (Proxy |> co |> sym co1).- This is not a dependent argument, so we don't extend the lifting context.--Now we need to deal with argument (3).-The way we normally proceed is to lift the kind of the binder, to see whether-it's dependent.-But here, the remainder of the kind of `a` that we're left with-after processing two arguments is just `k`.--The way forward is look up k in the lifting context, getting co1. If we're at-all well-typed, co1 will be a coercion between Π-types, with at least one binder.-So, let's-decompose co1 with decomposePiCos. This decomposition needs arguments to use-to instantiate any kind parameters. Look at the type of co1. If we just-decomposed it, we would end up with coercions whose types include j, which is-out of scope here. Accordingly, decomposePiCos takes a list of types whose-kinds are the *right-hand* types in the decomposed coercion. (See comments on-decomposePiCos.) Because the rewritten types have unrewritten kinds (because-rewriting is homogeneous), passing the list of rewritten types to decomposePiCos-just won't do: later arguments' kinds won't be as expected. So we need to get-the *unrewritten* types to pass to decomposePiCos. We can do this easily enough-by taking the kind of the argument coercions, passed in originally.--(Alternative 1: We could re-engineer decomposePiCos to deal with this situation.-But that function is already gnarly, and taking the right-hand types is correct-at its other call sites, which are much more common than this one.)--(Alternative 2: We could avoid calling decomposePiCos entirely, integrating its-behavior into simplifyArgsWorker. This would work, I think, but then all of the-complication of decomposePiCos would end up layered on top of all the complication-here. Please, no.)--(Alternative 3: We could pass the unrewritten arguments into simplifyArgsWorker-so that we don't have to recreate them. But that would complicate the interface-of this function to handle a very dark, dark corner case. Better to keep our-demons to ourselves here instead of exposing them to callers. This decision is-easily reversed if there is ever any performance trouble due to the call of-coercionKind.)--So we now call-- decomposePiCos co1- (Pair (forall j. j -> Type) (forall (j :: Star). (j |> axStar) -> Star))- [bo |> sym axStar, NoWay |> sym bc]--to get-- co5 :: Star ~ Type- co6 :: (j |> axStar) ~ (j |> co5), substituted to- (bo |> sym axStar |> axStar) ~ (bo |> sym axStar |> co5)- == bo ~ bo- res_co :: Type ~ Star--We then use these casts on (the rewritten) (3) and (4) to get-- (Bool |> sym axStar |> co5 :: Type) -- (C3)- (False |> sym bc |> co6 :: bo) -- (C4)--We can simplify to-- Bool -- (C3)- (False |> sym bc :: bo) -- (C4)--Of course, we still must do the processing in Note [simplifyArgsWorker] to finish-the job. We thus want to recur. Our new function kind is the left-hand type of-co1 (gotten, recall, by lifting the variable k that was the return kind of the-original function). Why the left-hand type (as opposed to the right-hand type)?-Because we have casted all the arguments according to decomposePiCos, which gets-us from the right-hand type to the left-hand one. We thus recur with that new-function kind, zapping our lifting context, because we have essentially applied-it.--This recursive call returns ([Bool, False], [...], Refl). The Bool and False-are the correct arguments we wish to return. But we must be careful about the-result coercion: our new, rewritten application will have kind Type, but we-want to make sure that the result coercion casts this back to Star. (Why?-Because we started with an application of kind Star, and rewriting is homogeneous.)--So, we have to twiddle the result coercion appropriately.--Let's check whether this is well-typed. We know-- a :: forall (k :: Type). k -> k-- a (forall j. j -> Type) :: (forall j. j -> Type) -> forall j. j -> Type-- a (forall j. j -> Type)- Proxy- :: forall j. j -> Type-- a (forall j. j -> Type)- Proxy- Bool- :: Bool -> Type-- a (forall j. j -> Type)- Proxy- Bool- False- :: Type-- a (forall j. j -> Type)- Proxy- Bool- False- |> res_co- :: Star--as desired.--Whew.--Historical note: I (Richard E) once thought that the final part of the kind-had to be a variable k (as in the example above). But it might not be: it could-be an application of a variable. Here is the example:-- let f :: forall (a :: Type) (b :: a -> Type). b (Any @a)- k :: Type- x :: k-- rewrite (f @Type @((->) k) x)--After instantiating [a |-> Type, b |-> ((->) k)], we see that `b (Any @a)`-is `k -> Any @a`, and thus the third argument of `x :: k` is well-kinded.---}----- This is shared between the rewriter and the normaliser in GHC.Core.FamInstEnv.--- See Note [simplifyArgsWorker]-{-# INLINE simplifyArgsWorker #-}-simplifyArgsWorker :: [TyCoBinder] -> Kind- -- the binders & result kind (not a Π-type) of the function applied to the args- -- list of binders can be shorter or longer than the list of args- -> TyCoVarSet -- free vars of the args- -> [Role] -- list of roles, r- -> [(Type, Coercion)] -- rewritten type arguments, arg- -- each comes with the coercion used to rewrite it,- -- with co :: rewritten_type ~ original_type- -> ([Type], [Coercion], MCoercionN)--- Returns (xis, cos, res_co), where each co :: xi ~ arg,--- and res_co :: kind (f xis) ~ kind (f tys), where f is the function applied to the args--- Precondition: if f :: forall bndrs. inner_ki (where bndrs and inner_ki are passed in),--- then (f orig_tys) is well kinded. Note that (f rewritten_tys) might *not* be well-kinded.--- Massaging the rewritten_tys in order to make (f rewritten_tys) well-kinded is what this--- function is all about. That is, (f xis), where xis are the returned arguments, *is*--- well kinded.-simplifyArgsWorker orig_ki_binders orig_inner_ki orig_fvs- orig_roles orig_simplified_args- = go [] [] orig_lc orig_ki_binders orig_inner_ki orig_roles orig_simplified_args- where- orig_lc = emptyLiftingContext $ mkInScopeSet $ orig_fvs-- go :: [Type] -- Xis accumulator, in reverse order- -> [Coercion] -- Coercions accumulator, in reverse order- -- These are in 1-to-1 correspondence- -> LiftingContext -- mapping from tyvars to rewriting coercions- -> [TyCoBinder] -- Unsubsted binders of function's kind- -> Kind -- Unsubsted result kind of function (not a Pi-type)- -> [Role] -- Roles at which to rewrite these ...- -> [(Type, Coercion)] -- rewritten arguments, with their rewriting coercions- -> ([Type], [Coercion], MCoercionN)- go acc_xis acc_cos !lc binders inner_ki _ []- -- The !lc makes the function strict in the lifting context- -- which means GHC can unbox that pair. A modest win.- = (reverse acc_xis, reverse acc_cos, kind_co)- where- final_kind = mkPiTys binders inner_ki- kind_co | noFreeVarsOfType final_kind = MRefl- | otherwise = MCo $ liftCoSubst Nominal lc final_kind-- go acc_xis acc_cos lc (binder:binders) inner_ki (role:roles) ((xi,co):args)- = -- By Note [Rewriting] in GHC.Tc.Solver.Rewrite invariant (F2),- -- tcTypeKind(xi) = tcTypeKind(ty). But, it's possible that xi will be- -- used as an argument to a function whose kind is different, if- -- earlier arguments have been rewritten to new types. We thus- -- need a coercion (kind_co :: old_kind ~ new_kind).- --- -- The bangs here have been observed to improve performance- -- significantly in optimized builds; see #18502- let !kind_co = mkSymCo $- liftCoSubst Nominal lc (tyCoBinderType binder)- !casted_xi = xi `mkCastTy` kind_co- casted_co = mkCoherenceLeftCo role xi kind_co co-- -- now, extend the lifting context with the new binding- !new_lc | Just tv <- tyCoBinderVar_maybe binder- = extendLiftingContextAndInScope lc tv casted_co- | otherwise- = lc- in- go (casted_xi : acc_xis)- (casted_co : acc_cos)- new_lc- binders- inner_ki- roles- args--- -- See Note [Last case in simplifyArgsWorker]- go acc_xis acc_cos lc [] inner_ki roles args- = let co1 = liftCoSubst Nominal lc inner_ki- co1_kind = coercionKind co1- unrewritten_tys = map (coercionRKind . snd) args- (arg_cos, res_co) = decomposePiCos co1 co1_kind unrewritten_tys- casted_args = assertPpr (equalLength args arg_cos)- (ppr args $$ ppr arg_cos)- [ (casted_xi, casted_co)- | ((xi, co), arg_co, role) <- zip3 args arg_cos roles- , let casted_xi = xi `mkCastTy` arg_co- casted_co = mkCoherenceLeftCo role xi arg_co co ]- -- In general decomposePiCos can return fewer cos than tys,- -- but not here; because we're well typed, there will be enough- -- binders. Note that decomposePiCos does substitutions, so even- -- if the original substitution results in something ending with- -- ... -> k, that k will be substituted to perhaps reveal more- -- binders.- zapped_lc = zapLiftingContext lc- Pair rewritten_kind _ = co1_kind- (bndrs, new_inner) = splitPiTys rewritten_kind-- (xis_out, cos_out, res_co_out)- = go acc_xis acc_cos zapped_lc bndrs new_inner roles casted_args- in- (xis_out, cos_out, res_co_out `mkTransMCoL` res_co)-- go _ _ _ _ _ _ _ = panic- "simplifyArgsWorker wandered into deeper water than usual"- -- This debug information is commented out because leaving it in- -- causes a ~2% increase in allocations in T9872d.- -- That's independent of the analogous case in rewrite_args_fast- -- in GHC.Tc.Solver.Rewrite:- -- each of these causes a 2% increase on its own, so commenting them- -- both out gives a 4% decrease in T9872d.- {--- (vcat [ppr orig_binders,- ppr orig_inner_ki,- ppr (take 10 orig_roles), -- often infinite!- ppr orig_tys])- -} {- %************************************************************************
compiler/GHC/Core/DataCon.hs view
@@ -1357,7 +1357,7 @@ or MkT :: a -> T a (with -XNoLinearTypes) -There are two different methods to retrieve a type of a datacon.+There are three different methods to retrieve a type of a datacon. They differ in how linear fields are handled. 1. dataConWrapperType:@@ -1369,7 +1369,7 @@ Used when we don't want to introduce linear types to user (in holes and in types in hie used by haddock). -3. dataConDisplayType (take a boolean indicating if -XLinearTypes is enabled):+3. dataConDisplayType (takes a boolean indicating if -XLinearTypes is enabled): The type we'd like to show in error messages, :info and -ddump-types. Ideally, it should reflect the type written by the user; the function returns a type with arrows that would be required
compiler/GHC/Core/FamInstEnv.hs view
@@ -45,6 +45,7 @@ import GHC.Core.TyCon import GHC.Core.Coercion import GHC.Core.Coercion.Axiom+import GHC.Core.Reduction import GHC.Types.Var.Set import GHC.Types.Var.Env import GHC.Types.Name@@ -1099,7 +1100,7 @@ reduceTyFamApp_maybe :: FamInstEnvs -> Role -- Desired role of result coercion -> TyCon -> [Type]- -> Maybe (Coercion, Type)+ -> Maybe Reduction -- Attempt to do a *one-step* reduction of a type-family application -- but *not* newtypes -- Works on type-synonym families always; data-families only if@@ -1130,20 +1131,18 @@ -- NB: Allow multiple matches because of compatible overlap = let co = mkUnbranchedAxInstCo role ax inst_tys inst_cos- ty = coercionRKind co- in Just (co, ty)+ in Just $ coercionRedn co | Just ax <- isClosedSynFamilyTyConWithAxiom_maybe tc , Just (ind, inst_tys, inst_cos) <- chooseBranch ax tys = let co = mkAxInstCo role ax ind inst_tys inst_cos- ty = coercionRKind co- in Just (co, ty)+ in Just $ coercionRedn co | Just ax <- isBuiltInSynFamTyCon_maybe tc , Just (coax,ts,ty) <- sfMatchFam ax tys , role == coaxrRole coax = let co = mkAxiomRuleCo coax (zipWith mkReflCo (coaxrAsmpRoles coax) ts)- in Just (co, ty)+ in Just $ mkReduction co ty | otherwise = Nothing@@ -1274,11 +1273,12 @@ -} topNormaliseType :: FamInstEnvs -> Type -> Type-topNormaliseType env ty = case topNormaliseType_maybe env ty of- Just (_co, ty') -> ty'- Nothing -> ty+topNormaliseType env ty+ = case topNormaliseType_maybe env ty of+ Just redn -> reductionReducedType redn+ Nothing -> ty -topNormaliseType_maybe :: FamInstEnvs -> Type -> Maybe (Coercion, Type)+topNormaliseType_maybe :: FamInstEnvs -> Type -> Maybe Reduction -- ^ Get rid of *outermost* (or toplevel) -- * type function redex@@ -1297,12 +1297,8 @@ -- original type, and the returned coercion is always homogeneous. topNormaliseType_maybe env ty = do { ((co, mkind_co), nty) <- topNormaliseTypeX stepper combine ty- ; return $ case mkind_co of- MRefl -> (co, nty)- MCo kind_co -> let nty_casted = nty `mkCastTy` mkSymCo kind_co- final_co = mkCoherenceRightCo Representational nty- (mkSymCo kind_co) co- in (final_co, nty_casted) }+ ; let hredn = mkHetReduction (mkReduction co nty) mkind_co+ ; return $ homogeniseHetRedn Representational hredn } where stepper = unwrapNewTypeStepper' `composeSteppers` tyFamStepper @@ -1317,18 +1313,19 @@ tyFamStepper :: NormaliseStepper (Coercion, MCoercionN) tyFamStepper rec_nts tc tys -- Try to step a type/data family = case topReduceTyFamApp_maybe env tc tys of- Just (co, rhs, res_co) -> NS_Step rec_nts rhs (co, res_co)- _ -> NS_Done+ Just (HetReduction (Reduction co rhs) res_co)+ -> NS_Step rec_nts rhs (co, res_co)+ _ -> NS_Done ----------------normaliseTcApp :: FamInstEnvs -> Role -> TyCon -> [Type] -> (Coercion, Type)+normaliseTcApp :: FamInstEnvs -> Role -> TyCon -> [Type] -> Reduction -- See comments on normaliseType for the arguments of this function normaliseTcApp env role tc tys = initNormM env role (tyCoVarsOfTypes tys) $ normalise_tc_app tc tys -- See Note [Normalising types] about the LiftingContext-normalise_tc_app :: TyCon -> [Type] -> NormM (Coercion, Type)+normalise_tc_app :: TyCon -> [Type] -> NormM Reduction normalise_tc_app tc tys | Just (tenv, rhs, tys') <- expandSynTyCon_maybe tc tys , not (isFamFreeTyCon tc) -- Expand and try again@@ -1341,76 +1338,70 @@ = -- A type-family application do { env <- getEnv ; role <- getRole- ; (args_co, ntys, res_co) <- normalise_tc_args tc tys+ ; ArgsReductions redns@(Reductions args_cos ntys) res_co <- normalise_tc_args tc tys ; case reduceTyFamApp_maybe env role tc ntys of- Just (first_co, ty')- -> do { (rest_co,nty) <- normalise_type ty'- ; return (assemble_result role nty- (args_co `mkTransCo` first_co `mkTransCo` rest_co)- res_co) }+ Just redn1+ -> do { redn2 <- normalise_reduction redn1+ ; let redn3 = mkTyConAppCo role tc args_cos `mkTransRedn` redn2+ ; return $ assemble_result role redn3 res_co } _ -> -- No unique matching family instance exists; -- we do not do anything- return (assemble_result role (mkTyConApp tc ntys) args_co res_co) }+ return $+ assemble_result role (mkTyConAppRedn role tc redns) res_co } | otherwise = -- A synonym with no type families in the RHS; or data type etc -- Just normalise the arguments and rebuild- do { (args_co, ntys, res_co) <- normalise_tc_args tc tys+ do { ArgsReductions redns res_co <- normalise_tc_args tc tys ; role <- getRole- ; return (assemble_result role (mkTyConApp tc ntys) args_co res_co) }+ ; return $+ assemble_result role (mkTyConAppRedn role tc redns) res_co } where assemble_result :: Role -- r, ambient role in NormM monad- -> Type -- nty, result type, possibly of changed kind- -> Coercion -- orig_ty ~r nty, possibly heterogeneous+ -> Reduction -- orig_ty ~r nty, possibly heterogeneous (nty possibly of changed kind) -> MCoercionN -- typeKind(orig_ty) ~N typeKind(nty)- -> (Coercion, Type) -- (co :: orig_ty ~r nty_casted, nty_casted)- -- where nty_casted has same kind as orig_ty- assemble_result r nty orig_to_nty kind_co- = ( final_co, nty_old_kind )- where- nty_old_kind = nty `mkCastTyMCo` mkSymMCo kind_co- final_co = mkCoherenceRightMCo r nty (mkSymMCo kind_co) orig_to_nty+ -> Reduction -- orig_ty ~r nty_casted+ -- where nty_casted has same kind as orig_ty+ assemble_result r redn kind_co+ = mkCoherenceRightMRedn r redn (mkSymMCo kind_co) --------------- -- | Try to simplify a type-family application, by *one* step--- If topReduceTyFamApp_maybe env r F tys = Just (co, rhs, res_co)+-- If topReduceTyFamApp_maybe env r F tys = Just (HetReduction (Reduction co rhs) res_co) -- then co :: F tys ~R# rhs -- res_co :: typeKind(F tys) ~ typeKind(rhs) -- Type families and data families; always Representational role topReduceTyFamApp_maybe :: FamInstEnvs -> TyCon -> [Type]- -> Maybe (Coercion, Type, MCoercion)+ -> Maybe HetReduction topReduceTyFamApp_maybe envs fam_tc arg_tys | isFamilyTyCon fam_tc -- type families and data families- , Just (co, rhs) <- reduceTyFamApp_maybe envs role fam_tc ntys- = Just (args_co `mkTransCo` co, rhs, res_co)+ , Just redn <- reduceTyFamApp_maybe envs role fam_tc ntys+ = Just $+ mkHetReduction+ (mkTyConAppCo role fam_tc args_cos `mkTransRedn` redn)+ res_co | otherwise = Nothing where role = Representational- (args_co, ntys, res_co) = initNormM envs role (tyCoVarsOfTypes arg_tys) $- normalise_tc_args fam_tc arg_tys+ ArgsReductions (Reductions args_cos ntys) res_co+ = initNormM envs role (tyCoVarsOfTypes arg_tys)+ $ normalise_tc_args fam_tc arg_tys -normalise_tc_args :: TyCon -> [Type] -- tc tys- -> NormM (Coercion, [Type], MCoercionN)- -- (co, new_tys), where- -- co :: tc tys ~ tc new_tys; might not be homogeneous- -- res_co :: typeKind(tc tys) ~N typeKind(tc new_tys)+normalise_tc_args :: TyCon -> [Type] -> NormM ArgsReductions normalise_tc_args tc tys = do { role <- getRole- ; (args_cos, nargs, res_co) <- normalise_args (tyConKind tc) (tyConRolesX role tc) tys- ; return (mkTyConAppCo role tc args_cos, nargs, res_co) }+ ; normalise_args (tyConKind tc) (tyConRolesX role tc) tys } --------------- normaliseType :: FamInstEnvs -> Role -- desired role of coercion- -> Type -> (Coercion, Type)+ -> Type -> Reduction normaliseType env role ty = initNormM env role (tyCoVarsOfType ty) $ normalise_type ty -normalise_type :: Type -- old type- -> NormM (Coercion, Type) -- (coercion, new type), where- -- co :: old-type ~ new_type+normalise_type :: Type -> NormM Reduction -- Normalise the input type, by eliminating *all* type-function redexes -- but *not* newtypes (which are visible to the programmer) -- Returns with Refl if nothing happens@@ -1422,106 +1413,105 @@ normalise_type ty = go ty where+ go :: Type -> NormM Reduction go (TyConApp tc tys) = normalise_tc_app tc tys- go ty@(LitTy {}) = do { r <- getRole- ; return (mkReflCo r ty, ty) }+ go ty@(LitTy {})+ = do { r <- getRole+ ; return $ mkReflRedn r ty } go (AppTy ty1 ty2) = go_app_tys ty1 [ty2] - go ty@(FunTy { ft_mult = w, ft_arg = ty1, ft_res = ty2 })- = do { (co1, nty1) <- go ty1- ; (co2, nty2) <- go ty2- ; (wco, wty) <- withRole Nominal $ go w+ go (FunTy { ft_af = vis, ft_mult = w, ft_arg = ty1, ft_res = ty2 })+ = do { arg_redn <- go ty1+ ; res_redn <- go ty2+ ; w_redn <- withRole Nominal $ go w ; r <- getRole- ; return (mkFunCo r wco co1 co2, ty { ft_mult = wty, ft_arg = nty1, ft_res = nty2 }) }+ ; return $ mkFunRedn r vis w_redn arg_redn res_redn } go (ForAllTy (Bndr tcvar vis) ty)- = do { (lc', tv', h, ki') <- normalise_var_bndr tcvar- ; (co, nty) <- withLC lc' $ normalise_type ty- ; let tv2 = setTyVarKind tv' ki'- ; return (mkForAllCo tv' h co, ForAllTy (Bndr tv2 vis) nty) }+ = do { (lc', tv', k_redn) <- normalise_var_bndr tcvar+ ; redn <- withLC lc' $ normalise_type ty+ ; return $ mkForAllRedn vis tv' k_redn redn } go (TyVarTy tv) = normalise_tyvar tv go (CastTy ty co)- = do { (nco, nty) <- go ty+ = do { redn <- go ty ; lc <- getLC ; let co' = substRightCo lc co- ; return (castCoercionKind2 nco Nominal ty nty co co'- , mkCastTy nty co') }+ ; return $ mkCastRedn2 Nominal ty co redn co'+ -- ^^^^^^^^^^^ uses castCoercionKind2+ } go (CoercionTy co) = do { lc <- getLC ; r <- getRole- ; let right_co = substRightCo lc co- ; return ( mkProofIrrelCo r- (liftCoSubst Nominal lc (coercionType co))- co right_co- , mkCoercionTy right_co ) }+ ; let kco = liftCoSubst Nominal lc (coercionType co)+ co' = substRightCo lc co+ ; return $ mkProofIrrelRedn r kco co co' } go_app_tys :: Type -- function -> [Type] -- args- -> NormM (Coercion, Type)+ -> NormM Reduction -- cf. GHC.Tc.Solver.Rewrite.rewrite_app_ty_args go_app_tys (AppTy ty1 ty2) tys = go_app_tys ty1 (ty2 : tys) go_app_tys fun_ty arg_tys- = do { (fun_co, nfun) <- go fun_ty+ = do { fun_redn@(Reduction fun_co nfun) <- go fun_ty ; case tcSplitTyConApp_maybe nfun of Just (tc, xis) ->- do { (second_co, nty) <- go (mkTyConApp tc (xis ++ arg_tys))+ do { redn <- go (mkTyConApp tc (xis ++ arg_tys)) -- rewrite_app_ty_args avoids redundantly processing the xis, -- but that's a much more performance-sensitive function. -- This type normalisation is not called in a loop.- ; return (mkAppCos fun_co (map mkNomReflCo arg_tys) `mkTransCo` second_co, nty) }+ ; return $+ mkAppCos fun_co (map mkNomReflCo arg_tys) `mkTransRedn` redn } Nothing ->- do { (args_cos, nargs, res_co) <- normalise_args (typeKind nfun)- (repeat Nominal)- arg_tys+ do { ArgsReductions redns res_co+ <- normalise_args (typeKind nfun)+ (repeat Nominal)+ arg_tys ; role <- getRole- ; let nty = mkAppTys nfun nargs- nco = mkAppCos fun_co args_cos- nty_casted = nty `mkCastTyMCo` mkSymMCo res_co- final_co = mkCoherenceRightMCo role nty (mkSymMCo res_co) nco- ; return (final_co, nty_casted) } }+ ; return $+ mkCoherenceRightMRedn role+ (mkAppRedns fun_redn redns)+ (mkSymMCo res_co) } } normalise_args :: Kind -- of the function -> [Role] -- roles at which to normalise args -> [Type] -- args- -> NormM ([Coercion], [Type], MCoercion)--- returns (cos, xis, res_co), where each xi is the normalised--- version of the corresponding type, each co is orig_arg ~ xi,--- and the res_co :: kind(f orig_args) ~ kind(f xis)+ -> NormM ArgsReductions+-- returns ArgsReductions (Reductions cos xis) res_co,+-- where each xi is the normalised version of the corresponding type,+-- each co is orig_arg ~ xi, and res_co :: kind(f orig_args) ~ kind(f xis). -- NB: The xis might *not* have the same kinds as the input types, -- but the resulting application *will* be well-kinded -- cf. GHC.Tc.Solver.Rewrite.rewrite_args_slow normalise_args fun_ki roles args = do { normed_args <- zipWithM normalise1 roles args- ; let (xis, cos, res_co) = simplifyArgsWorker ki_binders inner_ki fvs roles normed_args- ; return (map mkSymCo cos, xis, mkSymMCo res_co) }+ ; return $ simplifyArgsWorker ki_binders inner_ki fvs roles normed_args } where (ki_binders, inner_ki) = splitPiTys fun_ki fvs = tyCoVarsOfTypes args - -- rewriter conventions are different from ours- impedance_match :: NormM (Coercion, Type) -> NormM (Type, Coercion)- impedance_match action = do { (co, ty) <- action- ; return (ty, mkSymCo co) }- normalise1 role ty- = impedance_match $ withRole role $ normalise_type ty+ = withRole role $ normalise_type ty -normalise_tyvar :: TyVar -> NormM (Coercion, Type)+normalise_tyvar :: TyVar -> NormM Reduction normalise_tyvar tv = assert (isTyVar tv) $ do { lc <- getLC ; r <- getRole ; return $ case liftCoSubstTyVar lc r tv of- Just co -> (co, coercionRKind co)- Nothing -> (mkReflCo r ty, ty) }- where ty = mkTyVarTy tv+ Just co -> coercionRedn co+ Nothing -> mkReflRedn r (mkTyVarTy tv) } -normalise_var_bndr :: TyCoVar -> NormM (LiftingContext, TyCoVar, Coercion, Kind)+normalise_reduction :: Reduction -> NormM Reduction+normalise_reduction (Reduction co ty)+ = do { redn' <- normalise_type ty+ ; return $ co `mkTransRedn` redn' }++normalise_var_bndr :: TyCoVar -> NormM (LiftingContext, TyCoVar, Reduction) normalise_var_bndr tcvar -- works for both tvar and covar = do { lc1 <- getLC ; env <- getEnv ; let callback lc ki = runNormM (normalise_type ki) env lc Nominal- ; return $ liftCoSubstVarBndrUsing callback lc1 tcvar }+ ; return $ liftCoSubstVarBndrUsing reductionCoercion callback lc1 tcvar } -- | a monad for the normalisation functions, reading 'FamInstEnvs', -- a 'LiftingContext', and a 'Role'.
compiler/GHC/Core/Lint.hs view
@@ -1430,10 +1430,10 @@ -- We've already check lintL (tycon == dataConTyCon con) (mkBadConMsg tycon con) ; let { con_payload_ty = piResultTys (dataConRepType con) tycon_arg_tys- ; ex_tvs_n = length (dataConExTyCoVars con)- -- See Note [Alt arg multiplicities]- ; multiplicities = replicate ex_tvs_n Many ++- map scaledMult (dataConRepArgTys con) }+ ; binderMult (Named _) = Many+ ; binderMult (Anon _ st) = scaledMult st+ -- See Note [Validating multiplicities in a case]+ ; multiplicities = map binderMult $ fst $ splitPiTys con_payload_ty } -- And now bring the new binders into scope ; lintBinders CasePatBind args $ \ args' -> do@@ -1447,6 +1447,22 @@ | otherwise -- Scrut-ty is wrong shape = zeroUE <$ addErrL (mkBadAltMsg scrut_ty alt) +{-+Note [Validating multiplicities in a case]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Suppose 'MkT :: a %m -> T m a'.+If we are validating 'case (x :: T Many a) of MkT y -> ...',+we have to substitute m := Many in the type of MkT - in particular,+y can be used Many times and that expression would still be linear in x.+We do this by looking at con_payload_ty, which is the type of the datacon+applied to the surrounding arguments.+Testcase: linear/should_compile/MultConstructor++Data constructors containing existential tyvars will then have+Named binders, which are always multiplicity Many.+Testcase: indexed-types/should_compile/GADT1+-}+ lintLinearBinder :: SDoc -> Mult -> Mult -> LintM () lintLinearBinder doc actual_usage described_usage = ensureSubMult actual_usage described_usage err_msg@@ -1455,16 +1471,6 @@ $$ doc $$ ppr actual_usage $$ text "Annotation:" <+> ppr described_usage)--{--Note [Alt arg multiplicities]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-It is necessary to use `dataConRepArgTys` so you get the arg tys from-the wrapper if there is one.--You also need to add the existential ty vars as they are passed are arguments-but not returned by `dataConRepArgTys`. Without this the test `GADT1` fails.--} {- ************************************************************************
compiler/GHC/Core/Opt/Arity.hs view
@@ -1763,7 +1763,7 @@ Pair tyL tyR = coercionKind co pushCoercionIntoLambda- :: InScopeSet -> Var -> CoreExpr -> CoercionR -> Maybe (Var, CoreExpr)+ :: HasDebugCallStack => InScopeSet -> Var -> CoreExpr -> CoercionR -> Maybe (Var, CoreExpr) -- This implements the Push rule from the paper on coercions -- (\x. e) |> co -- ===>
compiler/GHC/Core/Opt/ConstantFold.hs view
@@ -10,7 +10,6 @@ (i1 + i2) only if it results in a valid Float. -} -{-# LANGUAGE CPP #-} {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE LambdaCase #-}@@ -31,8 +30,6 @@ ) where -#include "MachDeps.h"- import GHC.Prelude import GHC.Platform@@ -317,7 +314,6 @@ Word32SllOp -> mkPrimOpRule nm 2 [ shiftRule LitNumWord32 (const shiftL) ] Word32SrlOp -> mkPrimOpRule nm 2 [ shiftRule LitNumWord32 $ const $ shiftRightLogical @Word32 ] -#if WORD_SIZE_IN_BITS < 64 -- Int64 operations Int64AddOp -> mkPrimOpRule nm 2 [ binaryLit (int64Op2 (+)) , identity zeroI64@@ -387,7 +383,6 @@ , semiInversePrimOp Word64NotOp ] Word64SllOp -> mkPrimOpRule nm 2 [ shiftRule LitNumWord64 (const shiftL) ] Word64SrlOp -> mkPrimOpRule nm 2 [ shiftRule LitNumWord64 $ const $ shiftRightLogical @Word64 ]-#endif -- Int operations IntAddOp -> mkPrimOpRule nm 2 [ binaryLit (intOp2 (+))@@ -489,9 +484,7 @@ Int8ToIntOp -> mkPrimOpRule nm 1 [ liftLitPlatform extendIntLit ] Int16ToIntOp -> mkPrimOpRule nm 1 [ liftLitPlatform extendIntLit ] Int32ToIntOp -> mkPrimOpRule nm 1 [ liftLitPlatform extendIntLit ]-#if WORD_SIZE_IN_BITS < 64 Int64ToIntOp -> mkPrimOpRule nm 1 [ liftLitPlatform extendIntLit ]-#endif IntToInt8Op -> mkPrimOpRule nm 1 [ liftLit narrowInt8Lit , semiInversePrimOp Int8ToIntOp , narrowSubsumesAnd IntAndOp IntToInt8Op 8 ]@@ -501,9 +494,7 @@ IntToInt32Op -> mkPrimOpRule nm 1 [ liftLit narrowInt32Lit , semiInversePrimOp Int32ToIntOp , narrowSubsumesAnd IntAndOp IntToInt32Op 32 ]-#if WORD_SIZE_IN_BITS < 64 IntToInt64Op -> mkPrimOpRule nm 1 [ liftLit narrowInt64Lit ]-#endif Word8ToWordOp -> mkPrimOpRule nm 1 [ liftLitPlatform extendWordLit , extendNarrowPassthrough WordToWord8Op 0xFF@@ -514,9 +505,7 @@ Word32ToWordOp -> mkPrimOpRule nm 1 [ liftLitPlatform extendWordLit , extendNarrowPassthrough WordToWord32Op 0xFFFFFFFF ]-#if WORD_SIZE_IN_BITS < 64 Word64ToWordOp -> mkPrimOpRule nm 1 [ liftLitPlatform extendWordLit ]-#endif WordToWord8Op -> mkPrimOpRule nm 1 [ liftLit narrowWord8Lit , semiInversePrimOp Word8ToWordOp@@ -527,9 +516,7 @@ WordToWord32Op -> mkPrimOpRule nm 1 [ liftLit narrowWord32Lit , semiInversePrimOp Word32ToWordOp , narrowSubsumesAnd WordAndOp WordToWord32Op 32 ]-#if WORD_SIZE_IN_BITS < 64 WordToWord64Op -> mkPrimOpRule nm 1 [ liftLit narrowWord64Lit ]-#endif Word8ToInt8Op -> mkPrimOpRule nm 1 [ liftLitPlatform (litNumCoerce LitNumInt8) , semiInversePrimOp Int8ToWord8Op ]@@ -543,12 +530,10 @@ , semiInversePrimOp Int32ToWord32Op ] Int32ToWord32Op-> mkPrimOpRule nm 1 [ liftLitPlatform (litNumCoerce LitNumWord32) , semiInversePrimOp Word32ToInt32Op ]-#if WORD_SIZE_IN_BITS < 64 Word64ToInt64Op-> mkPrimOpRule nm 1 [ liftLitPlatform (litNumCoerce LitNumInt64) , semiInversePrimOp Int64ToWord64Op ] Int64ToWord64Op-> mkPrimOpRule nm 1 [ liftLitPlatform (litNumCoerce LitNumWord64) , semiInversePrimOp Word64ToInt64Op ]-#endif WordToIntOp -> mkPrimOpRule nm 1 [ liftLitPlatform (litNumCoerce LitNumInt) , semiInversePrimOp IntToWordOp ]@@ -817,13 +802,11 @@ zeroW32 = mkLitWord32 0 oneW32 = mkLitWord32 1 -#if WORD_SIZE_IN_BITS < 64 zeroI64, oneI64, zeroW64, oneW64 :: Literal zeroI64 = mkLitInt64 0 oneI64 = mkLitInt64 1 zeroW64 = mkLitWord64 0 oneW64 = mkLitWord64 1-#endif zerof, onef, twof, zerod, oned, twod :: Literal zerof = mkLitFloat 0.0@@ -890,7 +873,6 @@ int32Result (fromInteger i1 `op` fromInteger i2) int32Op2 _ _ _ _ = Nothing -#if WORD_SIZE_IN_BITS < 64 int64Op2 :: (Integral a, Integral b) => (a -> b -> Integer)@@ -898,7 +880,6 @@ int64Op2 op _ (LitNumber LitNumInt64 i1) (LitNumber LitNumInt64 i2) = int64Result (fromInteger i1 `op` fromInteger i2) int64Op2 _ _ _ _ = Nothing-#endif intOp2 :: (Integral a, Integral b) => (a -> b -> Integer)@@ -968,7 +949,6 @@ word32Result (fromInteger i1 `op` fromInteger i2) word32Op2 _ _ _ _ = Nothing -#if WORD_SIZE_IN_BITS < 64 word64Op2 :: (Integral a, Integral b) => (a -> b -> Integer)@@ -976,7 +956,6 @@ word64Op2 op _ (LitNumber LitNumWord64 i1) (LitNumber LitNumWord64 i2) = word64Result (fromInteger i1 `op` fromInteger i2) word64Op2 _ _ _ _ = Nothing-#endif wordOp2 :: (Integral a, Integral b) => (a -> b -> Integer)@@ -1218,7 +1197,6 @@ (lit, b) = mkLitWordWrapC platform result c = if b then onei platform else zeroi platform -#if WORD_SIZE_IN_BITS < 64 int64Result :: Integer -> Maybe CoreExpr int64Result result = Just (int64Result' result) @@ -1230,7 +1208,6 @@ word64Result' :: Integer -> CoreExpr word64Result' result = Lit (mkLitWord64Wrap result)-#endif -- | 'ambiant (primop x) = x', but not nececesarily 'primop (ambient x) = x'.@@ -1431,11 +1408,14 @@ instance MonadPlus RuleM getPlatform :: RuleM Platform-getPlatform = roPlatform <$> getEnv+getPlatform = roPlatform <$> getRuleOpts -getEnv :: RuleM RuleOpts-getEnv = RuleM $ \env _ _ _ -> Just env+getRuleOpts :: RuleM RuleOpts+getRuleOpts = RuleM $ \rule_opts _ _ _ -> Just rule_opts +getEnv :: RuleM InScopeEnv+getEnv = RuleM $ \_ env _ _ -> Just env+ liftMaybe :: Maybe a -> RuleM a liftMaybe Nothing = mzero liftMaybe (Just x) = return x@@ -1468,6 +1448,20 @@ getFunction :: RuleM Id getFunction = RuleM $ \_ _ fn _ -> Just fn +exprIsVarApp_maybe :: InScopeEnv -> CoreExpr -> Maybe (Id,CoreArg)+exprIsVarApp_maybe env@(_, id_unf) e = case e of+ App (Var f) a -> Just (f, a)+ Var v+ | Just rhs <- expandUnfolding_maybe (id_unf v)+ -> exprIsVarApp_maybe env rhs+ _ -> Nothing++-- | Looks into the expression or its unfolding to find "App (Var f) x"+isVarApp :: InScopeEnv -> CoreExpr -> RuleM (Id,CoreArg)+isVarApp env e = case exprIsVarApp_maybe env e of+ Nothing -> mzero+ Just r -> pure r+ isLiteral :: CoreExpr -> RuleM Literal isLiteral e = do env <- getInScopeEnv@@ -1509,13 +1503,13 @@ unaryLit :: (RuleOpts -> Literal -> Maybe CoreExpr) -> RuleM CoreExpr unaryLit op = do- env <- getEnv+ env <- getRuleOpts [Lit l] <- getArgs liftMaybe $ op env (convFloating env l) binaryLit :: (RuleOpts -> Literal -> Literal -> Maybe CoreExpr) -> RuleM CoreExpr binaryLit op = do- env <- getEnv+ env <- getRuleOpts [Lit l1, Lit l2] <- getArgs liftMaybe $ op env (convFloating env l1) (convFloating env l2) @@ -1910,12 +1904,18 @@ builtinRules :: [CoreRule] -- Rules for non-primops that can't be expressed using a RULE pragma builtinRules- = [BuiltinRule { ru_name = fsLit "AppendLitString",+ = [BuiltinRule { ru_name = fsLit "CStringFoldrLit", ru_fn = unpackCStringFoldrName,- ru_nargs = 4, ru_try = match_append_lit_C },- BuiltinRule { ru_name = fsLit "AppendLitStringUtf8",+ ru_nargs = 4, ru_try = match_cstring_foldr_lit_C },+ BuiltinRule { ru_name = fsLit "CStringFoldrLitUtf8", ru_fn = unpackCStringFoldrUtf8Name,- ru_nargs = 4, ru_try = match_append_lit_utf8 },+ ru_nargs = 4, ru_try = match_cstring_foldr_lit_utf8 },+ BuiltinRule { ru_name = fsLit "CStringAppendLit",+ ru_fn = unpackCStringAppendName,+ ru_nargs = 2, ru_try = match_cstring_append_lit_C },+ BuiltinRule { ru_name = fsLit "CStringAppendLitUtf8",+ ru_fn = unpackCStringAppendUtf8Name,+ ru_nargs = 2, ru_try = match_cstring_append_lit_utf8 }, BuiltinRule { ru_name = fsLit "EqString", ru_fn = eqStringName, ru_nargs = 2, ru_try = match_eq_string }, BuiltinRule { ru_name = fsLit "CStringLength", ru_fn = cstringLengthName,@@ -2042,66 +2042,91 @@ , bignum_popcount "integerPopCount" integerPopCountName mkLitIntWrap , bignum_popcount "naturalPopCount" naturalPopCountName mkLitWordWrap - -- identity passthrough- , id_passthrough "Int# -> Integer -> Int#"- integerToIntName integerISName- , id_passthrough "Word# -> Integer -> Word#"- integerToWordName integerFromWordName- , id_passthrough "Int64# -> Integer -> Int64#"- integerToInt64Name integerFromInt64Name- , id_passthrough "Word64# -> Integer -> Word64#"- integerToWord64Name integerFromWord64Name- , id_passthrough "Natural -> Integer -> Natural (wrap)"- integerToNaturalName integerFromNaturalName- , id_passthrough "Natural -> Integer -> Natural (throw)"- integerToNaturalThrowName integerFromNaturalName- , id_passthrough "Natural -> Integer -> Natural (clamp)"- integerToNaturalClampName integerFromNaturalName- , id_passthrough "Word# -> Natural -> Word#"- naturalToWordName naturalNSName- , id_passthrough "Word# -> Natural -> Word# (clamp)"- naturalToWordClampName naturalNSName+ ------------------------------------------------------------+ -- The following `small_passthough_*` rules are used to optimise conversions+ -- between numeric types by avoiding passing through "small" constructors of+ -- Integer and Natural.+ --+ -- See Note [Optimising conversions between numeric types]+ -- - -- passthrough bignum small constructors with a conversion that can be done- -- directly instead+ , small_passthrough_id "Word# -> Natural -> Word#"+ naturalNSName naturalToWordName+ , small_passthrough_id "Word# -> Natural -> Word# (clamp)"+ naturalNSName naturalToWordClampName - , small_passthrough "Int# -> Integer -> Word#"+ , small_passthrough_id "Int# -> Integer -> Int#"+ integerISName integerToIntName+ , small_passthrough_id "Word# -> Integer -> Word#"+ integerFromWordName integerToWordName+ , small_passthrough_id "Int64# -> Integer -> Int64#"+ integerFromInt64Name integerToInt64Name+ , small_passthrough_id "Word64# -> Integer -> Word64#"+ integerFromWord64Name integerToWord64Name+ , small_passthrough_id "Natural -> Integer -> Natural (wrap)"+ integerFromNaturalName integerToNaturalName+ , small_passthrough_id "Natural -> Integer -> Natural (throw)"+ integerFromNaturalName integerToNaturalThrowName+ , small_passthrough_id "Natural -> Integer -> Natural (clamp)"+ integerFromNaturalName integerToNaturalClampName++ , small_passthrough_app "Int# -> Integer -> Word#" integerISName integerToWordName (mkPrimOpId IntToWordOp)- , small_passthrough "Int# -> Integer -> Float#"+ , small_passthrough_app "Int# -> Integer -> Float#" integerISName integerToFloatName (mkPrimOpId IntToFloatOp)- , small_passthrough "Int# -> Integer -> Double#"+ , small_passthrough_app "Int# -> Integer -> Double#" integerISName integerToDoubleName (mkPrimOpId IntToDoubleOp)- , small_passthrough "Word# -> Integer -> Float#"++ , small_passthrough_app "Word# -> Integer -> Int#"+ integerFromWordName integerToIntName (mkPrimOpId WordToIntOp)+ , small_passthrough_app "Word# -> Integer -> Float#" integerFromWordName integerToFloatName (mkPrimOpId WordToFloatOp)- , small_passthrough "Word# -> Integer -> Double#"+ , small_passthrough_app "Word# -> Integer -> Double#" integerFromWordName integerToDoubleName (mkPrimOpId WordToDoubleOp)+ , small_passthrough_app "Word# -> Integer -> Natural (wrap)"+ integerFromWordName integerToNaturalName naturalNSId+ , small_passthrough_app "Word# -> Integer -> Natural (throw)"+ integerFromWordName integerToNaturalThrowName naturalNSId+ , small_passthrough_app "Word# -> Integer -> Natural (clamp)"+ integerFromWordName integerToNaturalClampName naturalNSId - , small_passthrough "Word# -> Natural -> Float#"+ , small_passthrough_app "Word# -> Natural -> Float#" naturalNSName naturalToFloatName (mkPrimOpId WordToFloatOp)- , small_passthrough "Word# -> Natural -> Double#"+ , small_passthrough_app "Word# -> Natural -> Double#" naturalNSName naturalToDoubleName (mkPrimOpId WordToDoubleOp) -#if WORD_SIZE_IN_BITS < 64- , id_passthrough "Int64# -> Integer -> Int64#"- integerToInt64Name integerFromInt64Name- , id_passthrough "Word64# -> Integer -> Word64#"- integerToWord64Name integerFromWord64Name+ , small_passthrough_id "Int64# -> Integer -> Int64#"+ integerFromInt64Name integerToInt64Name+ , small_passthrough_id "Word64# -> Integer -> Word64#"+ integerFromWord64Name integerToWord64Name - , small_passthrough "Int64# -> Integer -> Word64#"+ , small_passthrough_app "Int64# -> Integer -> Word64#" integerFromInt64Name integerToWord64Name (mkPrimOpId Int64ToWord64Op)- , small_passthrough "Word64# -> Integer -> Int64#"+ , small_passthrough_app "Word64# -> Integer -> Int64#" integerFromWord64Name integerToInt64Name (mkPrimOpId Word64ToInt64Op) - , small_passthrough "Word# -> Integer -> Word64#"+ , small_passthrough_app "Word# -> Integer -> Word64#" integerFromWordName integerToWord64Name (mkPrimOpId WordToWord64Op)- , small_passthrough "Word64# -> Integer -> Word#"+ , small_passthrough_app "Word64# -> Integer -> Word#" integerFromWord64Name integerToWordName (mkPrimOpId Word64ToWordOp)- , small_passthrough "Int# -> Integer -> Int64#"+ , small_passthrough_app "Int# -> Integer -> Int64#" integerISName integerToInt64Name (mkPrimOpId IntToInt64Op)- , small_passthrough "Int64# -> Integer -> Int#"+ , small_passthrough_app "Int64# -> Integer -> Int#" integerFromInt64Name integerToIntName (mkPrimOpId Int64ToIntOp)-#endif + , small_passthrough_custom "Int# -> Integer -> Word64#"+ integerISName integerToWord64Name+ (\x -> Var (mkPrimOpId Int64ToWord64Op) `App` (Var (mkPrimOpId IntToInt64Op) `App` x))+ , small_passthrough_custom "Word64# -> Integer -> Int#"+ integerFromWord64Name integerToIntName+ (\x -> Var (mkPrimOpId WordToIntOp) `App` (Var (mkPrimOpId Word64ToWordOp) `App` x))+ , small_passthrough_custom "Word# -> Integer -> Int64#"+ integerFromWordName integerToInt64Name+ (\x -> Var (mkPrimOpId Word64ToInt64Op) `App` (Var (mkPrimOpId WordToWord64Op) `App` x))+ , small_passthrough_custom "Int64# -> Integer -> Word#"+ integerFromInt64Name integerToWordName+ (\x -> Var (mkPrimOpId IntToWordOp) `App` (Var (mkPrimOpId Int64ToIntOp) `App` x))+ -- Bits.bit , bignum_bit "integerBit" integerBitName mkLitInteger , bignum_bit "naturalBit" naturalBitName mkLitNatural@@ -2153,15 +2178,17 @@ -- The data constructor may or may not have a wrapper, but if not -- dataConWrapId will return the worker --- integerISName = idName (dataConWrapId integerISDataCon)- naturalNSName = idName (dataConWrapId naturalNSDataCon)+ integerISId = dataConWrapId integerISDataCon+ naturalNSId = dataConWrapId naturalNSDataCon+ integerISName = idName integerISId+ naturalNSName = idName naturalNSId mkRule str name nargs f = BuiltinRule { ru_name = fsLit str , ru_fn = name , ru_nargs = nargs , ru_try = runRuleM $ do- env <- getEnv+ env <- getRuleOpts guard (roBignumRules env) f }@@ -2263,15 +2290,18 @@ x <- isNumberLiteral a0 pure $ Lit (mk_lit platform (fromIntegral (popCount x))) - id_passthrough str to_x from_x = mkRule str to_x 1 $ do- [App (Var f) x] <- getArgs- guard (idName f == from_x)- pure x+ small_passthrough_id str from_x to_x =+ small_passthrough_custom str from_x to_x id - small_passthrough str from_x to_y x_to_y = mkRule str to_y 1 $ do- [App (Var f) x] <- getArgs+ small_passthrough_app str from_x to_y x_to_y =+ small_passthrough_custom str from_x to_y (App (Var x_to_y))++ small_passthrough_custom str from_x to_y x_to_y = mkRule str to_y 1 $ do+ [a0] <- getArgs+ env <- getEnv+ (f,x) <- isVarApp env a0 guard (idName f == from_x)- pure $ App (Var x_to_y) x+ pure $ x_to_y x bignum_bit str name mk_lit = mkRule str name 1 $ do [a0] <- getArgs@@ -2345,7 +2375,42 @@ pure $ mk_lit (fromRational (n % d)) +---------------------------------------------------+-- The rules are:+-- unpackAppendCString*# "foo"# (unpackCString*# "baz"#)+-- = unpackCString*# "foobaz"#+--+-- unpackAppendCString*# "foo"# (unpackAppendCString*# "baz"# e)+-- = unpackAppendCString*# "foobaz"# e+-- +-- CString version+match_cstring_append_lit_C :: RuleFun+match_cstring_append_lit_C = match_cstring_append_lit unpackCStringAppendIdKey unpackCStringIdKey++-- CStringUTF8 version+match_cstring_append_lit_utf8 :: RuleFun+match_cstring_append_lit_utf8 = match_cstring_append_lit unpackCStringAppendUtf8IdKey unpackCStringUtf8IdKey++{-# INLINE match_cstring_append_lit #-}+match_cstring_append_lit :: Unique -> Unique -> RuleFun+match_cstring_append_lit append_key unpack_key _ env _ [lit1, e2]+ | Just (LitString s1) <- exprIsLiteral_maybe env lit1+ , (strTicks, Var unpk `App` lit2) <- stripStrTopTicks env e2+ , unpk `hasKey` unpack_key+ , Just (LitString s2) <- exprIsLiteral_maybe env lit2+ = Just $ mkTicks strTicks+ $ Var unpk `App` Lit (LitString (s1 `BS.append` s2))++ | Just (LitString s1) <- exprIsLiteral_maybe env lit1+ , (strTicks, Var appnd `App` lit2 `App` e) <- stripStrTopTicks env e2+ , appnd `hasKey` append_key+ , Just (LitString s2) <- exprIsLiteral_maybe env lit2+ = Just $ mkTicks strTicks+ $ Var appnd `App` Lit (LitString (s1 `BS.append` s2)) `App` e++match_cstring_append_lit _ _ _ _ _ _ = Nothing+ --------------------------------------------------- -- The rule is this: -- unpackFoldrCString*# "foo"# c (unpackFoldrCString*# "baz"# c n)@@ -2354,35 +2419,32 @@ -- See also Note [String literals in GHC] in CString.hs -- CString version-match_append_lit_C :: RuleFun-match_append_lit_C = match_append_lit unpackCStringFoldrIdKey+match_cstring_foldr_lit_C :: RuleFun+match_cstring_foldr_lit_C = match_cstring_foldr_lit unpackCStringFoldrIdKey -- CStringUTF8 version-match_append_lit_utf8 :: RuleFun-match_append_lit_utf8 = match_append_lit unpackCStringFoldrUtf8IdKey+match_cstring_foldr_lit_utf8 :: RuleFun+match_cstring_foldr_lit_utf8 = match_cstring_foldr_lit unpackCStringFoldrUtf8IdKey -{-# INLINE match_append_lit #-}-match_append_lit :: Unique -> RuleFun-match_append_lit foldVariant _ id_unf _+{-# INLINE match_cstring_foldr_lit #-}+match_cstring_foldr_lit :: Unique -> RuleFun+match_cstring_foldr_lit foldVariant _ env _ [ Type ty1 , lit1 , c1 , e2 ]- -- N.B. Ensure that we strip off any ticks (e.g. source notes) from the- -- `lit` and `c` arguments, lest this may fail to fire when building with- -- -g3. See #16740. | (strTicks, Var unpk `App` Type ty2 `App` lit2 `App` c2- `App` n) <- stripTicksTop tickishFloatable e2+ `App` n) <- stripStrTopTicks env e2 , unpk `hasKey` foldVariant- , Just (LitString s1) <- exprIsLiteral_maybe id_unf lit1- , Just (LitString s2) <- exprIsLiteral_maybe id_unf lit2+ , Just (LitString s1) <- exprIsLiteral_maybe env lit1+ , Just (LitString s2) <- exprIsLiteral_maybe env lit2 , let freeVars = (mkInScopeSet (exprFreeVars c1 `unionVarSet` exprFreeVars c2)) in eqExpr freeVars c1 c2- , (c1Ticks, c1') <- stripTicksTop tickishFloatable c1- , c2Ticks <- stripTicksTopT tickishFloatable c2+ , (c1Ticks, c1') <- stripStrTopTicks env c1+ , c2Ticks <- stripStrTopTicksT c2 = assert (ty1 `eqType` ty2) $ Just $ mkTicks strTicks $ Var unpk `App` Type ty1@@ -2390,26 +2452,44 @@ `App` mkTicks (c1Ticks ++ c2Ticks) c1' `App` n -match_append_lit _ _ _ _ _ = Nothing+match_cstring_foldr_lit _ _ _ _ _ = Nothing ++-- N.B. Ensure that we strip off any ticks (e.g. source notes) from the+-- argument, lest this may fail to fire when building with -g3. See #16740.+--+-- Also, look into variable's unfolding just in case the expression we look for+-- is in a top-level thunk.+stripStrTopTicks :: InScopeEnv -> CoreExpr -> ([CoreTickish], CoreExpr)+stripStrTopTicks (_,id_unf) e = case e of+ Var v+ | Just rhs <- expandUnfolding_maybe (id_unf v)+ -> stripTicksTop tickishFloatable rhs+ _ -> stripTicksTop tickishFloatable e++stripStrTopTicksT :: CoreExpr -> [CoreTickish]+stripStrTopTicksT e = stripTicksTopT tickishFloatable e+ --------------------------------------------------- -- The rule is this: -- eqString (unpackCString# (Lit s1)) (unpackCString# (Lit s2)) = s1==s2 -- Also matches unpackCStringUtf8# match_eq_string :: RuleFun-match_eq_string _ id_unf _- [Var unpk1 `App` lit1, Var unpk2 `App` lit2]- | unpk_key1 <- getUnique unpk1+match_eq_string _ env _ [e1, e2]+ | (ticks1, Var unpk1 `App` lit1) <- stripStrTopTicks env e1+ , (ticks2, Var unpk2 `App` lit2) <- stripStrTopTicks env e2+ , unpk_key1 <- getUnique unpk1 , unpk_key2 <- getUnique unpk2 , unpk_key1 == unpk_key2 -- For now we insist the literals have to agree in their encoding -- to keep the rule simple. But we could check if the decoded strings -- compare equal in here as well. , unpk_key1 `elem` [unpackCStringUtf8IdKey, unpackCStringIdKey]- , Just (LitString s1) <- exprIsLiteral_maybe id_unf lit1- , Just (LitString s2) <- exprIsLiteral_maybe id_unf lit2- = Just (if s1 == s2 then trueValBool else falseValBool)+ , Just (LitString s1) <- exprIsLiteral_maybe env lit1+ , Just (LitString s2) <- exprIsLiteral_maybe env lit2+ = Just $ mkTicks (ticks1 ++ ticks2)+ $ (if s1 == s2 then trueValBool else falseValBool) match_eq_string _ _ _ _ = Nothing @@ -2429,13 +2509,13 @@ -- function computing the length of such ByteStrings can often be constant -- folded. match_cstring_length :: RuleFun-match_cstring_length env id_unf _ [lit1]- | Just (LitString str) <- exprIsLiteral_maybe id_unf lit1+match_cstring_length rule_env env _ [lit1]+ | Just (LitString str) <- exprIsLiteral_maybe env lit1 -- If elemIndex returns Just, it has the index of the first embedded NUL -- in the string. If no NUL bytes are present (the common case) then use -- full length of the byte string. = let len = fromMaybe (BS.length str) (BS.elemIndex 0 str)- in Just (Lit (mkLitInt (roPlatform env) (fromIntegral len)))+ in Just (Lit (mkLitInt (roPlatform rule_env) (fromIntegral len))) match_cstring_length _ _ _ _ = Nothing ---------------------------------------------------@@ -2584,7 +2664,7 @@ addFoldingRules :: PrimOp -> NumOps -> RuleM CoreExpr addFoldingRules op num_ops = do massert (op == numAdd num_ops)- env <- getEnv+ env <- getRuleOpts guard (roNumConstantFolding env) [arg1,arg2] <- getArgs platform <- getPlatform@@ -2596,7 +2676,7 @@ subFoldingRules :: PrimOp -> NumOps -> RuleM CoreExpr subFoldingRules op num_ops = do massert (op == numSub num_ops)- env <- getEnv+ env <- getRuleOpts guard (roNumConstantFolding env) [arg1,arg2] <- getArgs platform <- getPlatform@@ -2605,7 +2685,7 @@ mulFoldingRules :: PrimOp -> NumOps -> RuleM CoreExpr mulFoldingRules op num_ops = do massert (op == numMul num_ops)- env <- getEnv+ env <- getRuleOpts guard (roNumConstantFolding env) [arg1,arg2] <- getArgs platform <- getPlatform@@ -2952,7 +3032,6 @@ , numLitType = LitNumWord32 } -#if WORD_SIZE_IN_BITS < 64 int64Ops :: NumOps int64Ops = NumOps { numAdd = Int64AddOp@@ -2968,7 +3047,6 @@ , numMul = Word64MulOp , numLitType = LitNumWord64 }-#endif intOps :: NumOps intOps = NumOps@@ -3189,4 +3267,126 @@ an alternative that is unreachable. You may wonder how this can happen: check out #15436.+++Note [Optimising conversions between numeric types]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Converting between numeric types is very common in Haskell codes. Suppose that+we have N inter-convertible numeric types (Word, Word8, Int, Integer, etc.).++- We don't want to have to use one conversion function per pair of types as that+would require N^2 functions: wordToWord8, wordToInt, wordToInteger...++- The following kind of class would allow us to have a single conversion+function at the price of N^2 instances and of the use of MultiParamTypeClasses+extension.++ class Convert a b where+ convert :: a -> b++What we do instead is that we use the Integer type (signed, unbounded) as a+passthrough type to perform every conversion. Hence we only need to define two+functions per numeric type:++ class Integral a where+ toInteger :: a -> Integer++ class Num a where+ fromInteger :: Integer -> a++These classes have a single parameter and can be derived automatically (e.g. for+newtypes). So we don't even have to define 2*N instances.++fromIntegral+------------++We can now define a generic conversion function:++ -- in the Prelude+ fromIntegral :: (Integral a, Num b) => a -> b+ fromIntegral = fromInteger . toInteger++The trouble with this approach is that performance might be terrible. E.g.+converting an Int into a Word, which is a no-op at the machine level, becomes+costly when performed via `fromIntegral` because an Integer has to be allocated.++To alleviate this:++- first `fromIntegral` was specialized (SPECIALIZE pragma). However it would+need N^2 pragmas to cover every case and it wouldn't cover user defined numeric+types which don't belong to base.++- while writing this note I discovered that we have a `-fwarn-identities` warning+to detect useless conversions (since 0656c72a8f):++ > fromIntegral (1 :: Int) :: Int++ <interactive>:3:21: warning: [-Widentities]+ Call of fromIntegral :: Int -> Int+ can probably be omitted++- but more importantly, many rules were added (e.g. in e0c787c10f):++ "fromIntegral/Int8->Int8" fromIntegral = id :: Int8 -> Int8+ "fromIntegral/a->Int8" fromIntegral = \x -> case fromIntegral x of I# x# -> I8# (intToInt8# x#)+ "fromIntegral/Int8->a" fromIntegral = \(I8# x#) -> fromIntegral (I# x#)++ The idea was to ensure that only cheap conversions ended up being used. E.g.:++ foo :: Int8 --> {- Integer -> -} -> Word8+ foo = fromIntegral++ ====> {Some fromIntegral rule for Int8}++ foo :: Int8 -> {- Int -> Integer -} -> Word8+ foo = fromIntegral . int8ToInt++ ====> {Some fromIntegral rule for Word8}++ foo :: Int8 -> {- Int -> Integer -> Word -} -> Word8+ foo = wordToWord8 . fromIntegral . int8ToInt++ ====> {Some fromIntegral rule for Int/Word}++ foo :: Int8 -> {- Int -> Word -} -> Word8+ foo = wordToWord8 . intToWord . int8ToInt+ -- not passing through Integer anymore!+++It worked but there were still some issues with this approach:++1. These rules only work for `fromIntegral`. If we wanted to define our own+ similar function (e.g. using other type-classes), we would also have to redefine+ all the rules to get similar performance.++2. `fromIntegral` had to be marked `NOINLINE [1]`:+ - NOINLINE to allow rules to match+ - [1] to allow inlining in later phases to avoid incurring a function call+ overhead for such a trivial operation++ Users of the function had to be careful because a simple helper without an+ INLINE pragma like:++ toInt :: Integral a => a -> Int+ toInt = fromIntegral++ has the following unfolding:++ toInt = integerToInt . toInteger++ which doesn't mention `fromIntegral` anymore. Hence `fromIntegral` rules+ wouldn't be triggered for any user of `toInt`. For this reason, we also have+ a bunch of rules for bignum primitives such as `integerToInt`.++3. These rewrite rules are tedious to write and error-prone (cf #19345).+++For these reasons, it is simpler to only rely on built-in rewrite rules for+bignum primitives. There aren't so many conversion primitives:+ - Natural <-> Word+ - Integer <-> Int/Word/Natural (+ Int64/Word64 on 32-bit arch)++All the built-in "small_passthrough_*" rules are used to avoid passing through+Integer/Natural. We now always inline `fromIntegral`.+ -}
+ compiler/GHC/Core/Reduction.hs view
@@ -0,0 +1,892 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE FlexibleContexts #-}++module GHC.Core.Reduction+ (+ -- * Reductions+ Reduction(..), ReductionN, ReductionR, HetReduction(..),+ Reductions(..),+ mkReduction, mkReductions, mkHetReduction, coercionRedn,+ reductionOriginalType,+ downgradeRedn, mkSubRedn,+ mkTransRedn, mkCoherenceRightRedn, mkCoherenceRightMRedn,+ mkCastRedn1, mkCastRedn2,+ mkReflRedn, mkGReflRightRedn, mkGReflRightMRedn,+ mkGReflLeftRedn, mkGReflLeftMRedn,+ mkAppRedn, mkAppRedns, mkFunRedn,+ mkForAllRedn, mkHomoForAllRedn, mkTyConAppRedn, mkClassPredRedn,+ mkProofIrrelRedn, mkReflCoRedn,+ homogeniseHetRedn,+ unzipRedns,++ -- * Rewriting type arguments+ ArgsReductions(..),+ simplifyArgsWorker++ ) where++import GHC.Prelude++import GHC.Core.Class ( Class(classTyCon) )+import GHC.Core.Coercion+import GHC.Core.Predicate ( mkClassPred )+import GHC.Core.TyCon ( TyCon )+import GHC.Core.Type++import GHC.Data.Pair ( Pair(Pair) )++import GHC.Types.Var ( setTyVarKind )+import GHC.Types.Var.Env ( mkInScopeSet )+import GHC.Types.Var.Set ( TyCoVarSet )++import GHC.Utils.Misc ( HasDebugCallStack, equalLength )+import GHC.Utils.Outputable+import GHC.Utils.Panic ( assertPpr, panic )++{-+%************************************************************************+%* *+ Reductions+%* *+%************************************************************************++Note [The Reduction type]+~~~~~~~~~~~~~~~~~~~~~~~~~+Many functions in the type-checker rewrite a type, using Given type equalitie+or type-family reductions, and return a Reduction, which is just a pair of the+coercion and the RHS type of the coercion:+ data Reduction = Reduction Coercion !Type++The order of the arguments to the constructor serves as a reminder+of what the Type is. In+ Reduction co ty+`ty` appears to the right of `co`, reminding us that we must have:+ co :: unrewritten_ty ~ ty++Example functions that use this datatype:+ GHC.Core.FamInstEnv.topNormaliseType_maybe+ :: FamInstEnvs -> Type -> Maybe Reduction+ GHC.Tc.Solver.Rewrite.rewrite+ :: CtEvidence -> TcType -> TcS Reduction++Having Reduction as a data type, with a strict Type field, rather than using+a pair (Coercion,Type) gives several advantages (see #20161)+* The strictness in Type improved performance in rewriting of type families+ (around 2.5% improvement in T9872),+* Compared to the situation before, it gives improved consistency around+ orientation of rewritings, as a Reduction is always left-to-right+ (the coercion's RHS type is always the type stored in the 'Reduction').+ No more 'mkSymCo's needed to convert between left-to-right and right-to-left.++One could imagine storing the LHS type of the coercion in the Reduction as well,+but in fact `reductionOriginalType` is very seldom used, so it's not worth it.+-}++-- | A 'Reduction' is the result of an operation that rewrites a type @ty_in@.+-- The 'Reduction' includes the rewritten type @ty_out@ and a 'Coercion' @co@+-- such that @co :: ty_in ~ ty_out@, where the role of the coercion is determined+-- by the context. That is, the LHS type of the coercion is the original type+-- @ty_in@, while its RHS type is the rewritten type @ty_out@.+--+-- A Reduction is always homogeneous, unless it is wrapped inside a 'HetReduction',+-- which separately stores the kind coercion.+--+-- See Note [The Reduction type].+data Reduction =+ Reduction+ { reductionCoercion :: Coercion+ , reductionReducedType :: !Type+ }+-- N.B. the 'Coercion' field must be lazy: see for instance GHC.Tc.Solver.Rewrite.rewrite_tyvar2+-- which returns an error in the 'Coercion' field when dealing with a Derived constraint+-- (which is OK as this Coercion gets ignored later).+-- We might want to revisit the strictness once Deriveds are removed.++-- | Stores a heterogeneous reduction.+--+-- The stored kind coercion must relate the kinds of the+-- stored reduction. That is, in @HetReduction (Reduction co xi) kco@,+-- we must have:+--+-- > co :: ty ~ xi+-- > kco :: typeKind ty ~ typeKind xi+data HetReduction =+ HetReduction+ Reduction+ MCoercionN+ -- N.B. strictness annotations don't seem to make a difference here++-- | Create a heterogeneous reduction.+--+-- Pre-condition: the provided kind coercion (second argument)+-- relates the kinds of the stored reduction.+-- That is, if the coercion stored in the 'Reduction' is of the form+--+-- > co :: ty ~ xi+--+-- Then the kind coercion supplied must be of the form:+--+-- > kco :: typeKind ty ~ typeKind xi+mkHetReduction :: Reduction -- ^ heterogeneous reduction+ -> MCoercionN -- ^ kind coercion+ -> HetReduction+mkHetReduction redn mco = HetReduction redn mco+{-# INLINE mkHetReduction #-}++-- | Homogenise a heterogeneous reduction.+--+-- Given @HetReduction (Reduction co xi) kco@, with+--+-- > co :: ty ~ xi+-- > kco :: typeKind(ty) ~ typeKind(xi)+--+-- this returns the homogeneous reduction:+--+-- > hco :: ty ~ ( xi |> sym kco )+homogeniseHetRedn :: Role -> HetReduction -> Reduction+homogeniseHetRedn role (HetReduction redn kco)+ = mkCoherenceRightMRedn role redn (mkSymMCo kco)+{-# INLINE homogeniseHetRedn #-}++-- | Create a 'Reduction' from a pair of a 'Coercion' and a 'Type.+--+-- Pre-condition: the RHS type of the coercion matches the provided type+-- (perhaps up to zonking).+--+-- Use 'coercionRedn' when you only have the coercion.+mkReduction :: Coercion -> Type -> Reduction+mkReduction co ty = Reduction co ty+{-# INLINE mkReduction #-}++instance Outputable Reduction where+ ppr redn =+ braces $ vcat+ [ text "reductionOriginalType:" <+> ppr (reductionOriginalType redn)+ , text " reductionReducedType:" <+> ppr (reductionReducedType redn)+ , text " reductionCoercion:" <+> ppr (reductionCoercion redn)+ ]++-- | A 'Reduction' in which the 'Coercion' has 'Nominal' role.+type ReductionN = Reduction++-- | A 'Reduction' in which the 'Coercion' has 'Representational' role.+type ReductionR = Reduction++-- | Get the original, unreduced type corresponding to a 'Reduction'.+--+-- This is obtained by computing the LHS kind of the stored coercion,+-- which may be slow.+reductionOriginalType :: Reduction -> Type+reductionOriginalType = coercionLKind . reductionCoercion+{-# INLINE reductionOriginalType #-}++-- | Turn a 'Coercion' into a 'Reduction'+-- by inspecting the RHS type of the coercion.+--+-- Prefer using 'mkReduction' when you already know+-- the RHS type of the coercion, to avoid computing it anew.+coercionRedn :: Coercion -> Reduction+coercionRedn co = Reduction co (coercionRKind co)+{-# INLINE coercionRedn #-}++-- | Downgrade the role of the coercion stored in the 'Reduction'.+downgradeRedn :: Role -- ^ desired role+ -> Role -- ^ current role+ -> Reduction+ -> Reduction+downgradeRedn new_role old_role redn@(Reduction co _)+ = redn { reductionCoercion = downgradeRole new_role old_role co }+{-# INLINE downgradeRedn #-}++-- | Downgrade the role of the coercion stored in the 'Reduction',+-- from 'Nominal' to 'Representational'.+mkSubRedn :: Reduction -> Reduction+mkSubRedn redn@(Reduction co _) = redn { reductionCoercion = mkSubCo co }+{-# INLINE mkSubRedn #-}++-- | Compose a reduction with a coercion on the left.+--+-- Pre-condition: the provided coercion's RHS type must match the LHS type+-- of the coercion that is stored in the reduction.+mkTransRedn :: Coercion -> Reduction -> Reduction+mkTransRedn co1 redn@(Reduction co2 _)+ = redn { reductionCoercion = co1 `mkTransCo` co2 }+{-# INLINE mkTransRedn #-}++-- | The reflexive reduction.+mkReflRedn :: Role -> Type -> Reduction+mkReflRedn r ty = mkReduction (mkReflCo r ty) ty++-- | Create a 'Reduction' from a kind cast, in which+-- the casted type is the rewritten type.+--+-- Given @ty :: k1@, @mco :: k1 ~ k2@,+-- produces the 'Reduction' @ty ~res_co~> (ty |> mco)@+-- at the given 'Role'.+mkGReflRightRedn :: Role -> Type -> CoercionN -> Reduction+mkGReflRightRedn role ty co+ = mkReduction+ (mkGReflRightCo role ty co)+ (mkCastTy ty co)+{-# INLINE mkGReflRightRedn #-}++-- | Create a 'Reduction' from a kind cast, in which+-- the casted type is the rewritten type.+--+-- Given @ty :: k1@, @mco :: k1 ~ k2@,+-- produces the 'Reduction' @ty ~res_co~> (ty |> mco)@+-- at the given 'Role'.+mkGReflRightMRedn :: Role -> Type -> MCoercionN -> Reduction+mkGReflRightMRedn role ty mco+ = mkReduction+ (mkGReflRightMCo role ty mco)+ (mkCastTyMCo ty mco)+{-# INLINE mkGReflRightMRedn #-}++-- | Create a 'Reduction' from a kind cast, in which+-- the casted type is the original (non-rewritten) type.+--+-- Given @ty :: k1@, @mco :: k1 ~ k2@,+-- produces the 'Reduction' @(ty |> mco) ~res_co~> ty@+-- at the given 'Role'.+mkGReflLeftRedn :: Role -> Type -> CoercionN -> Reduction+mkGReflLeftRedn role ty co+ = mkReduction+ (mkGReflLeftCo role ty co)+ ty+{-# INLINE mkGReflLeftRedn #-}++-- | Create a 'Reduction' from a kind cast, in which+-- the casted type is the original (non-rewritten) type.+--+-- Given @ty :: k1@, @mco :: k1 ~ k2@,+-- produces the 'Reduction' @(ty |> mco) ~res_co~> ty@+-- at the given 'Role'.+mkGReflLeftMRedn :: Role -> Type -> MCoercionN -> Reduction+mkGReflLeftMRedn role ty mco+ = mkReduction+ (mkGReflLeftMCo role ty mco)+ ty+{-# INLINE mkGReflLeftMRedn #-}++-- | Apply a cast to the result of a 'Reduction'.+--+-- Given a 'Reduction' @ty1 ~co1~> (ty2 :: k2)@ and a kind coercion @kco@+-- with LHS kind @k2@, produce a new 'Reduction' @ty1 ~co2~> ( ty2 |> kco )@+-- of the given 'Role' (which must match the role of the coercion stored+-- in the 'Reduction' argument).+mkCoherenceRightRedn :: Role -> Reduction -> CoercionN -> Reduction+mkCoherenceRightRedn r (Reduction co1 ty2) kco+ = mkReduction+ (mkCoherenceRightCo r ty2 kco co1)+ (mkCastTy ty2 kco)+{-# INLINE mkCoherenceRightRedn #-}++-- | Apply a cast to the result of a 'Reduction', using an 'MCoercionN'.+--+-- Given a 'Reduction' @ty1 ~co1~> (ty2 :: k2)@ and a kind coercion @mco@+-- with LHS kind @k2@, produce a new 'Reduction' @ty1 ~co2~> ( ty2 |> mco )@+-- of the given 'Role' (which must match the role of the coercion stored+-- in the 'Reduction' argument).+mkCoherenceRightMRedn :: Role -> Reduction -> MCoercionN -> Reduction+mkCoherenceRightMRedn r (Reduction co1 ty2) kco+ = mkReduction+ (mkCoherenceRightMCo r ty2 kco co1)+ (mkCastTyMCo ty2 kco)+{-# INLINE mkCoherenceRightMRedn #-}++-- | Apply a cast to a 'Reduction', casting both the original and the reduced type.+--+-- Given @cast_co@ and 'Reduction' @ty ~co~> xi@, this function returns+-- the 'Reduction' @(ty |> cast_co) ~return_co~> (xi |> cast_co)@+-- of the given 'Role' (which must match the role of the coercion stored+-- in the 'Reduction' argument).+--+-- Pre-condition: the 'Type' passed in is the same as the LHS type+-- of the coercion stored in the 'Reduction'.+mkCastRedn1 :: Role+ -> Type -- ^ original type+ -> CoercionN -- ^ coercion to cast with+ -> Reduction -- ^ rewritten type, with rewriting coercion+ -> Reduction+mkCastRedn1 r ty cast_co (Reduction co xi)+ -- co :: ty ~r ty'+ -- return_co :: (ty |> cast_co) ~r (ty' |> cast_co)+ = mkReduction+ (castCoercionKind1 co r ty xi cast_co)+ (mkCastTy xi cast_co)+{-# INLINE mkCastRedn1 #-}++-- | Apply casts on both sides of a 'Reduction' (of the given 'Role').+--+-- Use 'mkCastRedn1' when you want to cast both the original and reduced types+-- in a 'Reduction' using the same coercion.+--+-- Pre-condition: the 'Type' passed in is the same as the LHS type+-- of the coercion stored in the 'Reduction'.+mkCastRedn2 :: Role+ -> Type -- ^ original type+ -> CoercionN -- ^ coercion to cast with on the left+ -> Reduction -- ^ rewritten type, with rewriting coercion+ -> CoercionN -- ^ coercion to cast with on the right+ -> Reduction+mkCastRedn2 r ty cast_co (Reduction nco nty) cast_co'+ = mkReduction+ (castCoercionKind2 nco r ty nty cast_co cast_co')+ (mkCastTy nty cast_co')+{-# INLINE mkCastRedn2 #-}++-- | Apply one 'Reduction' to another.+--+-- Combines 'mkAppCo' and 'mkAppTy`.+mkAppRedn :: Reduction -> Reduction -> Reduction+mkAppRedn (Reduction co1 ty1) (Reduction co2 ty2)+ = mkReduction (mkAppCo co1 co2) (mkAppTy ty1 ty2)+{-# INLINE mkAppRedn #-}++-- | Create a function 'Reduction'.+--+-- Combines 'mkFunCo' and 'mkFunTy'.+mkFunRedn :: Role+ -> AnonArgFlag+ -> ReductionN -- ^ multiplicity reduction+ -> Reduction -- ^ argument reduction+ -> Reduction -- ^ result reduction+ -> Reduction+mkFunRedn r vis+ (Reduction w_co w_ty)+ (Reduction arg_co arg_ty)+ (Reduction res_co res_ty)+ = mkReduction+ (mkFunCo r w_co arg_co res_co)+ (mkFunTy vis w_ty arg_ty res_ty)+{-# INLINE mkFunRedn #-}++-- | Create a 'Reduction' associated to a Π type,+-- from a kind 'Reduction' and a body 'Reduction'.+--+-- Combines 'mkForAllCo' and 'mkForAllTy'.+mkForAllRedn :: ArgFlag+ -> TyVar+ -> ReductionN -- ^ kind reduction+ -> Reduction -- ^ body reduction+ -> Reduction+mkForAllRedn vis tv1 (Reduction h ki') (Reduction co ty)+ = mkReduction+ (mkForAllCo tv1 h co)+ (mkForAllTy tv2 vis ty)+ where+ tv2 = setTyVarKind tv1 ki'+{-# INLINE mkForAllRedn #-}++-- | Create a 'Reduction' of a quantified type from a+-- 'Reduction' of the body.+--+-- Combines 'mkHomoForAllCos' and 'mkForAllTys'.+mkHomoForAllRedn :: [TyVarBinder] -> Reduction -> Reduction+mkHomoForAllRedn bndrs (Reduction co ty)+ = mkReduction+ (mkHomoForAllCos (binderVars bndrs) co)+ (mkForAllTys bndrs ty)+{-# INLINE mkHomoForAllRedn #-}++-- | Create a 'Reduction' from a coercion between coercions.+--+-- Combines 'mkProofIrrelCo' and 'mkCoercionTy'.+mkProofIrrelRedn :: Role -- ^ role of the created coercion, "r"+ -> CoercionN -- ^ co :: phi1 ~N phi2+ -> Coercion -- ^ g1 :: phi1+ -> Coercion -- ^ g2 :: phi2+ -> Reduction -- ^ res_co :: g1 ~r g2+mkProofIrrelRedn role co g1 g2+ = mkReduction+ (mkProofIrrelCo role co g1 g2)+ (mkCoercionTy g2)+{-# INLINE mkProofIrrelRedn #-}++-- | Create a reflexive 'Reduction' whose RHS is the given 'Coercion',+-- with the specified 'Role'.+mkReflCoRedn :: Role -> Coercion -> Reduction+mkReflCoRedn role co+ = mkReduction+ (mkReflCo role co_ty)+ co_ty+ where+ co_ty = mkCoercionTy co+{-# INLINE mkReflCoRedn #-}++-- | A collection of 'Reduction's where the coercions and the types are stored separately.+--+-- Use 'unzipRedns' to obtain 'Reductions' from a list of 'Reduction's.+--+-- This datatype is used in 'mkAppRedns', 'mkClassPredRedns' and 'mkTyConAppRedn',+-- which expect separate types and coercions.+--+-- Invariant: the two stored lists are of the same length,+-- and the RHS type of each coercion is the corresponding type.+data Reductions = Reductions [Coercion] [Type]++-- | Create 'Reductions' from individual lists of coercions and types.+--+-- The lists should be of the same length, and the RHS type of each coercion+-- should match the specified type in the other list.+mkReductions :: [Coercion] -> [Type] -> Reductions+mkReductions cos tys = Reductions cos tys+{-# INLINE mkReductions #-}++-- | Combines 'mkAppCos' and 'mkAppTys'.+mkAppRedns :: Reduction -> Reductions -> Reduction+mkAppRedns (Reduction co ty) (Reductions cos tys)+ = mkReduction (mkAppCos co cos) (mkAppTys ty tys)+{-# INLINE mkAppRedns #-}++-- | 'TyConAppCo' for 'Reduction's: combines 'mkTyConAppCo' and `mkTyConApp`.+mkTyConAppRedn :: Role -> TyCon -> Reductions -> Reduction+mkTyConAppRedn role tc (Reductions cos tys)+ = mkReduction (mkTyConAppCo role tc cos) (mkTyConApp tc tys)+{-# INLINE mkTyConAppRedn #-}++-- | Reduce the arguments of a 'Class' 'TyCon'.+mkClassPredRedn :: Class -> Reductions -> Reduction+mkClassPredRedn cls (Reductions cos tys)+ = mkReduction+ (mkTyConAppCo Nominal (classTyCon cls) cos)+ (mkClassPred cls tys)+{-# INLINE mkClassPredRedn #-}++-- | Obtain 'Reductions' from a list of 'Reduction's by unzipping.+unzipRedns :: [Reduction] -> Reductions+unzipRedns = foldr accRedn (Reductions [] [])+ where+ accRedn :: Reduction -> Reductions -> Reductions+ accRedn (Reduction co xi) (Reductions cos xis)+ = Reductions (co:cos) (xi:xis)+{-# INLINE unzipRedns #-}+-- NB: this function is currently used in two locations:+--+-- - GHC.Tc.Gen.Foreign.normaliseFfiType', with one call of the form:+--+-- unzipRedns <$> zipWithM f tys roles+--+-- - GHC.Tc.Solver.Monad.breakTyVarCycle_maybe, with two calls of the form:+--+-- unzipRedns <$> mapM f tys+--+-- It is possible to write 'mapAndUnzipM' functions to handle these cases,+-- but the above locations aren't performance critical, so it was deemed+-- to not be worth it.++{-+%************************************************************************+%* *+ Simplifying types+%* *+%************************************************************************++The function below morally belongs in GHC.Tc.Solver.Rewrite, but it is used also in+FamInstEnv, and so lives here.++Note [simplifyArgsWorker]+~~~~~~~~~~~~~~~~~~~~~~~~~+Invariant (F2) of Note [Rewriting] in GHC.Tc.Solver.Rewrite says that+rewriting is homogeneous.+This causes some trouble when rewriting a function applied to a telescope+of arguments, perhaps with dependency. For example, suppose++ type family F :: forall (j :: Type) (k :: Type). Maybe j -> Either j k -> Bool -> [k]++and we wish to rewrite the args of (with kind applications explicit)++ F @a @b (Just @a c) (Right @a @b d) False++where all variables are skolems and++ a :: Type+ b :: Type+ c :: a+ d :: b++ [G] aco :: a ~ fa+ [G] bco :: b ~ fb+ [G] cco :: c ~ fc+ [G] dco :: d ~ fd++The first step is to rewrite all the arguments. This is done before calling+simplifyArgsWorker. We start from++ a+ b+ Just @a c+ Right @a @b d+ False++and get left-to-right reductions whose coercions are as follows:++ co1 :: a ~ fa+ co2 :: b ~ fb+ co3 :: (Just @a c) ~ (Just @fa (fc |> aco) |> co6)+ co4 :: (Right @a @b d) ~ (Right @fa @fb (fd |> bco) |> co7)+ co5 :: False ~ False++where+ co6 = Maybe (sym aco) :: Maybe fa ~ Maybe a+ co7 = Either (sym aco) (sym bco) :: Either fa fb ~ Either a b++We now process the rewritten args in left-to-right order. The first two args+need no further processing. But now consider the third argument. Let f3 = the rewritten+result, Just fa (fc |> aco) |> co6.+This f3 rewritten argument has kind (Maybe a), due to homogeneity of rewriting (F2).+And yet, when we build the application (F @fa @fb ...), we need this+argument to have kind (Maybe fa), not (Maybe a). We must cast this argument.+The coercion to use is determined by the kind of F:+we see in F's kind that the third argument has kind Maybe j.+Critically, we also know that the argument corresponding to j+(in our example, a) rewrote with a coercion co1. We can thus know the+coercion needed for the 3rd argument is (Maybe co1), thus building+(f3 |> Maybe co1)++More generally, we must use the Lifting Lemma, as implemented in+Coercion.liftCoSubst. As we work left-to-right, any variable that is a+dependent parameter (j and k, in our example) gets mapped in a lifting context+to the coercion that is output from rewriting the corresponding argument (co1+and co2, in our example). Then, after rewriting later arguments, we lift the+kind of these arguments in the lifting context that we've be building up.+This coercion is then used to keep the result of rewriting well-kinded.++Working through our example, this is what happens:++ 1. Extend the (empty) LC with [j |-> co1]. No new casting must be done,+ because the binder associated with the first argument has a closed type (no+ variables).++ 2. Extend the LC with [k |-> co2]. No casting to do.++ 3. Lifting the kind (Maybe j) with our LC+ yields co8 :: Maybe a ~ Maybe fa. Use (f3 |> co8) as the argument to F.++ 4. Lifting the kind (Either j k) with our LC+ yields co9 :: Either a b ~ Either fa fb. Use (f4 |> co9) as the 4th+ argument to F, where f4 is the rewritten form of argument 4, written above.++ 5. We lift Bool with our LC, getting <Bool>; casting has no effect.++We're now almost done, but the new application++ F @fa @fb (f3 |> co8) (f4 |> co9) False++has the wrong kind. Its kind is [fb], instead of the original [b].+So we must use our LC one last time to lift the result kind [k],+getting res_co :: [fb] ~ [b], and we cast our result.++Accordingly, the final result is++ F+ @fa+ @fb+ (Just @fa (fc |> aco) |> Maybe (sym aco) |> sym (Maybe (sym aco)))+ (Right @fa @fb (fd |> bco) |> Either (sym aco) (sym bco) |> sym (Either (sym aco) (sym bco)))+ False+ |> [sym bco]++The res_co (in this case, [sym bco]) is the third component of the+tuple returned by simplifyArgsWorker.++Note [Last case in simplifyArgsWorker]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+In writing simplifyArgsWorker's `go`, we know here that args cannot be empty,+because that case is first. We've run out of+binders. But perhaps inner_ki is a tyvar that has been instantiated with a+Π-type.++Here is an example.++ a :: forall (k :: Type). k -> k+ Proxy :: forall j. j -> Type+ type family Star+ axStar :: Star ~ Type+ type family NoWay :: Bool+ axNoWay :: NoWay ~ False+ bo :: Type+ [G] bc :: bo ~ Bool (in inert set)++ co :: (forall j. j -> Type) ~ (forall (j :: Star). (j |> axStar) -> Star)+ co = forall (j :: sym axStar). (<j> -> sym axStar)++ We are rewriting:+ a (forall (j :: Star). (j |> axStar) -> Star) -- 1+ (Proxy |> co) -- 2+ (bo |> sym axStar) -- 3+ (NoWay |> sym bc) -- 4+ :: Star++First, we rewrite all the arguments (before simplifyArgsWorker), like so:++ co1 :: (forall (j :: Star). (j |> axStar) -> Star) ~ (forall j. j -> Type) -- 1+ co2 :: (Proxy |> co) ~ (Proxy |> co) -- 2+ co3 :: (bo |> sym axStar) ~ (Bool |> sym axStar) -- 3+ co4 :: (NoWay |> sym bc) ~ (False |> sym bc) -- 4++Then we do the process described in Note [simplifyArgsWorker].++1. Lifting Type (the kind of the first arg) gives us a reflexive coercion, so we+ don't use it. But we do build a lifting context [k -> co1] (where co1 is a+ result of rewriting an argument, written above).++2. Lifting k gives us co1, so the second argument becomes (Proxy |> co |> co1).+ This is not a dependent argument, so we don't extend the lifting context.++Now we need to deal with argument (3).+The way we normally proceed is to lift the kind of the binder, to see whether+it's dependent.+But here, the remainder of the kind of `a` that we're left with+after processing two arguments is just `k`.++The way forward is look up k in the lifting context, getting co1. If we're at+all well-typed, co1 will be a coercion between Π-types, with at least one binder.+So, let's decompose co1 with decomposePiCos. This decomposition needs arguments to use+to instantiate any kind parameters. Look at the type of co1. If we just+decomposed it, we would end up with coercions whose types include j, which is+out of scope here. Accordingly, decomposePiCos takes a list of types whose+kinds are the *unrewritten* types in the decomposed coercion. (See comments on+decomposePiCos.) Because the rewritten types have unrewritten kinds (because+rewriting is homogeneous), passing the list of rewritten types to decomposePiCos+just won't do: later arguments' kinds won't be as expected. So we need to get+the *unrewritten* types to pass to decomposePiCos. We can do this easily enough+by taking the kind of the argument coercions, passed in originally.++(Alternative 1: We could re-engineer decomposePiCos to deal with this situation.+But that function is already gnarly, and other call sites of decomposePiCos+would suffer from the change, even though they are much more common than this one.)++(Alternative 2: We could avoid calling decomposePiCos entirely, integrating its+behavior into simplifyArgsWorker. This would work, I think, but then all of the+complication of decomposePiCos would end up layered on top of all the complication+here. Please, no.)++(Alternative 3: We could pass the unrewritten arguments into simplifyArgsWorker+so that we don't have to recreate them. But that would complicate the interface+of this function to handle a very dark, dark corner case. Better to keep our+demons to ourselves here instead of exposing them to callers. This decision is+easily reversed if there is ever any performance trouble due to the call of+coercionKind.)++So we now call++ decomposePiCos co1+ (Pair (forall (j :: Star). (j |> axStar) -> Star) (forall j. j -> Type))+ [bo |> sym axStar, NoWay |> sym bc]++to get++ co5 :: Star ~ Type+ co6 :: (j |> axStar) ~ (j |> co5), substituted to+ (bo |> sym axStar |> axStar) ~ (bo |> sym axStar |> co5)+ == bo ~ bo+ res_co :: Type ~ Star++We then use these casts on (the rewritten) (3) and (4) to get++ (Bool |> sym axStar |> co5 :: Type) -- (C3)+ (False |> sym bc |> co6 :: bo) -- (C4)++We can simplify to++ Bool -- (C3)+ (False |> sym bc :: bo) -- (C4)++Of course, we still must do the processing in Note [simplifyArgsWorker] to finish+the job. We thus want to recur. Our new function kind is the left-hand type of+co1 (gotten, recall, by lifting the variable k that was the return kind of the+original function). Why the left-hand type (as opposed to the right-hand type)?+Because we have casted all the arguments according to decomposePiCos, which gets+us from the right-hand type to the left-hand one. We thus recur with that new+function kind, zapping our lifting context, because we have essentially applied+it.++This recursive call returns ([Bool, False], [...], Refl). The Bool and False+are the correct arguments we wish to return. But we must be careful about the+result coercion: our new, rewritten application will have kind Type, but we+want to make sure that the result coercion casts this back to Star. (Why?+Because we started with an application of kind Star, and rewriting is homogeneous.)++So, we have to twiddle the result coercion appropriately.++Let's check whether this is well-typed. We know++ a :: forall (k :: Type). k -> k++ a (forall j. j -> Type) :: (forall j. j -> Type) -> forall j. j -> Type++ a (forall j. j -> Type)+ Proxy+ :: forall j. j -> Type++ a (forall j. j -> Type)+ Proxy+ Bool+ :: Bool -> Type++ a (forall j. j -> Type)+ Proxy+ Bool+ False+ :: Type++ a (forall j. j -> Type)+ Proxy+ Bool+ False+ |> res_co+ :: Star++as desired.++Whew.++Historical note: I (Richard E) once thought that the final part of the kind+had to be a variable k (as in the example above). But it might not be: it could+be an application of a variable. Here is the example:++ let f :: forall (a :: Type) (b :: a -> Type). b (Any @a)+ k :: Type+ x :: k++ rewrite (f @Type @((->) k) x)++After instantiating [a |-> Type, b |-> ((->) k)], we see that `b (Any @a)`+is `k -> Any @a`, and thus the third argument of `x :: k` is well-kinded.++-}++-- | Stores 'Reductions' as well as a kind coercion.+--+-- Used when rewriting arguments to a type function @f@.+--+-- Invariant:+-- when the stored reductions are of the form+-- co_i :: ty_i ~ xi_i,+-- the kind coercion is of the form+-- kco :: typeKind (f ty_1 ... ty_n) ~ typeKind (f xi_1 ... xi_n)+--+-- The type function @f@ depends on context.+data ArgsReductions =+ ArgsReductions+ {-# UNPACK #-} !Reductions+ !MCoercionN+ -- The strictness annotations and UNPACK pragma here are crucial+ -- to getting good performance in simplifyArgsWorker's tight loop.++-- This is shared between the rewriter and the normaliser in GHC.Core.FamInstEnv.+-- See Note [simplifyArgsWorker]+{-# INLINE simplifyArgsWorker #-}+-- NB. INLINE yields a ~1% decrease in allocations in T9872d compared to INLINEABLE+-- This function is only called in two locations, so the amount of code duplication+-- should be rather reasonable despite the size of the function.+simplifyArgsWorker :: HasDebugCallStack+ => [TyCoBinder] -> Kind+ -- the binders & result kind (not a Π-type) of the function applied to the args+ -- list of binders can be shorter or longer than the list of args+ -> TyCoVarSet -- free vars of the args+ -> [Role] -- list of roles, r+ -> [Reduction] -- rewritten type arguments, arg_i+ -- each comes with the coercion used to rewrite it,+ -- arg_co_i :: ty_i ~ arg_i+ -> ArgsReductions+-- Returns ArgsReductions (Reductions cos xis) res_co, where co_i :: ty_i ~ xi_i,+-- and res_co :: kind (f ty_1 ... ty_n) ~ kind (f xi_1 ... xi_n), where f is the function+-- that we are applying.+-- Precondition: if f :: forall bndrs. inner_ki (where bndrs and inner_ki are passed in),+-- then (f ty_1 ... ty_n) is well kinded. Note that (f arg_1 ... arg_n) might *not* be well-kinded.+-- Massaging the arg_i in order to make the function application well-kinded is what this+-- function is all about. That is, (f xi_1 ... xi_n), where xi_i are the returned arguments,+-- *is* well kinded.+simplifyArgsWorker orig_ki_binders orig_inner_ki orig_fvs+ orig_roles orig_simplified_args+ = go orig_lc+ orig_ki_binders orig_inner_ki+ orig_roles orig_simplified_args+ where+ orig_lc = emptyLiftingContext $ mkInScopeSet $ orig_fvs++ go :: LiftingContext -- mapping from tyvars to rewriting coercions+ -> [TyCoBinder] -- Unsubsted binders of function's kind+ -> Kind -- Unsubsted result kind of function (not a Pi-type)+ -> [Role] -- Roles at which to rewrite these ...+ -> [Reduction] -- rewritten arguments, with their rewriting coercions+ -> ArgsReductions+ go !lc binders inner_ki _ []+ -- The !lc makes the function strict in the lifting context+ -- which means GHC can unbox that pair. A modest win.+ = ArgsReductions+ (mkReductions [] [])+ kind_co+ where+ final_kind = mkPiTys binders inner_ki+ kind_co | noFreeVarsOfType final_kind = MRefl+ | otherwise = MCo $ liftCoSubst Nominal lc final_kind++ go lc (binder:binders) inner_ki (role:roles) (arg_redn:arg_redns)+ = -- We rewrite an argument ty with arg_redn = Reduction arg_co arg+ -- By Note [Rewriting] in GHC.Tc.Solver.Rewrite invariant (F2),+ -- tcTypeKind(ty) = tcTypeKind(arg).+ -- However, it is possible that arg will be used as an argument to a function+ -- whose kind is different, if earlier arguments have been rewritten.+ -- We thus need to compose the reduction with a kind coercion to ensure+ -- well-kindedness (see the call to mkCoherenceRightRedn below).+ --+ -- The bangs here have been observed to improve performance+ -- significantly in optimized builds; see #18502+ let !kind_co = liftCoSubst Nominal lc (tyCoBinderType binder)+ !(Reduction casted_co casted_xi)+ = mkCoherenceRightRedn role arg_redn kind_co+ -- now, extend the lifting context with the new binding+ !new_lc | Just tv <- tyCoBinderVar_maybe binder+ = extendLiftingContextAndInScope lc tv casted_co+ | otherwise+ = lc+ !(ArgsReductions (Reductions cos xis) final_kind_co)+ = go new_lc binders inner_ki roles arg_redns+ in ArgsReductions+ (Reductions (casted_co:cos) (casted_xi:xis))+ final_kind_co++ -- See Note [Last case in simplifyArgsWorker]+ go lc [] inner_ki roles arg_redns+ = let co1 = liftCoSubst Nominal lc inner_ki+ co1_kind = coercionKind co1+ unrewritten_tys = map reductionOriginalType arg_redns+ (arg_cos, res_co) = decomposePiCos co1 co1_kind unrewritten_tys+ casted_args = assertPpr (equalLength arg_redns arg_cos)+ (ppr arg_redns $$ ppr arg_cos)+ $ zipWith3 mkCoherenceRightRedn roles arg_redns arg_cos+ -- In general decomposePiCos can return fewer cos than tys,+ -- but not here; because we're well typed, there will be enough+ -- binders. Note that decomposePiCos does substitutions, so even+ -- if the original substitution results in something ending with+ -- ... -> k, that k will be substituted to perhaps reveal more+ -- binders.+ zapped_lc = zapLiftingContext lc+ Pair rewritten_kind _ = co1_kind+ (bndrs, new_inner) = splitPiTys rewritten_kind++ ArgsReductions redns_out res_co_out+ = go zapped_lc bndrs new_inner roles casted_args+ in+ ArgsReductions redns_out (res_co `mkTransMCoR` res_co_out)++ go _ _ _ _ _ = panic+ "simplifyArgsWorker wandered into deeper water than usual"+ -- This debug information is commented out because leaving it in+ -- causes a ~2% increase in allocations in T9872d.+ -- That's independent of the analogous case in rewrite_args_fast+ -- in GHC.Tc.Solver.Rewrite:+ -- each of these causes a 2% increase on its own, so commenting them+ -- both out gives a 4% decrease in T9872d.+ {-++ (vcat [ppr orig_binders,+ ppr orig_inner_ki,+ ppr (take 10 orig_roles), -- often infinite!+ ppr orig_tys])+ -}
compiler/GHC/Core/Rules.hs view
@@ -391,11 +391,11 @@ -- See Note [Extra args in rule matching] -- See comments on matchRule-lookupRule opts in_scope is_active fn args rules+lookupRule opts rule_env@(in_scope,_) is_active fn args rules = -- pprTrace "matchRules" (ppr fn <+> ppr args $$ ppr rules ) $ case go [] rules of [] -> Nothing- (m:ms) -> Just (findBest (fn,args') m ms)+ (m:ms) -> Just (findBest in_scope (fn,args') m ms) where rough_args = map roughTopName args @@ -408,7 +408,7 @@ go :: [(CoreRule,CoreExpr)] -> [CoreRule] -> [(CoreRule,CoreExpr)] go ms [] = ms go ms (r:rs)- | Just e <- matchRule opts in_scope is_active fn args' rough_args r+ | Just e <- matchRule opts rule_env is_active fn args' rough_args r = go ((r,mkTicks ticks e):ms) rs | otherwise = -- pprTrace "match failed" (ppr r $$ ppr args $$@@ -418,16 +418,16 @@ -- , isCheapUnfolding unf] ) go ms rs -findBest :: (Id, [CoreExpr])+findBest :: InScopeSet -> (Id, [CoreExpr]) -> (CoreRule,CoreExpr) -> [(CoreRule,CoreExpr)] -> (CoreRule,CoreExpr) -- All these pairs matched the expression -- Return the pair the most specific rule -- The (fn,args) is just for overlap reporting -findBest _ (rule,ans) [] = (rule,ans)-findBest target (rule1,ans1) ((rule2,ans2):prs)- | rule1 `isMoreSpecific` rule2 = findBest target (rule1,ans1) prs- | rule2 `isMoreSpecific` rule1 = findBest target (rule2,ans2) prs+findBest _ _ (rule,ans) [] = (rule,ans)+findBest in_scope target (rule1,ans1) ((rule2,ans2):prs)+ | isMoreSpecific in_scope rule1 rule2 = findBest in_scope target (rule1,ans1) prs+ | isMoreSpecific in_scope rule2 rule1 = findBest in_scope target (rule2,ans2) prs | debugIsOn = let pp_rule rule = ifPprDebug (ppr rule) (doubleQuotes (ftext (ruleName rule)))@@ -437,12 +437,12 @@ <+> sep (map ppr args) , text "Rule 1:" <+> pp_rule rule1 , text "Rule 2:" <+> pp_rule rule2]) $- findBest target (rule1,ans1) prs- | otherwise = findBest target (rule1,ans1) prs+ findBest in_scope target (rule1,ans1) prs+ | otherwise = findBest in_scope target (rule1,ans1) prs where (fn,args) = target -isMoreSpecific :: CoreRule -> CoreRule -> Bool+isMoreSpecific :: InScopeSet -> CoreRule -> CoreRule -> Bool -- This tests if one rule is more specific than another -- We take the view that a BuiltinRule is less specific than -- anything else, because we want user-define rules to "win"@@ -453,17 +453,16 @@ -- {-# RULES "truncate/Double->Int" truncate = double2Int #-} -- double2Int :: Double -> Int -- We want the specific RULE to beat the built-in class-op rule-isMoreSpecific (BuiltinRule {}) _ = False-isMoreSpecific (Rule {}) (BuiltinRule {}) = True-isMoreSpecific (Rule { ru_bndrs = bndrs1, ru_args = args1 })- (Rule { ru_bndrs = bndrs2, ru_args = args2- , ru_name = rule_name2, ru_rhs = rhs })- = isJust (matchN (in_scope, id_unfolding_fun) rule_name2 bndrs2 args2 args1 rhs)+isMoreSpecific _ (BuiltinRule {}) _ = False+isMoreSpecific _ (Rule {}) (BuiltinRule {}) = True+isMoreSpecific in_scope (Rule { ru_bndrs = bndrs1, ru_args = args1 })+ (Rule { ru_bndrs = bndrs2, ru_args = args2+ , ru_name = rule_name2, ru_rhs = rhs2 })+ = isJust (matchN (full_in_scope, id_unfolding_fun)+ rule_name2 bndrs2 args2 args1 rhs2) where id_unfolding_fun _ = NoUnfolding -- Don't expand in templates- in_scope = mkInScopeSet (mkVarSet bndrs1)- -- Actually we should probably include the free vars- -- of rule1's args, but I can't be bothered+ full_in_scope = in_scope `extendInScopeSetList` bndrs1 noBlackList :: Activation -> Bool noBlackList _ = False -- Nothing is black listed@@ -520,12 +519,12 @@ Nothing -> Nothing Just expr -> Just expr -matchRule _ in_scope is_active _ args rough_args+matchRule _ rule_env is_active _ args rough_args (Rule { ru_name = rule_name, ru_act = act, ru_rough = tpl_tops , ru_bndrs = tpl_vars, ru_args = tpl_args, ru_rhs = rhs }) | not (is_active act) = Nothing | ruleCantMatch tpl_tops rough_args = Nothing- | otherwise = matchN in_scope rule_name tpl_vars tpl_args args rhs+ | otherwise = matchN rule_env rule_name tpl_vars tpl_args args rhs -- | Initialize RuleOpts from DynFlags@@ -706,7 +705,7 @@ data RuleSubst = RS { rs_tv_subst :: TvSubstEnv -- Range is the , rs_id_subst :: IdSubstEnv -- template variables , rs_binds :: BindWrapper -- Floated bindings- , rs_bndrs :: VarSet -- Variables bound by floated lets+ , rs_bndrs :: [Var] -- Variables bound by floated lets } type BindWrapper = CoreExpr -> CoreExpr@@ -715,7 +714,7 @@ emptyRuleSubst :: RuleSubst emptyRuleSubst = RS { rs_tv_subst = emptyVarEnv, rs_id_subst = emptyVarEnv- , rs_binds = \e -> e, rs_bndrs = emptyVarSet }+ , rs_binds = \e -> e, rs_bndrs = [] } -- At one stage I tried to match even if there are more -- template args than real args.@@ -778,14 +777,19 @@ | -- pprTrace "match:Let" (vcat [ppr bind, ppr $ okToFloat (rv_lcl renv) (bindFreeVars bind)]) $ not (isJoinBind bind) -- can't float join point out of argument position , okToFloat (rv_lcl renv) (bindFreeVars bind) -- See Note [Matching lets]- = match (renv { rv_fltR = flt_subst' })+ = match (renv { rv_fltR = flt_subst'+ , rv_lcl = rv_lcl renv `extendRnInScopeSetList` new_bndrs })+ -- We are floating the let-binding out, as if it had enclosed+ -- the entire target from Day 1. So we must add its binders to+ -- the in-scope set (#20200) (subst { rs_binds = rs_binds subst . Let bind'- , rs_bndrs = extendVarSetList (rs_bndrs subst) new_bndrs })+ , rs_bndrs = new_bndrs ++ rs_bndrs subst }) e1 e2+ | otherwise+ = Nothing where- flt_subst = addInScopeSet (rv_fltR renv) (rs_bndrs subst)- (flt_subst', bind') = substBind flt_subst bind- new_bndrs = bindersOf bind'+ (flt_subst', bind') = substBind (rv_fltR renv) bind+ new_bndrs = bindersOf bind' {- Disabled: see Note [Matching cases] below match renv (tv_subst, id_subst, binds) e1@@ -812,15 +816,14 @@ match renv subst (Lam x1 e1) e2 | Just (x2, e2, ts) <- exprIsLambda_maybe (rvInScopeEnv renv) e2- = let renv' = renv { rv_lcl = rnBndr2 (rv_lcl renv) x1 x2- , rv_fltR = delBndr (rv_fltR renv) x2 }+ = let renv' = rnMatchBndr2 renv x1 x2 subst' = subst { rs_binds = rs_binds subst . flip (foldr mkTick) ts } in match renv' subst' e1 e2 match renv subst (Case e1 x1 ty1 alts1) (Case e2 x2 ty2 alts2) = do { subst1 <- match_ty renv subst ty1 ty2 ; subst2 <- match renv subst1 e1 e2- ; let renv' = rnMatchBndr2 renv subst x1 x2+ ; let renv' = rnMatchBndr2 renv x1 x2 ; match_alts renv' subst2 alts1 alts2 -- Alts are both sorted } @@ -882,15 +885,12 @@ match_cos _ _ cos1 cos2 = pprTrace "match_cos: not same length" (ppr cos1 $$ ppr cos2) Nothing --------------rnMatchBndr2 :: RuleMatchEnv -> RuleSubst -> Var -> Var -> RuleMatchEnv-rnMatchBndr2 renv subst x1 x2- = renv { rv_lcl = rnBndr2 rn_env x1 x2+rnMatchBndr2 :: RuleMatchEnv -> Var -> Var -> RuleMatchEnv+rnMatchBndr2 renv x1 x2+ = renv { rv_lcl = rnBndr2 (rv_lcl renv) x1 x2 , rv_fltR = delBndr (rv_fltR renv) x2 }- where- rn_env = addRnInScopeSet (rv_lcl renv) (rs_bndrs subst)- -- Typically this is a no-op, but it may matter if- -- there are some floated let-bindings + ------------------------------------------ match_alts :: RuleMatchEnv -> RuleSubst@@ -905,7 +905,7 @@ ; match_alts renv subst1 alts1 alts2 } where renv' = foldl' mb renv (vs1 `zip` vs2)- mb renv (v1,v2) = rnMatchBndr2 renv subst v1 v2+ mb renv (v1,v2) = rnMatchBndr2 renv v1 v2 match_alts _ _ _ _ = Nothing@@ -930,12 +930,19 @@ | otherwise -- v1' is not a template variable; check for an exact match with e2 = case e2 of -- Remember, envR of rn_env is disjoint from rv_fltR- Var v2 | v1' == rnOccR rn_env v2- -> Just subst+ Var v2 | Just v2' <- rnOccR_maybe rn_env v2+ -> -- v2 was bound by a nested lambda or case+ if v1' == v2' then Just subst+ else Nothing + -- v2 is not bound nestedly; it is free+ -- in the whole expression being matched+ -- So it will be in the InScopeSet for flt_env (#20200) | Var v2' <- lookupIdSubst flt_env v2 , v1' == v2' -> Just subst+ | otherwise+ -> Nothing _ -> Nothing @@ -980,7 +987,7 @@ ; return (subst' { rs_id_subst = id_subst' }) } where -- e2' is the result of applying flt_env to e2- e2' | isEmptyVarSet let_bndrs = e2+ e2' | null let_bndrs = e2 | otherwise = substExpr flt_env e2 id_subst' = extendVarEnv (rs_id_subst subst) v1' e2'@@ -1085,14 +1092,14 @@ Our cunning plan is this: * Along with the growing substitution for template variables we maintain a growing set of floated let-bindings (rs_binds)- plus the set of variables thus bound.+ plus the set of variables thus bound (rs_bndrs). * The RnEnv2 in the MatchEnv binds only the local binders- in the term (lambdas, case)+ in the term (lambdas, case), not the floated let-bndrs. - * When we encounter a let in the term to be matched, we- check that does not mention any locally bound (lambda, case)- variables. If so we fail+ * When we encounter a let in the term to be matched, we use+ okToFloat check that does not mention any locally bound (lambda,+ case) variables. If so we fail. * We use GHC.Core.Subst.substBind to freshen the binding, using an in-scope set that is the original in-scope variables plus the
compiler/GHC/Core/SimpleOpt.hs view
@@ -665,7 +665,7 @@ `setUnfoldingInfo` new_unfolding old_rules = ruleInfo old_info- new_rules = substSpec subst new_bndr old_rules+ new_rules = substRuleInfo subst new_bndr old_rules old_unfolding = realUnfoldingInfo old_info new_unfolding | isStableUnfolding old_unfolding@@ -1327,8 +1327,9 @@ "map coerce = coerce" match. -} -exprIsLambda_maybe :: InScopeEnv -> CoreExpr- -> Maybe (Var, CoreExpr,[CoreTickish])+exprIsLambda_maybe :: HasDebugCallStack+ => InScopeEnv -> CoreExpr+ -> Maybe (Var, CoreExpr,[CoreTickish]) -- See Note [exprIsLambda_maybe] -- The simple case: It is a lambda already
compiler/GHC/Core/Subst.hs view
@@ -14,17 +14,17 @@ TvSubstEnv, IdSubstEnv, InScopeSet, -- ** Substituting into expressions and related types- deShadowBinds, substSpec, substRulesForImportedIds,+ deShadowBinds, substRuleInfo, substRulesForImportedIds, substTy, substCo, substExpr, substExprSC, substBind, substBindSC, substUnfolding, substUnfoldingSC,- lookupIdSubst, lookupTCvSubst, substIdType, substIdOcc,+ lookupIdSubst, substIdType, substIdOcc, substTickish, substDVarSet, substIdInfo, -- ** Operations on substitutions emptySubst, mkEmptySubst, mkSubst, mkOpenSubst, substInScope, isEmptySubst, extendIdSubst, extendIdSubstList, extendTCvSubst, extendTvSubstList, extendSubst, extendSubstList, extendSubstWithVar, zapSubstEnv,- addInScopeSet, extendInScope, extendInScopeList, extendInScopeIds,+ extendInScope, extendInScopeList, extendInScopeIds, isInScope, setInScope, getTCvSubst, extendTvSubst, extendCvSubst, delBndr, delBndrs, @@ -251,23 +251,16 @@ -- | Find the substitution for an 'Id' in the 'Subst' lookupIdSubst :: HasDebugCallStack => Subst -> Id -> CoreExpr-lookupIdSubst (Subst in_scope ids _ _) v+lookupIdSubst s@(Subst in_scope ids _ _) v | not (isLocalId v) = Var v | Just e <- lookupVarEnv ids v = e | Just v' <- lookupInScope in_scope v = Var v' -- Vital! See Note [Extending the Subst]+ -- See #20200 | otherwise = warnPprTrace True (text "GHC.Core.Subst.lookupIdSubst" <+> ppr v- $$ ppr in_scope) $+ $$ ppr s) $ Var v --- | Find the substitution for a 'TyVar' in the 'Subst'-lookupTCvSubst :: Subst -> TyVar -> Type-lookupTCvSubst (Subst _ _ tvs cvs) v- | isTyVar v- = lookupVarEnv tvs v `orElse` Type.mkTyVarTy v- | otherwise- = mkCoercionTy $ lookupVarEnv cvs v `orElse` mkCoVarCo v- delBndr :: Subst -> Var -> Subst delBndr (Subst in_scope ids tvs cvs) v | isCoVar v = Subst in_scope ids tvs (delVarEnv cvs v)@@ -293,12 +286,6 @@ isInScope :: Var -> Subst -> Bool isInScope v (Subst in_scope _ _ _) = v `elemInScopeSet` in_scope --- | Add the 'Var' to the in-scope set, but do not remove--- any existing substitutions for it-addInScopeSet :: Subst -> VarSet -> Subst-addInScopeSet (Subst in_scope ids tvs cvs) vs- = Subst (in_scope `extendInScopeSetSet` vs) ids tvs cvs- -- | Add the 'Var' to the in-scope set: as a side effect, -- and remove any existing substitutions for it extendInScope :: Subst -> Var -> Subst@@ -622,7 +609,7 @@ substIdInfo :: Subst -> Id -> IdInfo -> Maybe IdInfo substIdInfo subst new_id info | nothing_to_do = Nothing- | otherwise = Just (info `setRuleInfo` substSpec subst new_id old_rules+ | otherwise = Just (info `setRuleInfo` substRuleInfo subst new_id old_rules `setUnfoldingInfo` substUnfolding subst old_unf) where old_rules = ruleInfo info@@ -668,14 +655,13 @@ other -> pprPanic "substIdOcc" (vcat [ppr v <+> ppr other, ppr subst]) --------------------- | Substitutes for the 'Id's within the 'WorkerInfo' given the new function 'Id'-substSpec :: Subst -> Id -> RuleInfo -> RuleInfo-substSpec subst new_id (RuleInfo rules rhs_fvs)- = seqRuleInfo new_spec `seq` new_spec+-- | Substitutes for the 'Id's within the 'RuleInfo' given the new function 'Id'+substRuleInfo :: Subst -> Id -> RuleInfo -> RuleInfo+substRuleInfo subst new_id (RuleInfo rules rhs_fvs)+ = RuleInfo (map (substRule subst subst_ru_fn) rules)+ (substDVarSet subst rhs_fvs) where subst_ru_fn = const (idName new_id)- new_spec = RuleInfo (map (substRule subst subst_ru_fn) rules)- (substDVarSet subst rhs_fvs) ------------------ substRulesForImportedIds :: Subst -> [CoreRule] -> [CoreRule]@@ -709,13 +695,21 @@ (subst', bndrs') = substBndrs subst bndrs -------------------substDVarSet :: Subst -> DVarSet -> DVarSet-substDVarSet subst fvs- = mkDVarSet $ fst $ foldr (subst_fv subst) ([], emptyVarSet) $ dVarSetElems fvs+substDVarSet :: HasDebugCallStack => Subst -> DVarSet -> DVarSet+substDVarSet subst@(Subst _ _ tv_env cv_env) fvs+ = mkDVarSet $ fst $ foldr subst_fv ([], emptyVarSet) $ dVarSetElems fvs where- subst_fv subst fv acc- | isId fv = expr_fvs (lookupIdSubst subst fv) isLocalVar emptyVarSet $! acc- | otherwise = tyCoFVsOfType (lookupTCvSubst subst fv) (const True) emptyVarSet $! acc+ subst_fv :: Var -> ([Var], VarSet) -> ([Var], VarSet)+ subst_fv fv acc+ | isTyVar fv+ , let fv_ty = lookupVarEnv tv_env fv `orElse` mkTyVarTy fv+ = tyCoFVsOfType fv_ty (const True) emptyVarSet $! acc+ | isCoVar fv+ , let fv_co = lookupVarEnv cv_env fv `orElse` mkCoVarCo fv+ = tyCoFVsOfCo fv_co (const True) emptyVarSet $! acc+ | otherwise+ , let fv_expr = lookupIdSubst subst fv+ = expr_fvs fv_expr isLocalVar emptyVarSet $! acc ------------------ substTickish :: Subst -> CoreTickish -> CoreTickish@@ -737,6 +731,31 @@ In any case we don't need to optimise the RHS of rules, or unfoldings, because the simplifier will do that.++Another place this went wrong was in `substRuleInfo`, which would immediately force+the lazy call to substExpr, which led to an infinite loop (as reported by #20112).++This time the call stack looked something like:++* `substRecBndrs`+* `substIdBndr`+* `substIdInfo`+* `substRuleInfo`+* `substRule`+* `substExpr`+* `mkTick`+* `isSaturatedConApp`+* Look at `IdInfo` for thing we are currently substituting because the rule is attached to `transpose` and mentions it in the `RHS` of the rule.++and the rule was++{-# RULES+"transpose/overlays1" forall xs. transpose (overlays1 xs) = overlays1 (fmap transpose xs)+#-}++This rule was attached to `transpose`, but also mentions itself in the RHS so we have+to be careful to not force the `IdInfo` for transpose when dealing with the RHS of the rule.+ Note [substTickish]
compiler/GHC/Core/TyCo/Rep.hs-boot view
@@ -1,3 +1,4 @@+{-# LANGUAGE NoPolyKinds #-} module GHC.Core.TyCo.Rep where import GHC.Utils.Outputable ( Outputable )
compiler/GHC/Core/TyCo/Subst.hs view
@@ -552,7 +552,7 @@ -} -- | Type substitution, see 'zipTvSubst'-substTyWith :: HasCallStack => [TyVar] -> [Type] -> Type -> Type+substTyWith :: HasDebugCallStack => [TyVar] -> [Type] -> Type -> Type -- Works only if the domain of the substitution is a -- superset of the type being substituted into substTyWith tvs tys = {-#SCC "substTyWith" #-}@@ -580,7 +580,7 @@ where tenv = zipTyEnv tvs tys -- | Coercion substitution, see 'zipTvSubst'-substCoWith :: HasCallStack => [TyVar] -> [Type] -> Coercion -> Coercion+substCoWith :: HasDebugCallStack => [TyVar] -> [Type] -> Coercion -> Coercion substCoWith tvs tys = assert (tvs `equalLength` tys ) substCo (zipTvSubst tvs tys) @@ -632,7 +632,7 @@ -- | This checks if the substitution satisfies the invariant from -- Note [The substitution invariant].-checkValidSubst :: HasCallStack => TCvSubst -> [Type] -> [Coercion] -> a -> a+checkValidSubst :: HasDebugCallStack => TCvSubst -> [Type] -> [Coercion] -> a -> a checkValidSubst subst@(TCvSubst in_scope tenv cenv) tys cos a = assertPpr (isValidTCvSubst subst) (text "in_scope" <+> ppr in_scope $$@@ -663,7 +663,7 @@ -- | Substitute within a 'Type' -- The substitution has to satisfy the invariants described in -- Note [The substitution invariant].-substTy :: HasCallStack => TCvSubst -> Type -> Type+substTy :: HasDebugCallStack => TCvSubst -> Type -> Type substTy subst ty | isEmptyTCvSubst subst = ty | otherwise = checkValidSubst subst [ty] [] $@@ -679,21 +679,21 @@ | isEmptyTCvSubst subst = ty | otherwise = subst_ty subst ty -substScaledTy :: HasCallStack => TCvSubst -> Scaled Type -> Scaled Type+substScaledTy :: HasDebugCallStack => TCvSubst -> Scaled Type -> Scaled Type substScaledTy subst scaled_ty = mapScaledType (substTy subst) scaled_ty -substScaledTyUnchecked :: HasCallStack => TCvSubst -> Scaled Type -> Scaled Type+substScaledTyUnchecked :: HasDebugCallStack => TCvSubst -> Scaled Type -> Scaled Type substScaledTyUnchecked subst scaled_ty = mapScaledType (substTyUnchecked subst) scaled_ty -- | Substitute within several 'Type's -- The substitution has to satisfy the invariants described in -- Note [The substitution invariant].-substTys :: HasCallStack => TCvSubst -> [Type] -> [Type]+substTys :: HasDebugCallStack => TCvSubst -> [Type] -> [Type] substTys subst tys | isEmptyTCvSubst subst = tys | otherwise = checkValidSubst subst tys [] $ map (subst_ty subst) tys -substScaledTys :: HasCallStack => TCvSubst -> [Scaled Type] -> [Scaled Type]+substScaledTys :: HasDebugCallStack => TCvSubst -> [Scaled Type] -> [Scaled Type] substScaledTys subst scaled_tys | isEmptyTCvSubst subst = scaled_tys | otherwise = checkValidSubst subst (map scaledMult scaled_tys ++ map scaledThing scaled_tys) [] $@@ -717,7 +717,7 @@ -- | Substitute within a 'ThetaType' -- The substitution has to satisfy the invariants described in -- Note [The substitution invariant].-substTheta :: HasCallStack => TCvSubst -> ThetaType -> ThetaType+substTheta :: HasDebugCallStack => TCvSubst -> ThetaType -> ThetaType substTheta = substTys -- | Substitute within a 'ThetaType' disabling the sanity checks.@@ -789,7 +789,7 @@ -- | Substitute within a 'Coercion' -- The substitution has to satisfy the invariants described in -- Note [The substitution invariant].-substCo :: HasCallStack => TCvSubst -> Coercion -> Coercion+substCo :: HasDebugCallStack => TCvSubst -> Coercion -> Coercion substCo subst co | isEmptyTCvSubst subst = co | otherwise = checkValidSubst subst [] [co] $ subst_co subst co@@ -807,7 +807,7 @@ -- | Substitute within several 'Coercion's -- The substitution has to satisfy the invariants described in -- Note [The substitution invariant].-substCos :: HasCallStack => TCvSubst -> [Coercion] -> [Coercion]+substCos :: HasDebugCallStack => TCvSubst -> [Coercion] -> [Coercion] substCos subst cos | isEmptyTCvSubst subst = cos | otherwise = checkValidSubst subst [] cos $ map (subst_co subst) cos@@ -947,19 +947,19 @@ lookupCoVar :: TCvSubst -> Var -> Maybe Coercion lookupCoVar (TCvSubst _ _ cenv) v = lookupVarEnv cenv v -substTyVarBndr :: HasCallStack => TCvSubst -> TyVar -> (TCvSubst, TyVar)+substTyVarBndr :: HasDebugCallStack => TCvSubst -> TyVar -> (TCvSubst, TyVar) substTyVarBndr = substTyVarBndrUsing substTy -substTyVarBndrs :: HasCallStack => TCvSubst -> [TyVar] -> (TCvSubst, [TyVar])+substTyVarBndrs :: HasDebugCallStack => TCvSubst -> [TyVar] -> (TCvSubst, [TyVar]) substTyVarBndrs = mapAccumL substTyVarBndr -substVarBndr :: HasCallStack => TCvSubst -> TyCoVar -> (TCvSubst, TyCoVar)+substVarBndr :: HasDebugCallStack => TCvSubst -> TyCoVar -> (TCvSubst, TyCoVar) substVarBndr = substVarBndrUsing substTy -substVarBndrs :: HasCallStack => TCvSubst -> [TyCoVar] -> (TCvSubst, [TyCoVar])+substVarBndrs :: HasDebugCallStack => TCvSubst -> [TyCoVar] -> (TCvSubst, [TyCoVar]) substVarBndrs = mapAccumL substVarBndr -substCoVarBndr :: HasCallStack => TCvSubst -> CoVar -> (TCvSubst, CoVar)+substCoVarBndr :: HasDebugCallStack => TCvSubst -> CoVar -> (TCvSubst, CoVar) substCoVarBndr = substCoVarBndrUsing substTy -- | Like 'substVarBndr', but disables sanity checks.
compiler/GHC/Core/Unfold.hs view
@@ -50,7 +50,7 @@ import GHC.Types.Literal import GHC.Builtin.PrimOps import GHC.Types.Id.Info-import GHC.Types.Basic ( Arity, InlineSpec(..), inlinePragmaSpec )+import GHC.Types.Basic ( Arity, isNoInlinePragma ) import GHC.Core.Type import GHC.Builtin.Names import GHC.Builtin.Types.Prim ( realWorldStatePrimTy )@@ -970,7 +970,7 @@ certainlyWillInline opts fn_info = case fn_unf of CoreUnfolding { uf_tmpl = expr, uf_guidance = guidance, uf_src = src }- | noinline -> Nothing -- See Note [Worker/wrapper for NOINLINE functions]+ | noinline -> Nothing -- See Note [Worker/wrapper for NOINLINE functions] | otherwise -> case guidance of UnfNever -> Nothing@@ -991,8 +991,8 @@ _other_unf -> Nothing where- noinline = inlinePragmaSpec (inlinePragInfo fn_info) == NoInline- fn_unf = unfoldingInfo fn_info -- NB: loop-breakers never inline+ noinline = isNoInlinePragma (inlinePragInfo fn_info)+ fn_unf = unfoldingInfo fn_info -- NB: loop-breakers never inline -- The UnfIfGoodArgs case seems important. If we w/w small functions -- binary sizes go up by 10%! (This is with SplitObjs.)
compiler/GHC/Core/Utils.hs view
@@ -76,6 +76,7 @@ import GHC.Core.Predicate import GHC.Core.TyCo.Rep( TyCoBinder(..), TyBinder ) import GHC.Core.Coercion+import GHC.Core.Reduction import GHC.Core.TyCon import GHC.Core.Multiplicity @@ -2632,8 +2633,8 @@ -- coercions via 'topNormaliseType_maybe'. Hence the \"norm\" prefix. normSplitTyConApp_maybe :: FamInstEnvs -> Type -> Maybe (TyCon, [Type], Coercion) normSplitTyConApp_maybe fam_envs ty- | let (co, ty1) = topNormaliseType_maybe fam_envs ty- `orElse` (mkRepReflCo ty, ty)+ | let Reduction co ty1 = topNormaliseType_maybe fam_envs ty+ `orElse` (mkReflRedn Representational ty) , Just (tc, tc_args) <- splitTyConApp_maybe ty1 = Just (tc, tc_args, co) normSplitTyConApp_maybe _ _ = Nothing
compiler/GHC/Data/Graph/Directed.hs view
@@ -12,7 +12,7 @@ stronglyConnCompG, topologicalSortG, verticesG, edgesG, hasVertexG,- reachableG, reachablesG, transposeG,+ reachableG, reachablesG, transposeG, allReachable, outgoingG, emptyG, findCycle,@@ -25,7 +25,7 @@ -- Simple way to classify edges EdgeType(..), classifyEdges- ) where+ ) where ------------------------------------------------------------------------------ -- A version of the graph algorithms described in:@@ -61,6 +61,9 @@ import Data.Tree import GHC.Types.Unique import GHC.Types.Unique.FM+import qualified Data.IntMap as IM+import qualified Data.IntSet as IS+import qualified Data.Map as M {- ************************************************************************@@ -359,6 +362,11 @@ where from_vertex = expectJust "reachableG" (gr_node_to_vertex graph from) result = {-# SCC "Digraph.reachable" #-} reachable (gr_int_graph graph) [from_vertex] +outgoingG :: Graph node -> node -> [node]+outgoingG graph from = map (gr_vertex_to_node graph) result+ where from_vertex = expectJust "reachableG" (gr_node_to_vertex graph from)+ result = gr_int_graph graph ! from_vertex+ -- | Given a list of roots return all reachable nodes. reachablesG :: Graph node -> [node] -> [node] reachablesG graph froms = map (gr_vertex_to_node graph) result@@ -366,6 +374,11 @@ reachable (gr_int_graph graph) vs vs = [ v | Just v <- map (gr_node_to_vertex graph) froms ] +allReachable :: Ord key => Graph node -> (node -> key) -> M.Map key [key]+allReachable (Graph g from _) conv = M.fromList [(conv (from v), IS.foldr (\k vs -> conv (from k) : vs) [] vs) | (v, vs) <- IM.toList int_graph]+ where+ int_graph = reachableGraph g+ hasVertexG :: Graph node -> node -> Bool hasVertexG graph node = isJust $ gr_node_to_vertex graph node @@ -434,6 +447,12 @@ -- This generalizes reachable which was found in Data.Graph reachable :: IntGraph -> [Vertex] -> [Vertex] reachable g vs = preorderF (dfs g vs)++reachableGraph :: IntGraph -> IM.IntMap IS.IntSet+reachableGraph g = res+ where+ do_one v = IS.unions (IS.fromList (g ! v) : mapMaybe (flip IM.lookup res) (g ! v))+ res = IM.fromList [(v, do_one v) | v <- vertices g] {- ************************************************************************
compiler/GHC/Driver/Env.hs view
@@ -1,4 +1,4 @@-+{-# LANGUAGE LambdaCase #-} module GHC.Driver.Env ( Hsc(..)@@ -61,7 +61,6 @@ import GHC.Types.Name import GHC.Types.Name.Env import GHC.Types.TyThing-import GHC.Types.Unique.FM import GHC.Builtin.Names ( gHC_PRIM ) @@ -77,6 +76,7 @@ import Data.IORef import qualified Data.Set as Set+import Data.Set (Set) runHsc :: HscEnv -> Hsc a -> IO a runHsc hsc_env (Hsc hsc) = do@@ -202,7 +202,7 @@ in (concat insts, concat famInsts) -- | Find instances visible from the given set of imports-hptInstancesBelow :: HscEnv -> ModuleName -> [ModuleNameWithIsBoot] -> ([ClsInst], [FamInst])+hptInstancesBelow :: HscEnv -> ModuleName -> Set ModuleNameWithIsBoot -> ([ClsInst], [FamInst]) hptInstancesBelow hsc_env mn mns = let (insts, famInsts) = unzip $ hptSomeThingsBelowUs (\mod_info ->@@ -217,53 +217,67 @@ in (concat insts, concat famInsts) -- | Get rules from modules "below" this one (in the dependency sense)-hptRules :: HscEnv -> [ModuleNameWithIsBoot] -> [CoreRule]+hptRules :: HscEnv -> Set ModuleNameWithIsBoot -> [CoreRule] hptRules = hptSomeThingsBelowUs (md_rules . hm_details) False -- | Get annotations from modules "below" this one (in the dependency sense)-hptAnns :: HscEnv -> Maybe [ModuleNameWithIsBoot] -> [Annotation]+hptAnns :: HscEnv -> Maybe (Set ModuleNameWithIsBoot) -> [Annotation] hptAnns hsc_env (Just deps) = hptSomeThingsBelowUs (md_anns . hm_details) False hsc_env deps hptAnns hsc_env Nothing = hptAllThings (md_anns . hm_details) hsc_env hptAllThings :: (HomeModInfo -> [a]) -> HscEnv -> [a] hptAllThings extract hsc_env = concatMap extract (eltsHpt (hsc_HPT hsc_env)) -hptModulesBelow :: HscEnv -> [ModuleNameWithIsBoot] -> Set.Set ModuleNameWithIsBoot-hptModulesBelow hsc_env mn = Set.fromList (map fst (eltsUFM $ go mn emptyUFM))+-- | This function returns all the modules belonging to the home-unit that can+-- be reached by following the given dependencies. Additionally, if both the+-- boot module and the non-boot module can be reached, it only returns the+-- non-boot one.+hptModulesBelow :: HscEnv -> Set ModuleNameWithIsBoot -> Set ModuleNameWithIsBoot+hptModulesBelow hsc_env mn = filtered_mods $ dep_mods mn Set.empty where- hpt = hsc_HPT hsc_env+ !hpt = hsc_HPT hsc_env - go [] seen = seen- go (mn:mns) seen- | Just (mn', both) <- lookupUFM seen (gwib_mod mn)- -- Already seen the module before- , gwib_isBoot mn' == gwib_isBoot mn- || both = go mns seen- | otherwise =- case lookupHpt hpt (gwib_mod mn) of- -- Not a home module- Nothing -> go mns seen- Just hmi ->- let- -- The bool indicates if we have seen *both* the- -- NotBoot and IsBoot versions- comb :: (GenWithIsBoot ModuleName, Bool)- -> (GenWithIsBoot ModuleName, Bool)- -> (GenWithIsBoot ModuleName, Bool)- comb (o@(GWIB { gwib_isBoot = NotBoot }), b) _ =- (o, IsBoot == gwib_isBoot mn || b)- comb ((GWIB { gwib_isBoot = IsBoot }, _)) (new_gwib, _) =- (new_gwib, NotBoot == gwib_isBoot mn)- in- go (dep_direct_mods (mi_deps (hm_iface hmi)) ++ mns)- (addToUFM_C comb seen (gwib_mod mn) (mn, False))+ -- get all the dependent modules without filtering boot/non-boot+ dep_mods !deps !seen -- invariant: intersection of deps and seen is null+ | Set.null deps = seen+ | otherwise = dep_mods deps' seen'+ where+ get_deps d@(GWIB mod _is_boot) (home_deps,all_deps) = case lookupHpt hpt mod of+ Nothing -> (home_deps,all_deps) -- not a home-module+ Just hmi -> let+ !home_deps' = Set.insert d home_deps+ !all_deps' = Set.union all_deps (dep_direct_mods (mi_deps (hm_iface hmi)))+ in (home_deps', all_deps') + -- all the non-transitive deps from our deps+ (seen',new_deps) = Set.foldr' get_deps (seen,Set.empty) deps + -- maintain the invariant that deps haven't already been seen+ deps' = Set.difference new_deps seen'++ -- remove boot modules when there is also a non-boot one+ filtered_mods mods = Set.fromDistinctAscList $ filter_mods $ Set.toAscList mods++ -- IsBoot and NotBoot modules are necessarily consecutive in the sorted list+ -- (cf Ord instance of GenWithIsBoot). Hence we only have to perform a+ -- linear sweep with a window of size 2 to remove boot modules for which we+ -- have the corresponding non-boot.+ filter_mods = \case+ (r1@(GWIB m1 b1) : r2@(GWIB m2 _) : rs)+ | m1 == m2 -> let !r' = case b1 of+ NotBoot -> r1+ IsBoot -> r2+ in r' : filter_mods rs+ | otherwise -> r1 : filter_mods (r2:rs)+ rs -> rs+++ -- | Get things from modules "below" this one (in the dependency sense) -- C.f Inst.hptInstances-hptSomeThingsBelowUs :: (HomeModInfo -> [a]) -> Bool -> HscEnv -> [ModuleNameWithIsBoot] -> [a]-hptSomeThingsBelowUs extract include_hi_boot hsc_env mod+hptSomeThingsBelowUs :: (HomeModInfo -> [a]) -> Bool -> HscEnv -> Set ModuleNameWithIsBoot -> [a]+hptSomeThingsBelowUs extract include_hi_boot hsc_env deps | isOneShot (ghcMode (hsc_dflags hsc_env)) = [] | otherwise@@ -271,7 +285,7 @@ in [ thing | -- Find each non-hi-boot module below me- GWIB { gwib_mod = mod, gwib_isBoot = is_boot } <- Set.toList (hptModulesBelow hsc_env mod)+ GWIB { gwib_mod = mod, gwib_isBoot = is_boot } <- Set.toList (hptModulesBelow hsc_env deps) , include_hi_boot || (is_boot == NotBoot) -- unsavoury: when compiling the base package with --make, we
+ compiler/GHC/Driver/Env/KnotVars.hs view
@@ -0,0 +1,71 @@+{-# LANGUAGE DeriveFunctor #-}+-- | This data structure holds an updateable environment which is used+-- when compiling module loops.+module GHC.Driver.Env.KnotVars( KnotVars(..)+ , emptyKnotVars+ , knotVarsFromModuleEnv+ , knotVarElems+ , lookupKnotVars+ , knotVarsWithout+ ) where++import GHC.Prelude+import GHC.Unit.Types ( Module )+import GHC.Unit.Module.Env+import Data.Maybe++-- See Note [Why is KnotVars not a ModuleEnv]+data KnotVars a = KnotVars { kv_domain :: [Module] -- Domain of the function , Note [KnotVars: Why store the domain?]+ -- Invariant: kv_lookup is surjective relative to kv_domain+ , kv_lookup :: Module -> Maybe a -- Lookup function+ }+ deriving Functor++emptyKnotVars :: KnotVars a+emptyKnotVars = KnotVars [] (const Nothing)++knotVarsFromModuleEnv :: ModuleEnv a -> KnotVars a+knotVarsFromModuleEnv me = KnotVars (moduleEnvKeys me) (lookupModuleEnv me)++knotVarElems :: KnotVars a -> [a]+knotVarElems (KnotVars keys lookup) = mapMaybe lookup keys++lookupKnotVars :: KnotVars a -> Module -> Maybe a+lookupKnotVars (KnotVars _ lookup) = lookup++knotVarsWithout :: Module -> KnotVars a -> KnotVars a+knotVarsWithout this_mod (KnotVars loop_mods lkup) = KnotVars+ (filter (/= this_mod) loop_mods)+ (\that_mod -> if that_mod == this_mod then Nothing else lkup that_mod)++{-+Note [Why is KnotVars not a ModuleEnv]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~++Initially 'KnotVars' was just a 'ModuleEnv a' but there is one tricky use of+the data structure in 'mkDsEnvs' which required this generalised structure.++In interactive mode the TypeEnvs from all the previous statements are merged+togethed into one big TypeEnv. 'dsLookupVar' relies on `tcIfaceVar'. The normal+lookup functions either look in the HPT or EPS but there is no entry for the `Ghci<N>` modules+in either, so the whole merged TypeEnv for all previous Ghci* is stored in the+`if_rec_types` variable and then lookup checks there in the case of any interactive module.++This is a misuse of the `if_rec_types` variable which might be fixed in future if the+Ghci<N> modules are just placed into the HPT like normal modules with implicit imports+between them.++Note [KnotVars: Why store the domain?]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~++Normally there's a 'Module' at hand to tell us which 'TypeEnv' we want to interrogate+at a particular time, apart from one case, when constructing the in-scope set+when linting an unfolding. In this case the whole environemnt is needed to tell us+everything that's in-scope at top-level in the loop because whilst we are linting unfoldings+the top-level identifiers from modules in the cycle might not be globalised properly yet.++This could be refactored so that the lint functions knew about 'KnotVars' and delayed+this check until deciding whether a variable was local or not.++-}+
compiler/GHC/Driver/Env/Types.hs view
@@ -18,7 +18,6 @@ import GHC.Unit.Finder.Types import GHC.Unit.Module.Graph import GHC.Unit.Env-import GHC.Unit.Types import GHC.Utils.Logger import GHC.Utils.TmpFs import {-# SOURCE #-} GHC.Driver.Plugins@@ -27,6 +26,7 @@ import Control.Monad.Trans.Reader import Control.Monad.Trans.State import Data.IORef+import GHC.Driver.Env.KnotVars -- | The Hsc monad: Passing an environment and diagnostic state newtype Hsc a = Hsc (HscEnv -> Messages GhcMessage -> IO (a, Messages GhcMessage))@@ -76,7 +76,7 @@ hsc_FC :: {-# UNPACK #-} !FinderCache, -- ^ The cached result of performing finding in the file system - hsc_type_env_var :: Maybe (Module, IORef TypeEnv)+ hsc_type_env_vars :: KnotVars (IORef TypeEnv) -- ^ Used for one-shot compilation only, to initialise -- the 'IfGblEnv'. See 'GHC.Tc.Utils.tcg_type_env_var' for -- 'GHC.Tc.Utils.TcGblEnv'. See also Note [hsc_type_env_var hack]
compiler/GHC/Driver/Monad.hs view
@@ -242,15 +242,15 @@ -- | Print the all diagnostics in a 'SourceError'. Useful inside exception -- handlers.-printException :: GhcMonad m => SourceError -> m ()+printException :: (HasLogger m, MonadIO m, HasDynFlags m) => SourceError -> m () printException err = do- dflags <- getSessionDynFlags+ dflags <- getDynFlags logger <- getLogger let !diag_opts = initDiagOpts dflags liftIO $ printMessages logger diag_opts (srcErrorMessages err) -- | A function called to log warnings and errors.-type WarnErrLogger = forall m. GhcMonad m => Maybe SourceError -> m ()+type WarnErrLogger = forall m. (HasDynFlags m , MonadIO m, HasLogger m) => Maybe SourceError -> m () defaultWarnErrLogger :: WarnErrLogger defaultWarnErrLogger Nothing = return ()
compiler/GHC/Driver/Session.hs view
@@ -84,7 +84,6 @@ sGhciUsagePath, sToolDir, sTopDir,- sTmpDir, sGlobalPackageDatabasePath, sLdSupportsCompactUnwind, sLdSupportsBuildId,@@ -134,7 +133,7 @@ PlatformMisc(..), settings, programName, projectVersion,- ghcUsagePath, ghciUsagePath, topDir, tmpDir,+ ghcUsagePath, ghciUsagePath, topDir, versionedAppDir, versionedFilePath, extraGccViaCFlags, globalPackageDatabasePath, pgm_L, pgm_P, pgm_F, pgm_c, pgm_a, pgm_l, pgm_lm, pgm_dll, pgm_T,@@ -445,6 +444,7 @@ toolSettings :: {-# UNPACK #-} !ToolSettings, platformMisc :: {-# UNPACK #-} !PlatformMisc, rawSettings :: [(String, String)],+ tmpDir :: TempDir, llvmConfig :: LlvmConfig, -- ^ N.B. It's important that this field is lazy since we load the LLVM@@ -793,8 +793,6 @@ toolDir dflags = fileSettings_toolDir $ fileSettings dflags topDir :: DynFlags -> FilePath topDir dflags = fileSettings_topDir $ fileSettings dflags-tmpDir :: DynFlags -> TempDir-tmpDir dflags = TempDir (fileSettings_tmpDir $ fileSettings dflags) extraGccViaCFlags :: DynFlags -> [String] extraGccViaCFlags dflags = toolSettings_extraGccViaCFlags $ toolSettings dflags globalPackageDatabasePath :: DynFlags -> FilePath@@ -1097,6 +1095,7 @@ let (useColor', colScheme') = (adjustCols maybeGhcColoursEnv . adjustCols maybeGhcColorsEnv) (useColor dflags, colScheme dflags)+ tmp_dir <- normalise <$> getTemporaryDirectory return dflags{ dynamicTooFailed = refDynamicTooFailed, useUnicode = useUnicode',@@ -1105,7 +1104,8 @@ colScheme = colScheme', rtldInfo = refRtldInfo, rtccInfo = refRtccInfo,- rtasmInfo = refRtasmInfo+ rtasmInfo = refRtasmInfo,+ tmpDir = TempDir tmp_dir } -- | The normal 'DynFlags'. Note that they are not suitable for use in this form@@ -1213,6 +1213,8 @@ platformMisc = sPlatformMisc mySettings, rawSettings = sRawSettings mySettings, + tmpDir = panic "defaultDynFlags: uninitialized tmpDir",+ -- See Note [LLVM configuration]. llvmConfig = llvmConfig, @@ -4118,8 +4120,6 @@ -- (except for -fno-glasgow-exts, which is treated specially) ---------------------------alterFileSettings :: (FileSettings -> FileSettings) -> DynFlags -> DynFlags-alterFileSettings f dynFlags = dynFlags { fileSettings = f (fileSettings dynFlags) } alterToolSettings :: (ToolSettings -> ToolSettings) -> DynFlags -> DynFlags alterToolSettings f dynFlags = dynFlags { toolSettings = f (toolSettings dynFlags) }@@ -4413,7 +4413,7 @@ -- tmpDir, where we store temporary files. setTmpDir :: FilePath -> DynFlags -> DynFlags-setTmpDir dir = alterFileSettings $ \s -> s { fileSettings_tmpDir = normalise dir }+setTmpDir dir d = d { tmpDir = TempDir (normalise dir) } -- we used to fix /cygdrive/c/.. on Windows, but this doesn't -- seem necessary now --SDM 7/2/2008
compiler/GHC/Hs/Binds.hs view
@@ -609,14 +609,14 @@ ppr_sig (IdSig _ id) = pprVarSig [id] (ppr (varType id)) ppr_sig (FixSig _ fix_sig) = ppr fix_sig ppr_sig (SpecSig _ var ty inl@(InlinePragma { inl_inline = spec }))- = pragSrcBrackets (inl_src inl) pragmaSrc (pprSpec (unLoc var)+ = pragSrcBrackets (inlinePragmaSource inl) pragmaSrc (pprSpec (unLoc var) (interpp'SP ty) inl) where pragmaSrc = case spec of- NoUserInlinePrag -> "{-# SPECIALISE"- _ -> "{-# SPECIALISE_INLINE"+ NoUserInlinePrag -> "{-# " ++ extractSpecPragName (inl_src inl)+ _ -> "{-# " ++ extractSpecPragName (inl_src inl) ++ "_INLINE" ppr_sig (InlineSig _ var inl)- = pragSrcBrackets (inl_src inl) "{-# INLINE" (pprInline inl+ = pragSrcBrackets (inlinePragmaSource inl) "{-# INLINE" (pprInline inl <+> pprPrefixOcc (unLoc var)) ppr_sig (SpecInstSig _ src ty) = pragSrcBrackets src "{-# pragma" (text "instance" <+> ppr ty)@@ -674,7 +674,7 @@ instance Outputable TcSpecPrag where ppr (SpecPrag var _ inl)- = text "SPECIALIZE" <+> pprSpec var (text "<type>") inl+ = ppr (extractSpecPragName $ inl_src inl) <+> pprSpec var (text "<type>") inl pprMinimalSig :: (OutputableBndr name) => LBooleanFormula (GenLocated l name) -> SDoc
compiler/GHC/Hs/Decls.hs view
@@ -705,13 +705,16 @@ , con_res_ty = res_ty, con_doc = doc }) = ppr_mbDoc doc <+> ppr_con_names cons <+> dcolon <+> (sep [pprHsOuterSigTyVarBndrs outer_bndrs <+> pprLHsContext mcxt,- ppr_arrow_chain (get_args args ++ [ppr res_ty]) ])+ sep (ppr_args args ++ [ppr res_ty]) ]) where- get_args (PrefixConGADT args) = map ppr args- get_args (RecConGADT fields _) = [pprConDeclFields (unLoc fields)]+ ppr_args (PrefixConGADT args) = map (\(HsScaled arr t) -> ppr t <+> ppr_arr arr) args+ ppr_args (RecConGADT fields _) = [pprConDeclFields (unLoc fields) <+> arrow] - ppr_arrow_chain (a:as) = sep (a : map (arrow <+>) as)- ppr_arrow_chain [] = empty+ -- Display linear arrows as unrestricted with -XNoLinearTypes+ -- (cf. dataConDisplayType in Note [Displaying linear fields] in GHC.Core.DataCon)+ ppr_arr (HsLinearArrow _) = sdocOption sdocLinearTypes $ \show_linear_types ->+ if show_linear_types then lollipop else arrow+ ppr_arr arr = pprHsArrow arr ppr_con_names :: (OutputableBndr a) => [GenLocated l a] -> SDoc ppr_con_names = pprWithCommas (pprPrefixOcc . unLoc)
compiler/GHC/Hs/Expr.hs view
@@ -186,7 +186,6 @@ deriving instance (Data (hs_syn GhcTc), Typeable hs_syn) => Data (HsWrap hs_syn) -type instance HsDoRn (GhcPass _) = GhcRn type instance HsBracketRn (GhcPass _) = GhcRn type instance PendingRnSplice' (GhcPass _) = PendingRnSplice type instance PendingTcSplice' (GhcPass _) = PendingTcSplice@@ -797,7 +796,7 @@ go (HsMultiIf{}) = prec > topPrec go (HsLet{}) = prec > topPrec go (HsDo _ sc _)- | isComprehensionContext sc = False+ | isDoComprehensionContext sc = False | otherwise = prec > topPrec go (ExplicitList{}) = False go (RecordUpd{}) = False@@ -1185,7 +1184,7 @@ = sep [hang (text "let") 2 (pprBinds binds), hang (text "in") 2 (ppr cmd)] -ppr_cmd (HsCmdDo _ (L _ stmts)) = pprDo ArrowExpr stmts+ppr_cmd (HsCmdDo _ (L _ stmts)) = pprArrowExpr stmts ppr_cmd (HsCmdArrApp _ arrow arg HsFirstOrderApp True) = hsep [ppr_lexpr arrow, larrowt, ppr_lexpr arg]@@ -1448,8 +1447,6 @@ type instance XApplicativeArgMany (GhcPass _) = NoExtField type instance XXApplicativeArg (GhcPass _) = NoExtCon -type instance ApplicativeArgStmCtxPass _ = GhcRn- instance (Outputable (StmtLR (GhcPass idL) (GhcPass idL) (LHsExpr (GhcPass idL))), Outputable (XXParStmtBlock (GhcPass idL) (GhcPass idR))) => Outputable (ParStmtBlock (GhcPass idL) (GhcPass idR)) where@@ -1562,17 +1559,21 @@ pprDo :: (OutputableBndrId p, Outputable body, Anno (StmtLR (GhcPass p) (GhcPass p) body) ~ SrcSpanAnnA )- => HsStmtContext any -> [LStmt (GhcPass p) body] -> SDoc+ => HsDoFlavour -> [LStmt (GhcPass p) body] -> SDoc pprDo (DoExpr m) stmts = ppr_module_name_prefix m <> text "do" <+> ppr_do_stmts stmts pprDo GhciStmtCtxt stmts = text "do" <+> ppr_do_stmts stmts-pprDo ArrowExpr stmts = text "do" <+> ppr_do_stmts stmts pprDo (MDoExpr m) stmts = ppr_module_name_prefix m <> text "mdo" <+> ppr_do_stmts stmts pprDo ListComp stmts = brackets $ pprComp stmts pprDo MonadComp stmts = brackets $ pprComp stmts-pprDo _ _ = panic "pprDo" -- PatGuard, ParStmtCxt +pprArrowExpr :: (OutputableBndrId p, Outputable body,+ Anno (StmtLR (GhcPass p) (GhcPass p) body) ~ SrcSpanAnnA+ )+ => [LStmt (GhcPass p) body] -> SDoc+pprArrowExpr stmts = text "do" <+> ppr_do_stmts stmts+ ppr_module_name_prefix :: Maybe ModuleName -> SDoc ppr_module_name_prefix = \case Nothing -> empty@@ -1868,12 +1869,15 @@ matchContextErrString (StmtCtxt (ParStmtCtxt c)) = matchContextErrString (StmtCtxt c) matchContextErrString (StmtCtxt (TransStmtCtxt c)) = matchContextErrString (StmtCtxt c) matchContextErrString (StmtCtxt (PatGuard _)) = text "pattern guard"-matchContextErrString (StmtCtxt GhciStmtCtxt) = text "interactive GHCi command"-matchContextErrString (StmtCtxt (DoExpr m)) = prependQualified m (text "'do' block")-matchContextErrString (StmtCtxt ArrowExpr) = text "'do' block"-matchContextErrString (StmtCtxt (MDoExpr m)) = prependQualified m (text "'mdo' block")-matchContextErrString (StmtCtxt ListComp) = text "list comprehension"-matchContextErrString (StmtCtxt MonadComp) = text "monad comprehension"+matchContextErrString (StmtCtxt (ArrowExpr)) = text "'do' block"+matchContextErrString (StmtCtxt (HsDoStmt flavour)) = matchDoContextErrString flavour++matchDoContextErrString :: HsDoFlavour -> SDoc+matchDoContextErrString GhciStmtCtxt = text "interactive GHCi command"+matchDoContextErrString (DoExpr m) = prependQualified m (text "'do' block")+matchDoContextErrString (MDoExpr m) = prependQualified m (text "'mdo' block")+matchDoContextErrString ListComp = text "list comprehension"+matchDoContextErrString MonadComp = text "monad comprehension" pprMatchInCtxt :: (OutputableBndrId idR, Outputable body) => Match (GhcPass idR) body -> SDoc
compiler/GHC/Hs/Instances.hs view
@@ -366,6 +366,8 @@ deriving instance Data (HsStmtContext GhcRn) deriving instance Data (HsStmtContext GhcTc) +deriving instance Data HsDoFlavour+ deriving instance Data (HsMatchContext GhcPs) deriving instance Data (HsMatchContext GhcRn) deriving instance Data (HsMatchContext GhcTc)@@ -412,6 +414,9 @@ deriving instance Data (HsOverLit GhcPs) deriving instance Data (HsOverLit GhcRn) deriving instance Data (HsOverLit GhcTc)++deriving instance Data OverLitRn+deriving instance Data OverLitTc -- --------------------------------------------------------------------- -- Data derivations from GHC.Hs.Pat ------------------------------------
compiler/GHC/Hs/Lit.hs view
@@ -1,10 +1,11 @@ {-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} -- Wrinkle in Note [Trees That Grow] -- in module Language.Haskell.Syntax.Extension+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE TypeApplications #-} {-# OPTIONS_GHC -Wno-orphans #-} -- Outputable, OutputableBndrId @@ -29,11 +30,10 @@ import GHC.Types.SourceText import GHC.Core.Type import GHC.Utils.Outputable+import Language.Haskell.Syntax.Expr ( HsExpr ) import Language.Haskell.Syntax.Extension import GHC.Hs.Extension -import Data.Data hiding ( Fixity )- {- ************************************************************************ * *@@ -57,20 +57,51 @@ type instance XHsDoublePrim (GhcPass _) = NoExtField type instance XXLit (GhcPass _) = NoExtCon +data OverLitRn+ = OverLitRn {+ ol_rebindable :: Bool, -- Note [ol_rebindable]+ ol_from_fun :: LIdP GhcRn -- Note [Overloaded literal witnesses]+ }+ data OverLitTc = OverLitTc {- ol_rebindable :: Bool, -- Note [ol_rebindable]+ ol_rebindable :: Bool, -- Note [ol_rebindable]+ ol_witness :: HsExpr GhcTc, -- Note [Overloaded literal witnesses] ol_type :: Type }- deriving Data +{-+Note [Overloaded literal witnesses]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~++During renaming, the coercion function needed for a given HsOverLit is+resolved according to the current scope and RebindableSyntax (see Note+[ol_rebindable]). The result of this resolution *before* type checking+is the coercion function such as 'fromInteger' or 'fromRational',+stored in the ol_from_fun field of OverLitRn.++*After* type checking, the ol_witness field of the OverLitTc contains+the witness of the literal as HsExpr, such as (fromInteger 3) or+lit_78. This witness should replace the literal. Reason: it allows+commoning up of the fromInteger calls, which wouldn't be possible if+the desugarer made the application.++The ol_type in OverLitTc records the type the overloaded literal is+found to have.+-}+ type instance XOverLit GhcPs = NoExtField-type instance XOverLit GhcRn = Bool -- Note [ol_rebindable]+type instance XOverLit GhcRn = OverLitRn type instance XOverLit GhcTc = OverLitTc +pprXOverLit :: GhcPass p -> XOverLit (GhcPass p) -> SDoc+pprXOverLit GhcPs noExt = ppr noExt+pprXOverLit GhcRn OverLitRn{ ol_from_fun = from_fun } = ppr from_fun+pprXOverLit GhcTc OverLitTc{ ol_witness = witness } = pprExpr witness+ type instance XXOverLit (GhcPass _) = NoExtCon overLitType :: HsOverLit GhcTc -> Type-overLitType (OverLit (OverLitTc _ ty) _ _) = ty+overLitType (OverLit OverLitTc{ ol_type = ty } _) = ty -- | Convert a literal from one index type to another convertLit :: HsLit (GhcPass p1) -> HsLit (GhcPass p2)@@ -94,8 +125,8 @@ The ol_rebindable field is True if this literal is actually using rebindable syntax. Specifically: - False iff ol_witness is the standard one- True iff ol_witness is non-standard+ False iff ol_from_fun / ol_witness is the standard one+ True iff ol_from_fun / ol_witness is non-standard Equivalently it's True if a) RebindableSyntax is on@@ -127,8 +158,8 @@ -- in debug mode, print the expression that it's resolved to, too instance OutputableBndrId p => Outputable (HsOverLit (GhcPass p)) where- ppr (OverLit {ol_val=val, ol_witness=witness})- = ppr val <+> (whenPprDebug (parens (pprExpr witness)))+ ppr (OverLit {ol_val=val, ol_ext=ext})+ = ppr val <+> (whenPprDebug (parens (pprXOverLit (ghcPass @p) ext))) -- | pmPprHsLit pretty prints literals and is used when pretty printing pattern -- match warnings. All are printed the same (i.e., without hashes if they are
compiler/GHC/Hs/Type.hs view
@@ -26,6 +26,7 @@ HsArrow(..), arrowToHsType, HsLinearArrowTokens(..), hsLinear, hsUnrestricted, isUnrestricted,+ pprHsArrow, HsType(..), HsCoreTy, LHsType, HsKind, LHsKind, HsForAllTelescope(..), EpAnnForallTy, HsTyVarBndr(..), LHsTyVarBndr,
compiler/GHC/Hs/Utils.hs view
@@ -299,11 +299,11 @@ mkHsIntegral :: IntegralLit -> HsOverLit GhcPs mkHsFractional :: FractionalLit -> HsOverLit GhcPs mkHsIsString :: SourceText -> FastString -> HsOverLit GhcPs-mkHsDo :: HsStmtContext GhcRn -> LocatedL [ExprLStmt GhcPs] -> HsExpr GhcPs-mkHsDoAnns :: HsStmtContext GhcRn -> LocatedL [ExprLStmt GhcPs] -> EpAnn AnnList -> HsExpr GhcPs-mkHsComp :: HsStmtContext GhcRn -> [ExprLStmt GhcPs] -> LHsExpr GhcPs+mkHsDo :: HsDoFlavour -> LocatedL [ExprLStmt GhcPs] -> HsExpr GhcPs+mkHsDoAnns :: HsDoFlavour -> LocatedL [ExprLStmt GhcPs] -> EpAnn AnnList -> HsExpr GhcPs+mkHsComp :: HsDoFlavour -> [ExprLStmt GhcPs] -> LHsExpr GhcPs -> HsExpr GhcPs-mkHsCompAnns :: HsStmtContext GhcRn -> [ExprLStmt GhcPs] -> LHsExpr GhcPs+mkHsCompAnns :: HsDoFlavour -> [ExprLStmt GhcPs] -> LHsExpr GhcPs -> EpAnn AnnList -> HsExpr GhcPs @@ -345,9 +345,9 @@ -> StmtLR (GhcPass idL) GhcPs bodyR -mkHsIntegral i = OverLit noExtField (HsIntegral i) noExpr-mkHsFractional f = OverLit noExtField (HsFractional f) noExpr-mkHsIsString src s = OverLit noExtField (HsIsString src s) noExpr+mkHsIntegral i = OverLit noExtField (HsIntegral i)+mkHsFractional f = OverLit noExtField (HsFractional f)+mkHsIsString src s = OverLit noExtField (HsIsString src s) mkHsDo ctxt stmts = HsDo noAnn ctxt stmts mkHsDoAnns ctxt stmts anns = HsDo anns ctxt stmts@@ -575,7 +575,7 @@ nlWildPatName :: LPat GhcRn nlWildPatName = noLocA (WildPat noExtField ) -nlHsDo :: HsStmtContext GhcRn -> [LStmt GhcPs (LHsExpr GhcPs)]+nlHsDo :: HsDoFlavour -> [LStmt GhcPs (LHsExpr GhcPs)] -> LHsExpr GhcPs nlHsDo ctxt stmts = noLocA (mkHsDo ctxt (noLocA stmts))
compiler/GHC/HsToCore/Errors/Ppr.hs view
@@ -88,7 +88,7 @@ -> mkSimpleDecorated $ text "Ignoring useless SPECIALISE pragma for NOINLINE function:" <+> quotes (ppr poly_id) DsMultiplicityCoercionsNotSupported- -> mkSimpleDecorated $ text "Multiplicity coercions are currently not supported (see GHC #19517)"+ -> mkSimpleDecorated $ text "GHC bug #19517: GHC currently does not support programs using GADTs or type families to witness equality of multiplicities" DsOrphanRule rule -> mkSimpleDecorated $ text "Orphan rule:" <+> ppr rule DsRuleLhsTooComplicated orig_lhs lhs2@@ -165,6 +165,8 @@ text "Pragma for declaration of" <+> ppr decl ThSplicesWithinDeclBrackets -> mkMsg "Splices within declaration brackets" empty+ ThNonLinearDataCon+ -> mkMsg "Non-linear fields in data constructors" empty where mkMsg what doc = mkSimpleDecorated $
compiler/GHC/HsToCore/Errors/Types.hs view
@@ -192,6 +192,7 @@ | ThHaddockDocumentation | ThWarningAndDeprecationPragmas [LIdP GhcRn] | ThSplicesWithinDeclBrackets+ | ThNonLinearDataCon data NegLiteralExtEnabled = YesUsingNegLiterals
compiler/GHC/Parser/PostProcess.hs view
@@ -1362,7 +1362,7 @@ -- If the flag MonadComprehensions is set, return a 'MonadComp' context, -- otherwise use the usual 'ListComp' context -checkMonadComp :: PV (HsStmtContext GhcRn)+checkMonadComp :: PV HsDoFlavour checkMonadComp = do monadComprehensions <- getBit MonadComprehensionsBit return $ if monadComprehensions@@ -2514,8 +2514,8 @@ Just act -> act Nothing -> -- No phase specified case inl of- NoInline -> NeverActive- _other -> AlwaysActive+ NoInline _ -> NeverActive+ _other -> AlwaysActive ----------------------------------------------------------------------------- -- utilities for foreign declarations
compiler/GHC/Platform.hs view
@@ -73,7 +73,7 @@ , platformTablesNextToCode :: !Bool -- ^ Determines whether we will be compiling info tables that reside just -- before the entry code, or with an indirection to the entry code. See- -- TABLES_NEXT_TO_CODE in includes/rts/storage/InfoTables.h.+ -- TABLES_NEXT_TO_CODE in rts/include/rts/storage/InfoTables.h. , platform_constants :: !(Maybe PlatformConstants) -- ^ Constants such as structure offsets, type sizes, etc. }
compiler/GHC/Platform/AArch64.hs view
@@ -6,4 +6,4 @@ #define MACHREGS_NO_REGS 0 #define MACHREGS_aarch64 1-#include "../../../includes/CodeGen.Platform.hs"+#include "CodeGen.Platform.h"
compiler/GHC/Platform/ARM.hs view
@@ -6,5 +6,5 @@ #define MACHREGS_NO_REGS 0 #define MACHREGS_arm 1-#include "../../../includes/CodeGen.Platform.hs"+#include "CodeGen.Platform.h"
compiler/GHC/Platform/NoRegs.hs view
@@ -5,5 +5,5 @@ import GHC.Prelude #define MACHREGS_NO_REGS 1-#include "../../../includes/CodeGen.Platform.hs"+#include "CodeGen.Platform.h"
compiler/GHC/Platform/PPC.hs view
@@ -6,5 +6,5 @@ #define MACHREGS_NO_REGS 0 #define MACHREGS_powerpc 1-#include "../../../includes/CodeGen.Platform.hs"+#include "CodeGen.Platform.h"
compiler/GHC/Platform/RISCV64.hs view
@@ -6,5 +6,5 @@ #define MACHREGS_NO_REGS 0 #define MACHREGS_riscv64 1-#include "../../../includes/CodeGen.Platform.hs"+#include "CodeGen.Platform.h"
compiler/GHC/Platform/S390X.hs view
@@ -6,5 +6,5 @@ #define MACHREGS_NO_REGS 0 #define MACHREGS_s390x 1-#include "../../../includes/CodeGen.Platform.hs"+#include "CodeGen.Platform.h"
compiler/GHC/Platform/SPARC.hs view
@@ -6,5 +6,5 @@ #define MACHREGS_NO_REGS 0 #define MACHREGS_sparc 1-#include "../../../includes/CodeGen.Platform.hs"+#include "CodeGen.Platform.h"
compiler/GHC/Platform/X86.hs view
@@ -6,5 +6,5 @@ #define MACHREGS_NO_REGS 0 #define MACHREGS_i386 1-#include "../../../includes/CodeGen.Platform.hs"+#include "CodeGen.Platform.h"
compiler/GHC/Platform/X86_64.hs view
@@ -6,5 +6,5 @@ #define MACHREGS_NO_REGS 0 #define MACHREGS_x86_64 1-#include "../../../includes/CodeGen.Platform.hs"+#include "CodeGen.Platform.h"
compiler/GHC/Runtime/Heap/Layout.hs view
@@ -181,7 +181,7 @@ type IsStatic = Bool -- From an SMRep you can get to the closure type defined in--- includes/rts/storage/ClosureTypes.h. Described by the function+-- rts/include/rts/storage/ClosureTypes.h. Described by the function -- rtsClosureType below. data ClosureTypeInfo@@ -404,8 +404,8 @@ ----------------------------------------------------------------------------- -- deriving the RTS closure type from an SMRep -#include "rts/storage/ClosureTypes.h"-#include "rts/storage/FunTypes.h"+#include "ClosureTypes.h"+#include "FunTypes.h" -- Defines CONSTR, CONSTR_1_0 etc -- | Derives the RTS closure type from an 'SMRep'
compiler/GHC/Settings.hs view
@@ -16,7 +16,6 @@ , sGhciUsagePath , sToolDir , sTopDir- , sTmpDir , sGlobalPackageDatabasePath , sLdSupportsCompactUnwind , sLdSupportsBuildId@@ -151,7 +150,6 @@ , fileSettings_ghciUsagePath :: FilePath -- ditto , fileSettings_toolDir :: Maybe FilePath -- ditto , fileSettings_topDir :: FilePath -- ditto- , fileSettings_tmpDir :: String -- no trailing '/' , fileSettings_globalPackageDatabase :: FilePath } @@ -182,8 +180,6 @@ sToolDir = fileSettings_toolDir . sFileSettings sTopDir :: Settings -> FilePath sTopDir = fileSettings_topDir . sFileSettings-sTmpDir :: Settings -> String-sTmpDir = fileSettings_tmpDir . sFileSettings sGlobalPackageDatabasePath :: Settings -> FilePath sGlobalPackageDatabasePath = fileSettings_globalPackageDatabase . sFileSettings
compiler/GHC/SysTools/BaseDir.hs view
@@ -100,7 +100,7 @@ set in `aclocal.m4`. This allows the rest of the build system to have access to these and other values determined by configure. - Based on this file, `includes/ghc.mk` when ran will produce the settings file+ Based on this file, `rts/include/ghc.mk` when ran will produce the settings file by echoing the values into a the final file. Coincidentally this is also where `ghcplatform.h` and `ghcversion.h` generated which contains information about the build platform and sets CPP for use by the entire build.@@ -118,7 +118,7 @@ The last part of this is the `generateSettings` in `src/Rules/Generate.hs` which produces the desired settings file out of Hadrian. This is the- equivalent to `includes/ghc.mk`.+ equivalent to `rts/include/ghc.mk`. --
compiler/GHC/Tc/Errors/Ppr.hs view
@@ -11,9 +11,13 @@ import GHC.Core.TyCo.Ppr (pprWithTYPE) import GHC.Core.Type+import GHC.Data.Bag import GHC.Tc.Errors.Types import GHC.Types.Error+import GHC.Types.Name (pprPrefixName) import GHC.Types.Name.Reader (pprNameProvenance)+import GHC.Types.SrcLoc (GenLocated(..))+import GHC.Types.Name.Occurrence (occName) import GHC.Types.Var.Env (emptyTidyEnv) import GHC.Driver.Flags import GHC.Hs@@ -52,6 +56,14 @@ -> mkDecorated [text "Use of plugins makes the module unsafe"] TcRnModMissingRealSrcSpan mod -> mkDecorated [text "Module does not have a RealSrcSpan:" <+> ppr mod]+ TcRnIdNotExportedFromModuleSig name mod+ -> mkDecorated [ text "The identifier" <+> ppr (occName name) <+>+ text "does not exist in the signature for" <+> ppr mod+ ]+ TcRnIdNotExportedFromLocalSig name+ -> mkDecorated [ text "The identifier" <+> ppr (occName name) <+>+ text "does not exist in the local signature."+ ] TcRnShadowedName occ provenance -> let shadowed_locs = case provenance of ShadowedNameProvenanceLocal n -> [text "bound at" <+> ppr n]@@ -95,6 +107,68 @@ -> mkSimpleDecorated $ vcat [ text "Illegal `..' notation for constructor" <+> quotes (ppr con) , nest 2 (text "The constructor has no labelled fields") ]+ TcRnIgnoringAnnotations anns+ -> mkSimpleDecorated $+ text "Ignoring ANN annotation" <> plural anns <> comma+ <+> text "because this is a stage-1 compiler without -fexternal-interpreter or doesn't support GHCi"+ TcRnAnnotationInSafeHaskell+ -> mkSimpleDecorated $+ vcat [ text "Annotations are not compatible with Safe Haskell."+ , text "See https://gitlab.haskell.org/ghc/ghc/issues/10826" ]+ TcRnInvalidTypeApplication fun_ty hs_ty+ -> mkSimpleDecorated $+ text "Cannot apply expression of type" <+> quotes (ppr fun_ty) $$+ text "to a visible type argument" <+> quotes (ppr hs_ty)+ TcRnTagToEnumMissingValArg+ -> mkSimpleDecorated $+ text "tagToEnum# must appear applied to one value argument"+ TcRnTagToEnumUnspecifiedResTy ty+ -> mkSimpleDecorated $+ hang (text "Bad call to tagToEnum# at type" <+> ppr ty)+ 2 (vcat [ text "Specify the type by giving a type signature"+ , text "e.g. (tagToEnum# x) :: Bool" ])+ TcRnTagToEnumResTyNotAnEnum ty+ -> mkSimpleDecorated $+ hang (text "Bad call to tagToEnum# at type" <+> ppr ty)+ 2 (text "Result type must be an enumeration type")+ TcRnArrowIfThenElsePredDependsOnResultTy+ -> mkSimpleDecorated $+ text "Predicate type of `ifThenElse' depends on result type"+ TcRnArrowCommandExpected cmd+ -> mkSimpleDecorated $+ vcat [text "The expression", nest 2 (ppr cmd),+ text "was found where an arrow command was expected"]+ TcRnIllegalHsBootFileDecl+ -> mkSimpleDecorated $+ text "Illegal declarations in an hs-boot file"+ TcRnRecursivePatternSynonym binds+ -> mkSimpleDecorated $+ 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 :: GenLocated (SrcSpanAnn' a) (HsBindLR GhcRn idR) -> SDoc+ pprLBind (L loc bind) = pprWithCommas ppr (collectHsBindBinders CollNoDictBinders bind)+ <+> pprLoc (locA loc)+ TcRnPartialTypeSigTyVarMismatch n1 n2 fn_name hs_ty+ -> mkSimpleDecorated $+ 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))+ TcRnPartialTypeSigBadQuantifier n fn_name hs_ty+ -> mkSimpleDecorated $+ 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))+ TcRnPolymorphicBinderMissingSig n ty+ -> mkSimpleDecorated $+ sep [ text "Polymorphic local binding with no type signature:"+ , nest 2 $ pprPrefixName n <+> dcolon <+> ppr ty ]+ TcRnOverloadedSig sig+ -> mkSimpleDecorated $+ hang (text "Overloaded signature conflicts with monomorphism restriction")+ 2 (ppr sig) diagnosticReason = \case TcRnUnknownMessage m@@ -118,6 +192,10 @@ -> WarningWithoutFlag TcRnModMissingRealSrcSpan{} -> ErrorWithoutFlag+ TcRnIdNotExportedFromModuleSig{}+ -> ErrorWithoutFlag+ TcRnIdNotExportedFromLocalSig{}+ -> ErrorWithoutFlag TcRnShadowedName{} -> WarningWithFlag Opt_WarnNameShadowing TcRnDuplicateWarningDecls{}@@ -142,6 +220,34 @@ -> ErrorWithoutFlag TcRnIllegalWildcardsInConstructor{} -> ErrorWithoutFlag+ TcRnIgnoringAnnotations{}+ -> WarningWithoutFlag+ TcRnAnnotationInSafeHaskell+ -> ErrorWithoutFlag+ TcRnInvalidTypeApplication{}+ -> ErrorWithoutFlag+ TcRnTagToEnumMissingValArg+ -> ErrorWithoutFlag+ TcRnTagToEnumUnspecifiedResTy{}+ -> ErrorWithoutFlag+ TcRnTagToEnumResTyNotAnEnum{}+ -> ErrorWithoutFlag+ TcRnArrowIfThenElsePredDependsOnResultTy+ -> ErrorWithoutFlag+ TcRnArrowCommandExpected{}+ -> ErrorWithoutFlag+ TcRnIllegalHsBootFileDecl+ -> ErrorWithoutFlag+ TcRnRecursivePatternSynonym{}+ -> ErrorWithoutFlag+ TcRnPartialTypeSigTyVarMismatch{}+ -> ErrorWithoutFlag+ TcRnPartialTypeSigBadQuantifier{}+ -> ErrorWithoutFlag+ TcRnPolymorphicBinderMissingSig{}+ -> WarningWithFlag Opt_WarnMissingLocalSignatures+ TcRnOverloadedSig{}+ -> ErrorWithoutFlag diagnosticHints = \case TcRnUnknownMessage m@@ -165,6 +271,10 @@ -> noHints TcRnModMissingRealSrcSpan{} -> noHints+ TcRnIdNotExportedFromModuleSig name mod+ -> [SuggestAddToHSigExportList name $ Just mod]+ TcRnIdNotExportedFromLocalSig name+ -> [SuggestAddToHSigExportList name Nothing] TcRnShadowedName{} -> noHints TcRnDuplicateWarningDecls{}@@ -188,6 +298,34 @@ TcRnCharLiteralOutOfRange{} -> noHints TcRnIllegalWildcardsInConstructor{}+ -> noHints+ TcRnIgnoringAnnotations{}+ -> noHints+ TcRnAnnotationInSafeHaskell+ -> noHints+ TcRnInvalidTypeApplication{}+ -> noHints+ TcRnTagToEnumMissingValArg+ -> noHints+ TcRnTagToEnumUnspecifiedResTy{}+ -> noHints+ TcRnTagToEnumResTyNotAnEnum{}+ -> noHints+ TcRnArrowIfThenElsePredDependsOnResultTy+ -> noHints+ TcRnArrowCommandExpected{}+ -> noHints+ TcRnIllegalHsBootFileDecl+ -> noHints+ TcRnRecursivePatternSynonym{}+ -> noHints+ TcRnPartialTypeSigTyVarMismatch{}+ -> noHints+ TcRnPartialTypeSigBadQuantifier{}+ -> noHints+ TcRnPolymorphicBinderMissingSig{}+ -> noHints+ TcRnOverloadedSig{} -> noHints messageWithInfoDiagnosticMessage :: UnitState
compiler/GHC/Tc/Errors/Types.hs view
@@ -1,5 +1,4 @@ {-# LANGUAGE GADTs #-}-{-# LANGUAGE FlexibleContexts #-} module GHC.Tc.Errors.Types ( -- * Main types TcRnMessage(..)@@ -13,6 +12,7 @@ import GHC.Prelude import GHC.Hs+import {-# SOURCE #-} GHC.Tc.Types (TcIdSigInfo) import GHC.Tc.Types.Constraint import GHC.Types.Error import GHC.Types.Name (Name, OccName)@@ -165,14 +165,37 @@ with a plugin, the TcRnUnsafeDueToPlugin warning (controlled by -Wunsafe) is used as the reason the module was inferred to be unsafe. This warning is not raised if the -fplugin-trustworthy flag is passed.++ Test cases: plugins/T19926 -} TcRnUnsafeDueToPlugin :: TcRnMessage {-| TcRnModMissingRealSrcSpan is an error that occurrs when compiling a module that lacks an associated 'RealSrcSpan'.++ Test cases: None -} TcRnModMissingRealSrcSpan :: Module -> TcRnMessage+ {-| TcRnIdNotExportedFromModuleSig is an error pertaining to backpack that occurs+ when an identifier required by a signature is not exported by the module+ or signature that is being used as a substitution for that signature. + Example(s): None + Test cases: backpack/should_fail/bkpfail36+ -}+ TcRnIdNotExportedFromModuleSig :: Name -> Module -> TcRnMessage+ {-| TcRnIdNotExportedFromLocalSig is an error pertaining to backpack that+ occurs when an identifier which is necessary for implementing a module+ signature is not exported from that signature.++ Example(s): None++ Test cases: backpack/should_fail/bkpfail30+ backpack/should_fail/bkpfail31+ backpack/should_fail/bkpfail34+ -}+ TcRnIdNotExportedFromLocalSig :: Name -> TcRnMessage+ {-| TcRnShadowedName is a warning (controlled by -Wname-shadowing) that occurs whenever an inner-scope value has the same name as an outer-scope value, i.e. the inner value shadows the outer one. This can catch typographical errors that turn into@@ -320,6 +343,171 @@ Test cases: None -} TcRnIllegalWildcardsInConstructor :: !Name -> TcRnMessage++ {-| TcRnIgnoringAnnotations is a warning that occurs when the source code+ contains annotation pragmas but the platform in use does not support an+ external interpreter such as GHCi and therefore the annotations are ignored.++ Example(s): None++ Test cases: None+ -}+ TcRnIgnoringAnnotations :: [LAnnDecl GhcRn] -> TcRnMessage++ {-| TcRnAnnotationInSafeHaskell is an error that occurs if annotation pragmas+ are used in conjunction with Safe Haskell.++ Example(s): None++ Test cases: annotations/should_fail/T10826+ -}+ TcRnAnnotationInSafeHaskell :: TcRnMessage++ {-| TcRnInvalidTypeApplication is an error that occurs when a visible type application+ is used with an expression that does not accept "specified" type arguments.++ Example(s):+ foo :: forall {a}. a -> a+ foo x = x+ bar :: ()+ bar = let x = foo @Int 42+ in ()++ Test cases: overloadedrecflds/should_fail/overloadedlabelsfail03+ typecheck/should_fail/ExplicitSpecificity1+ typecheck/should_fail/ExplicitSpecificity10+ typecheck/should_fail/ExplicitSpecificity2+ typecheck/should_fail/T17173+ typecheck/should_fail/VtaFail+ -}+ TcRnInvalidTypeApplication :: Type -> LHsWcType GhcRn -> TcRnMessage++ {-| TcRnTagToEnumMissingValArg is an error that occurs when the 'tagToEnum#'+ function is not applied to a single value argument.++ Example(s):+ tagToEnum# 1 2++ Test cases: None+ -}+ TcRnTagToEnumMissingValArg :: TcRnMessage++ {-| TcRnTagToEnumUnspecifiedResTy is an error that occurs when the 'tagToEnum#'+ function is not given a concrete result type.++ Example(s):+ foo :: forall a. a+ foo = tagToEnum# 0#++ Test cases: typecheck/should_fail/tcfail164+ -}+ TcRnTagToEnumUnspecifiedResTy :: Type -> TcRnMessage++ {-| TcRnTagToEnumResTyNotAnEnum is an error that occurs when the 'tagToEnum#'+ function is given a result type that is not an enumeration type.++ Example(s):+ foo :: Int -- not an enumeration TyCon+ foo = tagToEnum# 0#++ Test cases: typecheck/should_fail/tcfail164+ -}+ TcRnTagToEnumResTyNotAnEnum :: Type -> TcRnMessage++ {-| TcRnArrowIfThenElsePredDependsOnResultTy is an error that occurs when the+ predicate type of an ifThenElse expression in arrow notation depends on+ the type of the result.++ Example(s): None++ Test cases: None+ -}+ TcRnArrowIfThenElsePredDependsOnResultTy :: TcRnMessage++ {-| TcRnArrowCommandExpected is an error that occurs if a non-arrow command+ is used where an arrow command is expected.++ Example(s): None++ Test cases: None+ -}+ TcRnArrowCommandExpected :: HsCmd GhcRn -> TcRnMessage++ {-| TcRnIllegalHsBootFileDecl is an error that occurs when an hs-boot file+ contains declarations that are not allowed, such as bindings.++ Example(s): None++ Test cases: None+ -}+ TcRnIllegalHsBootFileDecl :: TcRnMessage++ {-| TcRnRecursivePatternSynonym is an error that occurs when a pattern synonym+ is defined in terms of itself, either directly or indirectly.++ Example(s):+ pattern A = B+ pattern B = A++ Test cases: patsyn/should_fail/T16900+ -}+ TcRnRecursivePatternSynonym :: LHsBinds GhcRn -> TcRnMessage++ {-| TcRnPartialTypeSigTyVarMismatch is an error that occurs when a partial type signature+ attempts to unify two different types.++ Example(s):+ f :: a -> b -> _+ f x y = [x, y]++ Test cases: partial-sigs/should_fail/T14449+ -}+ TcRnPartialTypeSigTyVarMismatch+ :: Name -- ^ first type variable+ -> Name -- ^ second type variable+ -> Name -- ^ function name+ -> LHsSigWcType GhcRn -> TcRnMessage++ {-| TcRnPartialTypeSigBadQuantifier is an error that occurs when a type variable+ being quantified over in the partial type signature of a function gets unified+ with a type that is free in that function's context.++ Example(s):+ foo :: Num a => a -> a+ foo xxx = g xxx+ where+ g :: forall b. Num b => _ -> b+ g y = xxx + y++ Test cases: partial-sig/should_fail/T14479+ -}+ TcRnPartialTypeSigBadQuantifier+ :: Name -- ^ type variable being quantified+ -> Name -- ^ function name+ -> LHsSigWcType GhcRn -> TcRnMessage++ {-| TcRnPolymorphicBinderMissingSig is a warning controlled by -Wmissing-local-signatures+ that occurs when a local polymorphic binding lacks a type signature.++ Example(s):+ id a = a++ Test cases: warnings/should_compile/T12574+ -}+ TcRnPolymorphicBinderMissingSig :: Name -> Type -> TcRnMessage++ {-| TcRnOverloadedSig is an error that occurs when a binding group conflicts+ with the monomorphism restriction.++ Example(s):+ data T a = T a+ mono = ... where+ x :: Applicative f => f a+ T x = ...++ Test cases: typecheck/should_compile/T11339+ -}+ TcRnOverloadedSig :: TcIdSigInfo -> TcRnMessage -- | Which parts of a record field are affected by a particular error or warning. data RecordFieldPart
compiler/GHC/Tc/Solver/InertSet.hs view
@@ -36,12 +36,12 @@ import GHC.Tc.Solver.Types import GHC.Tc.Types.Constraint-import GHC.Tc.Types.Evidence import GHC.Tc.Types.Origin import GHC.Tc.Utils.TcType import GHC.Types.Var import GHC.Types.Var.Env +import GHC.Core.Reduction import GHC.Core.Predicate import GHC.Core.TyCo.FVs import qualified GHC.Core.TyCo.Rep as Rep@@ -243,12 +243,12 @@ -- used to undo the cycle-breaking needed to handle -- Note [Type variable cycles] in GHC.Tc.Solver.Canonical - , inert_famapp_cache :: FunEqMap (TcCoercion, TcType)+ , inert_famapp_cache :: FunEqMap Reduction -- Just a hash-cons cache for use when reducing family applications -- only -- -- If F tys :-> (co, rhs, flav),- -- then co :: rhs ~N F tys+ -- then co :: F tys ~N rhs -- all evidence is from instances or Givens; no coercion holes here -- (We have no way of "kicking out" from the cache, so putting -- wanteds here means we can end up solving a Wanted with itself. Bad)
compiler/GHC/Tc/Types.hs view
@@ -1,7 +1,9 @@ -{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE PatternSynonyms #-} {- (c) The University of Glasgow 2006-2012@@ -32,6 +34,7 @@ setLclEnvLoc, getLclEnvLoc, IfGblEnv(..), IfLclEnv(..), tcVisibleOrphanMods,+ RewriteEnv(..), -- Frontend types (shouldn't really be here) FrontendResult(..),@@ -72,9 +75,11 @@ getPlatform, -- Constraint solver plugins- TcPlugin(..), TcPluginResult(..), TcPluginSolver,- TcPluginM, runTcPluginM, unsafeTcPluginTcM,- getEvBindsTcPluginM,+ TcPlugin(..),+ TcPluginSolveResult(TcPluginContradiction, TcPluginOk, ..),+ TcPluginRewriteResult(..),+ TcPluginSolver, TcPluginRewriter,+ TcPluginM(runTcPluginM), unsafeTcPluginTcM, -- Role annotations RoleAnnotEnv, emptyRoleAnnotEnv, mkRoleAnnotEnv,@@ -103,6 +108,7 @@ import {-# SOURCE #-} GHC.Tc.Errors.Hole.FitTypes ( HoleFitPlugin ) import GHC.Tc.Errors.Types +import GHC.Core.Reduction ( Reduction(..) ) import GHC.Core.Type import GHC.Core.TyCon ( TyCon, tyConKind ) import GHC.Core.PatSyn ( PatSyn )@@ -110,6 +116,7 @@ import GHC.Core.UsageEnv import GHC.Core.InstEnv import GHC.Core.FamInstEnv+import GHC.Core.Predicate import GHC.Types.Id ( idType, idName ) import GHC.Types.FieldLabel ( FieldLabel )@@ -151,10 +158,8 @@ import GHC.Builtin.Names ( isUnboundName ) -import Control.Monad (ap) import Data.Set ( Set ) import qualified Data.Set as S-import Data.List ( sort ) import Data.Map ( Map ) import Data.Dynamic ( Dynamic ) import Data.Typeable ( TypeRep )@@ -163,6 +168,7 @@ import GHCi.RemoteTypes import qualified Language.Haskell.TH as TH+import GHC.Driver.Env.KnotVars -- | A 'NameShape' is a substitution on 'Name's that can be used -- to refine the identities of a hole while we are renaming interfaces@@ -251,7 +257,41 @@ instance ContainsModule gbl => ContainsModule (Env gbl lcl) where extractModule env = extractModule (env_gbl env) +{-+************************************************************************+* *+* RewriteEnv+* The rewriting environment+* *+************************************************************************+-} +-- | A 'RewriteEnv' carries the necessary context for performing rewrites+-- (i.e. type family reductions and following filled-in metavariables)+-- in the solver.+data RewriteEnv+ = FE { fe_loc :: !CtLoc+ -- ^ In which context are we rewriting?+ --+ -- Type-checking plugins might want to use this location information+ -- when emitting new Wanted constraints when rewriting type family+ -- applications. This ensures that such Wanted constraints will,+ -- when unsolved, give rise to error messages with the+ -- correct source location.++ -- Within GHC, we use this field to keep track of reduction depth.+ -- See Note [Rewriter CtLoc] in GHC.Tc.Solver.Rewrite.+ , fe_flavour :: !CtFlavour+ , fe_eq_rel :: !EqRel+ -- ^ At what role are we rewriting?+ --+ -- See Note [Rewriter EqRels] in GHC.Tc.Solver.Rewrite+ }+-- RewriteEnv is mostly used in @GHC.Tc.Solver.Rewrite@, but it is defined+-- here so that it can also be passed to rewriting plugins.+-- See the 'tcPluginRewrite' field of 'TcPlugin'.++ {- ************************************************************************ * *@@ -272,7 +312,7 @@ -- We need the module name so we can test when it's appropriate -- to look in this env. -- See Note [Tying the knot] in GHC.IfaceToCore- if_rec_types :: Maybe (Module, IfG TypeEnv)+ if_rec_types :: !(KnotVars (IfG TypeEnv)) -- Allows a read effect, so it can be in a mutable -- variable; c.f. handling the external package type env -- Nothing => interactive stuff, no loops possible@@ -285,7 +325,7 @@ -- it means M.f = \x -> x, where M is the if_mod -- NB: This is a semantic module, see -- Note [Identity versus semantic module]- if_mod :: Module,+ if_mod :: !Module, -- Whether or not the IfaceDecl came from a boot -- file or not; we'll use this to choose between@@ -407,7 +447,7 @@ -- NB: for what "things in this module" means, see -- Note [The interactive package] in "GHC.Runtime.Context" - tcg_type_env_var :: TcRef TypeEnv,+ tcg_type_env_var :: KnotVars (IORef TypeEnv), -- Used only to initialise the interface-file -- typechecker in initIfaceTcRn, so that it can see stuff -- bound in this module when dealing with hi-boot recursions@@ -573,8 +613,13 @@ -- are supplied (#19714), or if those reasons have already been -- reported by GHC.Driver.Main.markUnsafeInfer - tcg_tc_plugins :: [TcPluginSolver],- -- ^ A list of user-defined plugins for the constraint solver.+ tcg_tc_plugin_solvers :: [TcPluginSolver],+ -- ^ A list of user-defined type-checking plugins for constraint solving.++ tcg_tc_plugin_rewriters :: UniqFM TyCon [TcPluginRewriter],+ -- ^ A collection of all the user-defined type-checking plugins for rewriting+ -- type family applications, collated by their type family 'TyCon's.+ tcg_hf_plugins :: [HoleFitPlugin], -- ^ A list of user-defined plugins for hole fit suggestions. @@ -1384,9 +1429,9 @@ -- including us for imported modules) } -mkModDeps :: [ModuleNameWithIsBoot]+mkModDeps :: Set ModuleNameWithIsBoot -> ModuleNameEnv ModuleNameWithIsBoot-mkModDeps deps = foldl' add emptyUFM deps+mkModDeps deps = S.foldl' add emptyUFM deps where add env elt = addToUFM env (gwib_mod elt) elt @@ -1406,8 +1451,8 @@ modDepsElts :: ModuleNameEnv ModuleNameWithIsBoot- -> [ModuleNameWithIsBoot]-modDepsElts = sort . nonDetEltsUFM+ -> Set ModuleNameWithIsBoot+modDepsElts = S.fromList . nonDetEltsUFM -- It's OK to use nonDetEltsUFM here because sorting by module names -- restores determinism @@ -1666,65 +1711,130 @@ ------------------------- -} -type TcPluginSolver = [Ct] -- given- -> [Ct] -- derived- -> [Ct] -- wanted- -> TcPluginM TcPluginResult--newtype TcPluginM a = TcPluginM (EvBindsVar -> TcM a) deriving (Functor)--instance Applicative TcPluginM where- pure x = TcPluginM (const $ pure x)- (<*>) = ap--instance Monad TcPluginM where- TcPluginM m >>= k =- TcPluginM (\ ev -> do a <- m ev- runTcPluginM (k a) ev)+-- | The @solve@ function of a type-checking plugin takes in Given, Derived+-- and Wanted constraints, and should return a 'TcPluginSolveResult'+-- indicating which Wanted constraints it could solve, or whether any are+-- insoluble.+type TcPluginSolver = [Ct] -- ^ Givens+ -> [Ct] -- ^ Deriveds+ -> [Ct] -- ^ Wanteds+ -> TcPluginM TcPluginSolveResult -instance MonadFail TcPluginM where- fail x = TcPluginM (const $ fail x)+-- | For rewriting type family applications, a type-checking plugin provides+-- a function of this type for each type family 'TyCon'.+--+-- The function is provided with the current set of Given constraints, together+-- with the arguments to the type family.+-- The type family application will always be fully saturated.+type TcPluginRewriter+ = RewriteEnv -- ^ Rewriter environment+ -> [Ct] -- ^ Givens+ -> [TcType] -- ^ type family arguments+ -> TcPluginM TcPluginRewriteResult -runTcPluginM :: TcPluginM a -> EvBindsVar -> TcM a-runTcPluginM (TcPluginM m) = m+-- | 'TcPluginM' is the monad in which type-checking plugins operate.+newtype TcPluginM a = TcPluginM { runTcPluginM :: TcM a }+ deriving newtype (Functor, Applicative, Monad, MonadFail) -- | This function provides an escape for direct access to -- the 'TcM` monad. It should not be used lightly, and -- the provided 'TcPluginM' API should be favoured instead. unsafeTcPluginTcM :: TcM a -> TcPluginM a-unsafeTcPluginTcM = TcPluginM . const---- | Access the 'EvBindsVar' carried by the 'TcPluginM' during--- constraint solving. Returns 'Nothing' if invoked during--- 'tcPluginInit' or 'tcPluginStop'.-getEvBindsTcPluginM :: TcPluginM EvBindsVar-getEvBindsTcPluginM = TcPluginM return-+unsafeTcPluginTcM = TcPluginM data TcPlugin = forall s. TcPlugin- { tcPluginInit :: TcPluginM s+ { tcPluginInit :: TcPluginM s -- ^ Initialize plugin, when entering type-checker. - , tcPluginSolve :: s -> TcPluginSolver+ , tcPluginSolve :: s -> EvBindsVar -> TcPluginSolver -- ^ Solve some constraints.- -- TODO: WRITE MORE DETAILS ON HOW THIS WORKS.+ --+ -- This function will be invoked at two points in the constraint solving+ -- process: once to simplify Given constraints, and once to solve+ -- Wanted constraints. In the first case (and only in the first case),+ -- no Wanted constraints will be passed to the plugin.+ --+ -- The plugin can either return a contradiction,+ -- or specify that it has solved some constraints (with evidence),+ -- and possibly emit additional constraints. These returned constraints+ -- must be Givens in the first case, and Wanteds in the second.+ --+ -- Use @ \\ _ _ _ _ _ -> pure $ TcPluginOK [] [] @ if your plugin+ -- does not provide this functionality. - , tcPluginStop :: s -> TcPluginM ()+ , tcPluginRewrite :: s -> UniqFM TyCon TcPluginRewriter+ -- ^ Rewrite saturated type family applications.+ --+ -- The plugin is expected to supply a mapping from type family names to+ -- rewriting functions. For each type family 'TyCon', the plugin should+ -- provide a function which takes in the given constraints and arguments+ -- of a saturated type family application, and return a possible rewriting.+ -- See 'TcPluginRewriter' for the expected shape of such a function.+ --+ -- Use @ \\ _ -> emptyUFM @ if your plugin does not provide this functionality.++ , tcPluginStop :: s -> TcPluginM () -- ^ Clean up after the plugin, when exiting the type-checker. } -data TcPluginResult- = TcPluginContradiction [Ct]- -- ^ The plugin found a contradiction.- -- The returned constraints are removed from the inert set,- -- and recorded as insoluble.+-- | The plugin found a contradiction.+-- The returned constraints are removed from the inert set,+-- and recorded as insoluble.+--+-- The returned list of constraints should never be empty.+pattern TcPluginContradiction :: [Ct] -> TcPluginSolveResult+pattern TcPluginContradiction insols+ = TcPluginSolveResult+ { tcPluginInsolubleCts = insols+ , tcPluginSolvedCts = []+ , tcPluginNewCts = [] } - | TcPluginOk [(EvTerm,Ct)] [Ct]- -- ^ The first field is for constraints that were solved.- -- These are removed from the inert set,- -- and the evidence for them is recorded.- -- The second field contains new work, that should be processed by- -- the constraint solver.+-- | The plugin has not found any contradictions,+--+-- The first field is for constraints that were solved.+-- The second field contains new work, that should be processed by+-- the constraint solver.+pattern TcPluginOk :: [(EvTerm, Ct)] -> [Ct] -> TcPluginSolveResult+pattern TcPluginOk solved new+ = TcPluginSolveResult+ { tcPluginInsolubleCts = []+ , tcPluginSolvedCts = solved+ , tcPluginNewCts = new }++-- | Result of running a solver plugin.+data TcPluginSolveResult+ = TcPluginSolveResult+ { -- | Insoluble constraints found by the plugin.+ --+ -- These constraints will be added to the inert set,+ -- and reported as insoluble to the user.+ tcPluginInsolubleCts :: [Ct]+ -- | Solved constraints, together with their evidence.+ --+ -- These are removed from the inert set, and the+ -- evidence for them is recorded.+ , tcPluginSolvedCts :: [(EvTerm, Ct)]+ -- | New constraints that the plugin wishes to emit.+ --+ -- These will be added to the work list.+ , tcPluginNewCts :: [Ct]+ }++data TcPluginRewriteResult+ =+ -- | The plugin does not rewrite the type family application.+ TcPluginNoRewrite++ -- | The plugin rewrites the type family application+ -- providing a rewriting together with evidence: a 'Reduction',+ -- which contains the rewritten type together with a 'Coercion'+ -- whose right-hand-side type is the rewritten type.+ --+ -- The plugin can also emit additional Wanted constraints.+ | TcPluginRewriteTo+ { tcPluginReduction :: !Reduction+ , tcRewriterNewWanteds :: [Ct]+ } {- ********************************************************************* * *
compiler/GHC/Tc/Types.hs-boot view
@@ -2,8 +2,12 @@ import GHC.Tc.Utils.TcType import GHC.Types.SrcLoc+import GHC.Utils.Outputable data TcLclEnv++data TcIdSigInfo+instance Outputable TcIdSigInfo setLclEnvTcLevel :: TcLclEnv -> TcLevel -> TcLclEnv getLclEnvTcLevel :: TcLclEnv -> TcLevel
compiler/GHC/Tc/Types/Constraint.hs view
@@ -43,7 +43,7 @@ isSolvedWC, andWC, unionsWC, mkSimpleWC, mkImplicWC, addInsols, dropMisleading, addSimples, addImplics, addHoles, tyCoVarsOfWC, dropDerivedWC, dropDerivedSimples,- tyCoVarsOfWCList, insolubleCt, insolubleEqCt,+ tyCoVarsOfWCList, insolubleWantedCt, insolubleEqCt, insolubleCt, isDroppableCt, insolubleImplic, arisesFromGivens, @@ -1129,7 +1129,7 @@ -- for why this function is so strange, treating the 'simples' -- and the implications differently. Sigh. dropMisleading (WC { wc_simple = simples, wc_impl = implics, wc_holes = holes })- = WC { wc_simple = filterBag insolubleCt simples+ = WC { wc_simple = filterBag insolubleWantedCt simples , wc_impl = mapBag drop_implic implics , wc_holes = filterBag isOutOfScopeHole holes } where@@ -1158,19 +1158,20 @@ insolubleWC :: WantedConstraints -> Bool insolubleWC (WC { wc_impl = implics, wc_simple = simples, wc_holes = holes })- = anyBag insolubleCt simples+ = anyBag insolubleWantedCt simples || anyBag insolubleImplic implics || anyBag isOutOfScopeHole holes -- See Note [Insoluble holes] -insolubleCt :: Ct -> Bool+insolubleWantedCt :: Ct -> Bool -- Definitely insoluble, in particular /excluding/ type-hole constraints--- Namely: a) an equality constraint--- b) that is insoluble--- c) and does not arise from a Given-insolubleCt ct- | not (insolubleEqCt ct) = False- | arisesFromGivens ct = False -- See Note [Given insolubles]- | otherwise = True+-- Namely:+-- a) an insoluble constraint as per 'insolubleCt', i.e. either+-- - an insoluble equality constraint (e.g. Int ~ Bool), or+-- - a custom type error constraint, TypeError msg :: Constraint+-- b) that does not arise from a Given+--+-- See Note [Given insolubles].+insolubleWantedCt ct = insolubleCt ct && not (arisesFromGivens ct) insolubleEqCt :: Ct -> Bool -- Returns True of /equality/ constraints@@ -1189,6 +1190,34 @@ -- (where F is an arity-1 type function) insolubleEqCt (CIrredCan { cc_reason = reason }) = isInsolubleReason reason insolubleEqCt _ = False++-- | Returns True of equality constraints that are definitely insoluble,+-- as well as TypeError constraints.+-- Can return 'True' for Given constraints, unlike 'insolubleWantedCt'.+--+-- This function is critical for accurate pattern-match overlap warnings.+-- See Note [Pattern match warnings with insoluble Givens] in GHC.Tc.Solver+--+-- Note that this does not traverse through the constraint to find+-- nested custom type errors: it only detects @TypeError msg :: Constraint@,+-- and not e.g. @Eq (TypeError msg)@.+insolubleCt :: Ct -> Bool+insolubleCt ct+ | Just _ <- userTypeError_maybe (ctPred ct)+ -- Don't use 'isUserTypeErrorCt' here, as that function is too eager:+ -- the TypeError might appear inside a type family application+ -- which might later reduce, but we only want to return 'True'+ -- for constraints that are definitely insoluble.+ --+ -- Test case: T11503, with the 'Assert' type family:+ --+ -- > type Assert :: Bool -> Constraint -> Constraint+ -- > type family Assert check errMsg where+ -- > Assert 'True _errMsg = ()+ -- > Assert _check errMsg = errMsg+ = True+ | otherwise+ = insolubleEqCt ct -- | Does this hole represent an "out of scope" error? -- See Note [Insoluble holes]
compiler/GHC/Tc/Types/Evidence.hs view
@@ -97,6 +97,8 @@ import GHC.Types.Unique.Set import GHC.Core.Multiplicity +import qualified Data.Semigroup as S+ {- Note [TcCoercions] ~~~~~~~~~~~~~~~~~~@@ -293,6 +295,25 @@ toConstr (WpMultCoercion _) = wpMultCoercion_constr dataTypeOf _ = hsWrapper_dataType++-- | The Semigroup instance is a bit fishy, since @WpCompose@, as a data+-- constructor, is "syntactic" and not associative. Concretely, if @a@, @b@,+-- and @c@ aren't @WpHole@:+--+-- > (a <> b) <> c ?= a <> (b <> c)+--+-- ==>+--+-- > (a `WpCompose` b) `WpCompose` c /= @ a `WpCompose` (b `WpCompose` c)+--+-- However these two associations are are "semantically equal" in the sense+-- that they produce equal functions when passed to+-- @GHC.HsToCore.Binds.dsHsWrapper@.+instance S.Semigroup HsWrapper where+ (<>) = (<.>)++instance Monoid HsWrapper where+ mempty = WpHole hsWrapper_dataType :: Data.DataType hsWrapper_dataType
compiler/GHC/Types/Basic.hs view
@@ -84,7 +84,10 @@ InlinePragma(..), defaultInlinePragma, alwaysInlinePragma, neverInlinePragma, dfunInlinePragma, isDefaultInlinePragma,- isInlinePragma, isInlinablePragma, isAnyInlinePragma,+ isInlinePragma, isInlinablePragma, isNoInlinePragma,+ isAnyInlinePragma, alwaysInlineConLikePragma,+ inlinePragmaSource,+ inlinePragmaName, inlineSpecSource, inlinePragmaSpec, inlinePragmaSat, inlinePragmaActivation, inlinePragmaRuleMatchInfo, setInlinePragmaActivation, setInlinePragmaRuleMatchInfo,@@ -1330,9 +1333,11 @@ -- | Inline Specification data InlineSpec -- What the user's INLINE pragma looked like- = Inline -- User wrote INLINE- | Inlinable -- User wrote INLINABLE- | NoInline -- User wrote NOINLINE+ = Inline SourceText -- User wrote INLINE+ | Inlinable SourceText -- User wrote INLINABLE+ | NoInline SourceText -- User wrote NOINLINE+ -- Each of the above keywords is accompanied with+ -- a string of type SourceText written by the user | NoUserInlinePrag -- User did not write any of INLINE/INLINABLE/NOINLINE -- e.g. in `defaultInlinePragma` or when created by CSE deriving( Eq, Data, Show )@@ -1429,12 +1434,29 @@ , inl_inline = NoUserInlinePrag , inl_sat = Nothing } -alwaysInlinePragma = defaultInlinePragma { inl_inline = Inline }+alwaysInlinePragma = defaultInlinePragma { inl_inline = Inline (inlinePragmaSource defaultInlinePragma) } neverInlinePragma = defaultInlinePragma { inl_act = NeverActive } +alwaysInlineConLikePragma :: InlinePragma+alwaysInlineConLikePragma = alwaysInlinePragma { inl_rule = ConLike }+ inlinePragmaSpec :: InlinePragma -> InlineSpec inlinePragmaSpec = inl_inline +inlinePragmaSource :: InlinePragma -> SourceText+inlinePragmaSource prag = case inl_inline prag of+ Inline x -> x+ Inlinable y -> y+ NoInline z -> z+ NoUserInlinePrag -> NoSourceText++inlineSpecSource :: InlineSpec -> SourceText+inlineSpecSource spec = case spec of+ Inline x -> x+ Inlinable y -> y+ NoInline z -> z+ NoUserInlinePrag -> NoSourceText+ -- A DFun has an always-active inline activation so that -- exprIsConApp_maybe can "see" its unfolding -- (However, its actual Unfolding is a DFunUnfolding, which is@@ -1450,20 +1472,25 @@ isInlinePragma :: InlinePragma -> Bool isInlinePragma prag = case inl_inline prag of- Inline -> True- _ -> False+ Inline _ -> True+ _ -> False isInlinablePragma :: InlinePragma -> Bool isInlinablePragma prag = case inl_inline prag of- Inlinable -> True- _ -> False+ Inlinable _ -> True+ _ -> False +isNoInlinePragma :: InlinePragma -> Bool+isNoInlinePragma prag = case inl_inline prag of+ NoInline _ -> True+ _ -> False+ isAnyInlinePragma :: InlinePragma -> Bool -- INLINE or INLINABLE isAnyInlinePragma prag = case inl_inline prag of- Inline -> True- Inlinable -> True- _ -> False+ Inline _ -> True+ Inlinable _ -> True+ _ -> False inlinePragmaSat :: InlinePragma -> Maybe Arity inlinePragmaSat = inl_sat@@ -1515,7 +1542,6 @@ ab <- get bh return (ActiveAfter src ab) - instance Outputable RuleMatchInfo where ppr ConLike = text "CONLIKE" ppr FunLike = text "FUNLIKE"@@ -1529,24 +1555,32 @@ else return FunLike instance Outputable InlineSpec where- ppr Inline = text "INLINE"- ppr NoInline = text "NOINLINE"- ppr Inlinable = text "INLINABLE"- ppr NoUserInlinePrag = empty+ ppr (Inline src) = text "INLINE" <+> pprWithSourceText src empty+ ppr (NoInline src) = text "NOINLINE" <+> pprWithSourceText src empty+ ppr (Inlinable src) = text "INLINABLE" <+> pprWithSourceText src empty+ ppr NoUserInlinePrag = empty instance Binary InlineSpec where put_ bh NoUserInlinePrag = putByte bh 0- put_ bh Inline = putByte bh 1- put_ bh Inlinable = putByte bh 2- put_ bh NoInline = putByte bh 3+ put_ bh (Inline s) = do putByte bh 1+ put_ bh s+ put_ bh (Inlinable s) = do putByte bh 2+ put_ bh s+ put_ bh (NoInline s) = do putByte bh 3+ put_ bh s get bh = do h <- getByte bh case h of 0 -> return NoUserInlinePrag- 1 -> return Inline- 2 -> return Inlinable- _ -> return NoInline-+ 1 -> do+ s <- get bh+ return (Inline s)+ 2 -> do+ s <- get bh+ return (Inlinable s)+ _ -> do+ s <- get bh+ return (NoInline s) instance Outputable InlinePragma where ppr = pprInline@@ -1567,6 +1601,14 @@ d <- get bh return (InlinePragma s a b c d) +-- | Outputs string for pragma name for any of INLINE/INLINABLE/NOINLINE. This+-- differs from the Outputable instance for the InlineSpec type where the pragma+-- name string as well as the accompanying SourceText (if any) is printed.+inlinePragmaName :: InlineSpec -> SDoc+inlinePragmaName (Inline _) = text "INLINE"+inlinePragmaName (Inlinable _) = text "INLINABLE"+inlinePragmaName (NoInline _) = text "NOINLINE"+inlinePragmaName NoUserInlinePrag = empty pprInline :: InlinePragma -> SDoc pprInline = pprInline' True@@ -1577,15 +1619,18 @@ pprInline' :: Bool -- True <=> do not display the inl_inline field -> InlinePragma -> SDoc-pprInline' emptyInline (InlinePragma { inl_inline = inline, inl_act = activation- , inl_rule = info, inl_sat = mb_arity })+pprInline' emptyInline (InlinePragma+ { inl_inline = inline,+ inl_act = activation,+ inl_rule = info,+ inl_sat = mb_arity }) = pp_inl inline <> pp_act inline activation <+> pp_sat <+> pp_info where- pp_inl x = if emptyInline then empty else ppr x+ pp_inl x = if emptyInline then empty else inlinePragmaName x - pp_act Inline AlwaysActive = empty- pp_act NoInline NeverActive = empty- pp_act _ act = ppr act+ pp_act Inline {} AlwaysActive = empty+ pp_act NoInline {} NeverActive = empty+ pp_act _ act = ppr act pp_sat | Just ar <- mb_arity = parens (text "sat-args=" <> int ar) | otherwise = empty
compiler/GHC/Types/Hint.hs view
@@ -20,6 +20,7 @@ import GHC.Unit.Module (ModuleName, Module) import GHC.Hs.Extension (GhcTc) import GHC.Core.Coercion+import GHC.Types.Name (Name) import GHC.Types.Basic (Activation, RuleName) import GHC.Parser.Errors.Basic import {-# SOURCE #-} Language.Haskell.Syntax.Expr@@ -190,6 +191,9 @@ | SuggestAddInlineOrNoInlinePragma !Var !Activation | SuggestAddPhaseToCompetingRule !RuleName+ {-| Suggests adding an identifier to the export list of a signature.+ -}+ | SuggestAddToHSigExportList !Name !(Maybe Module) {-| Suggests increasing the limit for the number of iterations in the simplifier. -}
compiler/GHC/Types/Hint/Ppr.hs view
@@ -14,6 +14,7 @@ import GHC.Hs.Expr () -- instance Outputable import GHC.Types.Id+import GHC.Unit.Types import GHC.Utils.Outputable import Data.List (intersperse)@@ -98,6 +99,11 @@ $$ text " including the definition module, you must qualify it." SuggestTypeSignatureForm -> text "A type signature should be of form <variables> :: <type>"+ SuggestAddToHSigExportList _name mb_mod+ -> let header = text "Try adding it to the export list of"+ in case mb_mod of+ Nothing -> header <+> text "the hsig file."+ Just mod -> header <+> ppr (moduleName mod) <> text "'s hsig file." perhapsAsPat :: SDoc perhapsAsPat = text "Perhaps you meant an as-pattern, which must not be surrounded by whitespace"
compiler/GHC/Types/Id/Make.hs view
@@ -48,6 +48,7 @@ import GHC.Core.TyCo.Rep import GHC.Core.FamInstEnv import GHC.Core.Coercion+import GHC.Core.Reduction import GHC.Tc.Utils.TcType as TcType import GHC.Core.Make import GHC.Core.FVs ( mkRuleInfo )@@ -840,8 +841,7 @@ dataConWrapperInlinePragma :: InlinePragma -- See Note [DataCon wrappers are conlike]-dataConWrapperInlinePragma = alwaysInlinePragma { inl_rule = ConLike- , inl_inline = Inline }+dataConWrapperInlinePragma = alwaysInlineConLikePragma {- Note [Activation for data constructor wrappers] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~@@ -1031,7 +1031,9 @@ -- we use -fomit-iface-pragmas as the indication , let mb_co = topNormaliseType_maybe fam_envs (scaledThing arg_ty) -- Unwrap type families and newtypes- arg_ty' = case mb_co of { Just (_,ty) -> scaledSet arg_ty ty; Nothing -> arg_ty }+ arg_ty' = case mb_co of+ { Just redn -> scaledSet arg_ty (reductionReducedType redn)+ ; Nothing -> arg_ty } , isUnpackableType dflags fam_envs (scaledThing arg_ty') , (rep_tys, _) <- dataConArgUnpack arg_ty' , case unpk_prag of@@ -1041,8 +1043,8 @@ && rep_tys `lengthAtMost` 1) -- See Note [Unpack one-wide fields] srcUnpack -> isSrcUnpacked srcUnpack = case mb_co of- Nothing -> HsUnpack Nothing- Just (co,_) -> HsUnpack (Just co)+ Nothing -> HsUnpack Nothing+ Just redn -> HsUnpack (Just $ reductionCoercion redn) | otherwise -- Record the strict-but-no-unpack decision = HsStrict
compiler/GHC/Types/Literal.hs view
@@ -38,6 +38,7 @@ , literalType , pprLiteral , litNumIsSigned+ , litNumRange , litNumCheckRange , litNumWrap , litNumCoerce@@ -369,20 +370,32 @@ -- | Check that a given number is in the range of a numeric literal litNumCheckRange :: Platform -> LitNumType -> Integer -> Bool-litNumCheckRange platform nt i = case nt of- LitNumInt -> platformInIntRange platform i- LitNumWord -> platformInWordRange platform i- LitNumInt8 -> inBoundedRange @Int8 i- LitNumInt16 -> inBoundedRange @Int16 i- LitNumInt32 -> inBoundedRange @Int32 i- LitNumInt64 -> inBoundedRange @Int64 i- LitNumWord8 -> inBoundedRange @Word8 i- LitNumWord16 -> inBoundedRange @Word16 i- LitNumWord32 -> inBoundedRange @Word32 i- LitNumWord64 -> inBoundedRange @Word64 i- LitNumNatural -> i >= 0- LitNumInteger -> True+litNumCheckRange platform nt i =+ maybe True (i >=) m_lower &&+ maybe True (i <=) m_upper+ where+ (m_lower, m_upper) = litNumRange platform nt +-- | Get the literal range+litNumRange :: Platform -> LitNumType -> (Maybe Integer, Maybe Integer)+litNumRange platform nt = case nt of+ LitNumInt -> (Just (platformMinInt platform), Just (platformMaxInt platform))+ LitNumWord -> (Just 0, Just (platformMaxWord platform))+ LitNumInt8 -> bounded_range @Int8+ LitNumInt16 -> bounded_range @Int16+ LitNumInt32 -> bounded_range @Int32+ LitNumInt64 -> bounded_range @Int64+ LitNumWord8 -> bounded_range @Word8+ LitNumWord16 -> bounded_range @Word16+ LitNumWord32 -> bounded_range @Word32+ LitNumWord64 -> bounded_range @Word64+ LitNumNatural -> (Just 0, Nothing)+ LitNumInteger -> (Nothing, Nothing)+ where+ bounded_range :: forall a . (Integral a, Bounded a) => (Maybe Integer,Maybe Integer)+ bounded_range = case boundedRange @a of+ (mi,ma) -> (Just mi, Just ma)+ -- | Create a numeric 'Literal' of the given type mkLitNumber :: Platform -> LitNumType -> Integer -> Literal mkLitNumber platform nt i =@@ -576,6 +589,9 @@ inBoundedRange :: forall a. (Bounded a, Integral a) => Integer -> Bool inBoundedRange x = x >= toInteger (minBound :: a) && x <= toInteger (maxBound :: a)++boundedRange :: forall a. (Bounded a, Integral a) => (Integer,Integer)+boundedRange = (toInteger (minBound :: a), toInteger (maxBound :: a)) isMinBound :: Platform -> Literal -> Bool isMinBound _ (LitChar c) = c == minBound
compiler/GHC/Types/Unique/DFM.hs view
@@ -77,7 +77,6 @@ import Data.Functor.Classes (Eq1 (..)) import Data.List (sortBy) import Data.Function (on)-import qualified Data.Semigroup as Semi import GHC.Types.Unique.FM (UniqFM, nonDetUFMToList, ufmToIntMap, unsafeIntMapToUFM) import Unsafe.Coerce @@ -411,13 +410,6 @@ allUDFM :: (elt -> Bool) -> UniqDFM key elt -> Bool allUDFM p (UDFM m _i) = M.foldr ((&&) . p . taggedFst) True m--instance Semi.Semigroup (UniqDFM key a) where- (<>) = plusUDFM--instance Monoid (UniqDFM key a) where- mempty = emptyUDFM- mappend = (Semi.<>) -- This should not be used in committed code, provided for convenience to -- make ad-hoc conversions when developing
compiler/GHC/Types/Unique/DSet.hs view
@@ -8,7 +8,6 @@ -- -- Basically, the things need to be in class 'Uniquable'. -{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE DeriveDataTypeable #-} module GHC.Types.Unique.DSet (@@ -46,14 +45,13 @@ import Data.Coerce import Data.Data-import qualified Data.Semigroup as Semi -- See Note [UniqSet invariant] in GHC.Types.Unique.Set for why we want a newtype here. -- Beyond preserving invariants, we may also want to 'override' typeclass -- instances. newtype UniqDSet a = UniqDSet {getUniqDSet' :: UniqDFM a a}- deriving (Data, Semi.Semigroup, Monoid)+ deriving (Data) emptyUniqDSet :: UniqDSet a emptyUniqDSet = UniqDSet emptyUDFM
compiler/GHC/Types/Unique/FM.hs view
@@ -57,6 +57,7 @@ mergeUFM, plusMaybeUFM_C, plusUFMList,+ sequenceUFMList, minusUFM, intersectUFM, intersectUFM_C,@@ -300,6 +301,15 @@ plusUFMList :: [UniqFM key elt] -> UniqFM key elt plusUFMList = foldl' plusUFM emptyUFM++sequenceUFMList :: forall key elt. [UniqFM key elt] -> UniqFM key [elt]+sequenceUFMList = foldr (plusUFM_CD2 cons) emptyUFM+ where+ cons :: Maybe elt -> Maybe [elt] -> [elt]+ cons (Just x) (Just ys) = x : ys+ cons Nothing (Just ys) = ys+ cons (Just x) Nothing = [x]+ cons Nothing Nothing = [] minusUFM :: UniqFM key elt1 -> UniqFM key elt2 -> UniqFM key elt1 minusUFM (UFM x) (UFM y) = UFM (M.difference x y)
compiler/GHC/Types/Var.hs-boot view
@@ -1,3 +1,4 @@+{-# LANGUAGE NoPolyKinds #-} module GHC.Types.Var where import GHC.Prelude ()
compiler/GHC/Types/Var/Env.hs view
@@ -64,7 +64,7 @@ rnOccL, rnOccR, inRnEnvL, inRnEnvR, rnOccL_maybe, rnOccR_maybe, rnBndrL, rnBndrR, nukeRnEnvL, nukeRnEnvR, rnSwap, delBndrL, delBndrR, delBndrsL, delBndrsR,- addRnInScopeSet,+ extendRnInScopeSetList, rnEtaL, rnEtaR, rnInScope, rnInScopeSet, lookupRnInScope, rnEnvL, rnEnvR,@@ -260,10 +260,10 @@ , envR = emptyVarEnv , in_scope = vars } -addRnInScopeSet :: RnEnv2 -> VarSet -> RnEnv2-addRnInScopeSet env vs- | isEmptyVarSet vs = env- | otherwise = env { in_scope = extendInScopeSetSet (in_scope env) vs }+extendRnInScopeSetList :: RnEnv2 -> [Var] -> RnEnv2+extendRnInScopeSetList env vs+ | null vs = env+ | otherwise = env { in_scope = extendInScopeSetList (in_scope env) vs } rnInScope :: Var -> RnEnv2 -> Bool rnInScope x env = x `elemInScopeSet` in_scope env
compiler/GHC/Unit/Home/ModInfo.hs view
@@ -10,10 +10,12 @@ , mapHpt , delFromHpt , addToHpt+ , addHomeModInfoToHpt , addListToHpt , lookupHptDirectly , lookupHptByModule , listToHpt+ , listHMIToHpt , pprHPT ) where@@ -30,6 +32,8 @@ import GHC.Types.Unique.DFM import GHC.Utils.Outputable+import Data.List+import Data.Ord -- | Information about modules in the package being compiled data HomeModInfo = HomeModInfo@@ -93,12 +97,23 @@ addToHpt :: HomePackageTable -> ModuleName -> HomeModInfo -> HomePackageTable addToHpt = addToUDFM +addHomeModInfoToHpt :: HomeModInfo -> HomePackageTable -> HomePackageTable+addHomeModInfoToHpt hmi hpt = addToHpt hpt (moduleName (mi_module (hm_iface hmi))) hmi+ addListToHpt :: HomePackageTable -> [(ModuleName, HomeModInfo)] -> HomePackageTable addListToHpt = addListToUDFM listToHpt :: [(ModuleName, HomeModInfo)] -> HomePackageTable listToHpt = listToUDFM++listHMIToHpt :: [HomeModInfo] -> HomePackageTable+listHMIToHpt hmis =+ listToHpt [(moduleName (mi_module (hm_iface hmi)), hmi) | hmi <- sorted_hmis]+ where+ -- Sort to put Non-boot things last, so they overwrite the boot interfaces+ -- in the HPT, other than that, the order doesn't matter+ sorted_hmis = sortOn (Down . mi_boot . hm_iface) hmis lookupHptByModule :: HomePackageTable -> Module -> Maybe HomeModInfo -- The HPT is indexed by ModuleName, not Module,
compiler/GHC/Unit/Module/Deps.hs view
@@ -16,6 +16,9 @@ import GHC.Utils.Fingerprint import GHC.Utils.Binary +import Data.Set (Set)+import qualified Data.Set as Set+ -- | Dependency information about ALL modules and packages below this one -- in the import hierarchy. This is the serialisable version of `ImportAvails`. --@@ -25,10 +28,10 @@ -- -- See Note [Transitive Information in Dependencies] data Dependencies = Deps- { dep_direct_mods :: [ModuleNameWithIsBoot]+ { dep_direct_mods :: Set ModuleNameWithIsBoot -- ^ All home-package modules which are directly imported by this one. - , dep_direct_pkgs :: [UnitId]+ , dep_direct_pkgs :: Set UnitId -- ^ All packages directly imported by this module -- I.e. packages to which this module's direct imports belong. --@@ -38,12 +41,12 @@ -- ^ Transitive closure of hsig files in the home package - , dep_trusted_pkgs :: [UnitId]+ , dep_trusted_pkgs :: Set UnitId -- Packages which we are required to trust -- when the module is imported as a safe import -- (Safe Haskell). See Note [Tracking Trust Transitively] in GHC.Rename.Names - , dep_boot_mods :: [ModuleNameWithIsBoot]+ , dep_boot_mods :: Set ModuleNameWithIsBoot -- ^ All modules which have boot files below this one, and whether we -- should use the boot file or not. -- This information is only used to populate the eps_is_boot field.@@ -96,7 +99,15 @@ dep_finsts = fis }) noDependencies :: Dependencies-noDependencies = Deps [] [] [] [] [] [] []+noDependencies = Deps+ { dep_direct_mods = Set.empty+ , dep_direct_pkgs = Set.empty+ , dep_sig_mods = []+ , dep_boot_mods = Set.empty+ , dep_trusted_pkgs = Set.empty+ , dep_orphs = []+ , dep_finsts = []+ } -- | Records modules for which changes may force recompilation of this module -- See wiki: https://gitlab.haskell.org/ghc/ghc/wikis/commentary/compiler/recompilation-avoidance@@ -110,7 +121,7 @@ usg_mod :: Module, -- ^ External package module depended on usg_mod_hash :: Fingerprint,- -- ^ Cached module fingerprint+ -- ^ Cached module ABI fingerprint (corresponds to mi_mod_hash) usg_safe :: IsSafeImport -- ^ Was this module imported as a safe import }@@ -119,7 +130,10 @@ usg_mod_name :: ModuleName, -- ^ Name of the module usg_mod_hash :: Fingerprint,- -- ^ Cached module fingerprint+ -- ^ Cached module ABI fingerprint (corresponds to mi_mod_hash).+ -- This may be out dated after recompilation was avoided, but is+ -- still used as a fast initial check for change during+ -- recompilation avoidance. usg_entities :: [(OccName,Fingerprint)], -- ^ Entities we depend on, sorted by occurrence name and fingerprinted. -- NB: usages are for parent names only, e.g. type constructors
compiler/GHC/Unit/Module/Graph.hs view
@@ -21,7 +21,7 @@ , needsTemplateHaskellOrQQ , isTemplateHaskellOrQQNonBoot , showModMsg- )+ , moduleGraphNodeModule) where import GHC.Prelude@@ -53,6 +53,10 @@ = InstantiationNode InstantiatedUnit -- | There is a module summary node for each module, signature, and boot module being built. | ModuleNode ExtendedModSummary++moduleGraphNodeModule :: ModuleGraphNode -> Maybe ExtendedModSummary+moduleGraphNodeModule (InstantiationNode {}) = Nothing+moduleGraphNodeModule (ModuleNode ems) = Just ems instance Outputable ModuleGraphNode where ppr = \case
compiler/GHC/Unit/Module/ModGuts.hs view
@@ -36,7 +36,9 @@ import GHC.Types.SrcLoc import GHC.Types.CostCentre +import Data.Set (Set) + -- | A ModGuts is carried through the compiler, accumulating stuff as it goes -- There is only one ModGuts at any time, the one for the module -- being compiled right now. Once it is compiled, a 'ModIface' and@@ -135,7 +137,7 @@ cg_ccs :: [CostCentre], -- List of cost centres used in bindings and rules cg_foreign :: !ForeignStubs, -- ^ Foreign export stubs cg_foreign_files :: ![(ForeignSrcLang, FilePath)],- cg_dep_pkgs :: ![UnitId], -- ^ Dependent packages, used to+ cg_dep_pkgs :: !(Set UnitId), -- ^ Dependent packages, used to -- generate #includes for C code gen cg_hpc_info :: !HpcInfo, -- ^ Program coverage tick box information cg_modBreaks :: !(Maybe ModBreaks), -- ^ Module breakpoints
compiler/GHC/Unit/Module/ModSummary.hs view
@@ -11,7 +11,6 @@ , ms_mod_name , ms_imps , ms_mnwib- , ms_home_allimps , ms_home_srcimps , ms_home_imps , msHiFilePath@@ -127,9 +126,6 @@ where isLocal Nothing = True isLocal (Just pkg) | pkg == fsLit "this" = True -- "this" is special isLocal _ = False--ms_home_allimps :: ModSummary -> [ModuleName]-ms_home_allimps ms = map unLoc (ms_home_srcimps ms ++ ms_home_imps ms) -- | Like 'ms_home_imps', but for SOURCE imports. ms_home_srcimps :: ModSummary -> [Located ModuleName]
compiler/GHC/Unit/State.hs view
@@ -10,6 +10,7 @@ -- * Reading the package config, and processing cmdline args UnitState(..),+ PreloadUnitClosure, UnitDatabase (..), UnitErr (..), emptyUnitState,
compiler/GHC/Unit/Types.hs view
@@ -660,6 +660,9 @@ } deriving ( Eq, Ord, Show , Functor, Foldable, Traversable )+ -- the Ord instance must ensure that we first sort by Module and then by+ -- IsBootInterface: this is assumed to perform filtering of non-boot modules,+ -- e.g. in GHC.Driver.Env.hptModulesBelow type ModuleNameWithIsBoot = GenWithIsBoot ModuleName
compiler/GHC/Unit/Types.hs-boot view
@@ -1,13 +1,15 @@+{-# LANGUAGE KindSignatures #-} module GHC.Unit.Types where import GHC.Prelude () import {-# SOURCE #-} GHC.Utils.Outputable-import {-# SOURCE #-} GHC.Unit.Module.Name+import {-# SOURCE #-} GHC.Unit.Module.Name ( ModuleName )+import Data.Kind (Type) data UnitId-data GenModule unit-data GenUnit uid-data Indefinite unit+data GenModule (unit :: Type)+data GenUnit (uid :: Type)+data Indefinite (unit :: Type) type Module = GenModule Unit type Unit = GenUnit UnitId
compiler/GHC/Utils/Binary.hs view
@@ -96,6 +96,8 @@ import Data.Char ( ord, chr ) import Data.Time import Data.List (unfoldr)+import Data.Set (Set)+import qualified Data.Set as Set import Control.Monad ( when, (<$!>), unless, forM_ ) import System.IO as IO import System.IO.Unsafe ( unsafeInterleaveIO )@@ -636,6 +638,10 @@ let loop 0 = return [] loop n = do a <- get bh; as <- loop (n-1); return (a:as) loop len++instance Binary a => Binary (Set a) where+ put_ bh a = put_ bh (Set.toAscList a)+ get bh = Set.fromDistinctAscList <$> get bh instance (Ix a, Binary a, Binary b) => Binary (Array a b) where put_ bh arr = do
compiler/GHC/Utils/Binary/Typeable.hs view
@@ -1,10 +1,9 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE GADTs #-} {-# OPTIONS_GHC -O2 -funbox-strict-fields #-}-{-# OPTIONS_GHC -Wno-orphans #-}+{-# OPTIONS_GHC -Wno-orphans -Wincomplete-patterns #-} #if MIN_VERSION_base(4,16,0) #define HAS_TYPELITCHAR #endif@@ -19,7 +18,7 @@ import GHC.Utils.Binary -import GHC.Exts (TYPE, RuntimeRep(..), VecCount(..), VecElem(..))+import GHC.Exts (RuntimeRep(..), VecCount(..), VecElem(..)) #if __GLASGOW_HASKELL__ >= 901 import GHC.Exts (Levity(Lifted, Unlifted)) #endif@@ -49,7 +48,6 @@ 1 -> do con <- get bh :: IO TyCon ks <- get bh :: IO [SomeTypeRep] return $ SomeTypeRep $ mkTrCon con ks- 2 -> do SomeTypeRep f <- getSomeTypeRep bh SomeTypeRep x <- getSomeTypeRep bh case typeRepKind f of@@ -68,20 +66,8 @@ [ " Applied type: " ++ show f , " To argument: " ++ show x ]- 3 -> do SomeTypeRep arg <- getSomeTypeRep bh- SomeTypeRep res <- getSomeTypeRep bh- if- | App argkcon _ <- typeRepKind arg- , App reskcon _ <- typeRepKind res- , Just HRefl <- argkcon `eqTypeRep` tYPErep- , Just HRefl <- reskcon `eqTypeRep` tYPErep- -> return $ SomeTypeRep $ Fun arg res- | otherwise -> failure "Kind mismatch" [] _ -> failure "Invalid SomeTypeRep" [] where- tYPErep :: TypeRep TYPE- tYPErep = typeRep- failure description info = fail $ unlines $ [ "Binary.getSomeTypeRep: "++description ] ++ map (" "++) info@@ -201,10 +187,7 @@ _ -> fail "Binary.putTypeLitSort: invalid tag" putTypeRep :: BinHandle -> TypeRep a -> IO ()--- Special handling for TYPE, (->), and RuntimeRep due to recursive kind--- relations.--- See Note [Mutually recursive representations of primitive types]-putTypeRep bh rep+putTypeRep bh rep -- Handle Type specially since it's so common | Just HRefl <- rep `eqTypeRep` (typeRep :: TypeRep Type) = put_ bh (0 :: Word8) putTypeRep bh (Con' con ks) = do
compiler/GHC/Utils/Logger.hs view
@@ -402,7 +402,7 @@ defaultLogActionHPutStrDoc logflags asciiSpace h d -- Don't add a newline at the end, so that successive -- calls to this log-action can output all on the same line- = printSDoc (log_default_dump_context logflags) (Pretty.PageMode asciiSpace) h d+ = printSDoc (log_default_user_context logflags) (Pretty.PageMode asciiSpace) h d -- -- Note [JSON Error Messages]
compiler/Language/Haskell/Syntax/Binds.hs view
@@ -46,6 +46,7 @@ import GHC.Data.BooleanFormula (LBooleanFormula) import GHC.Utils.Outputable+import GHC.Utils.Panic (pprPanic) import Data.Data hiding ( Fixity ) import Data.Void@@ -872,16 +873,28 @@ | is_deflt = text "default type signature" | otherwise = text "class method signature" hsSigDoc (IdSig {}) = text "id signature"-hsSigDoc (SpecSig _ _ _ inl)- = ppr inl <+> text "pragma"-hsSigDoc (InlineSig _ _ prag) = ppr (inlinePragmaSpec prag) <+> text "pragma"-hsSigDoc (SpecInstSig _ src _)- = pprWithSourceText src empty <+> text "instance pragma"+hsSigDoc (SpecSig _ _ _ inl) = (inlinePragmaName . inl_inline $ inl) <+> text "pragma"+hsSigDoc (InlineSig _ _ prag) = (inlinePragmaName . inl_inline $ prag) <+> text "pragma"+-- Using the 'inlinePragmaName' function ensures that the pragma name for any+-- one of the INLINE/INLINABLE/NOINLINE pragmas are printed after being extracted+-- from the InlineSpec field of the pragma.+hsSigDoc (SpecInstSig _ src _) = text (extractSpecPragName src) <+> text "instance pragma" hsSigDoc (FixSig {}) = text "fixity declaration" hsSigDoc (MinimalSig {}) = text "MINIMAL pragma" hsSigDoc (SCCFunSig {}) = text "SCC pragma" hsSigDoc (CompleteMatchSig {}) = text "COMPLETE pragma" hsSigDoc (XSig {}) = text "XSIG TTG extension"++-- | Extracts the name for a SPECIALIZE instance pragma. In 'hsSigDoc', the src+-- field of 'SpecInstSig' signature contains the SourceText for a SPECIALIZE+-- instance pragma of the form: "SourceText {-# SPECIALIZE"+--+-- Extraction ensures that all variants of the pragma name (with a 'Z' or an+-- 'S') are output exactly as used in the pragma.+extractSpecPragName :: SourceText -> String+extractSpecPragName srcTxt = case (words $ show srcTxt) of+ (_:_:pragName:_) -> filter (/= '\"') pragName+ _ -> pprPanic "hsSigDoc: Misformed SPECIALISE instance pragma:" (ppr srcTxt) {- ************************************************************************
compiler/Language/Haskell/Syntax/Expr.hs view
@@ -488,10 +488,7 @@ -- For details on above see note [exact print annotations] in GHC.Parser.Annotation | HsDo (XDo p) -- Type of the whole expression- (HsStmtContext (HsDoRn p))- -- The parameterisation of the above is unimportant- -- because in this context we never use- -- the PatGuard or ParStmt variant+ HsDoFlavour (XRec p [ExprLStmt p]) -- "do":one or more stmts -- | Syntactic list: [a,b,c,...]@@ -665,7 +662,6 @@ -- | The AST used to hard-refer to GhcPass, which was a layer violation. For now, -- we paper it over with this new extension point.-type family HsDoRn p type family HsBracketRn p type family PendingRnSplice' p type family PendingTcSplice' p@@ -1371,13 +1367,11 @@ , app_stmts :: [ExprLStmt idL] -- stmts , final_expr :: HsExpr idL -- return (v1,..,vn), or just (v1,..,vn) , bv_pattern :: LPat idL -- (v1,...,vn)- , stmt_context :: HsStmtContext (ApplicativeArgStmCtxPass idL)+ , stmt_context :: HsDoFlavour -- ^ context of the do expression, used in pprArg } | XApplicativeArg !(XXApplicativeArg idL) -type family ApplicativeArgStmCtxPass idL- {- Note [The type of bind in Stmts] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~@@ -1720,46 +1714,69 @@ -- | Haskell Statement Context. data HsStmtContext p- = ListComp- | MonadComp-- | DoExpr (Maybe ModuleName) -- ^[ModuleName.]do { ... }- | MDoExpr (Maybe ModuleName) -- ^[ModuleName.]mdo { ... } ie recursive do-expression- | ArrowExpr -- ^do-notation in an arrow-command context-- | GhciStmtCtxt -- ^A command-line Stmt in GHCi pat <- rhs+ = HsDoStmt HsDoFlavour -- ^Context for HsDo (do-notation and comprehensions) | PatGuard (HsMatchContext p) -- ^Pattern guard for specified thing | ParStmtCtxt (HsStmtContext p) -- ^A branch of a parallel stmt | TransStmtCtxt (HsStmtContext p) -- ^A branch of a transform stmt+ | ArrowExpr -- ^do-notation in an arrow-command context +data HsDoFlavour+ = DoExpr (Maybe ModuleName) -- ^[ModuleName.]do { ... }+ | MDoExpr (Maybe ModuleName) -- ^[ModuleName.]mdo { ... } ie recursive do-expression+ | GhciStmtCtxt -- ^A command-line Stmt in GHCi pat <- rhs+ | ListComp+ | MonadComp+ qualifiedDoModuleName_maybe :: HsStmtContext p -> Maybe ModuleName qualifiedDoModuleName_maybe ctxt = case ctxt of- DoExpr m -> m- MDoExpr m -> m+ HsDoStmt (DoExpr m) -> m+ HsDoStmt (MDoExpr m) -> m _ -> Nothing isComprehensionContext :: HsStmtContext id -> Bool -- Uses comprehension syntax [ e | quals ]-isComprehensionContext ListComp = True-isComprehensionContext MonadComp = True isComprehensionContext (ParStmtCtxt c) = isComprehensionContext c isComprehensionContext (TransStmtCtxt c) = isComprehensionContext c-isComprehensionContext _ = False+isComprehensionContext ArrowExpr = False+isComprehensionContext (PatGuard _) = False+isComprehensionContext (HsDoStmt flavour) = isDoComprehensionContext flavour +isDoComprehensionContext :: HsDoFlavour -> Bool+isDoComprehensionContext GhciStmtCtxt = False+isDoComprehensionContext (DoExpr _) = False+isDoComprehensionContext (MDoExpr _) = False+isDoComprehensionContext ListComp = True+isDoComprehensionContext MonadComp = True+ -- | Is this a monadic context? isMonadStmtContext :: HsStmtContext id -> Bool-isMonadStmtContext MonadComp = True-isMonadStmtContext DoExpr{} = True-isMonadStmtContext MDoExpr{} = True-isMonadStmtContext GhciStmtCtxt = True isMonadStmtContext (ParStmtCtxt ctxt) = isMonadStmtContext ctxt isMonadStmtContext (TransStmtCtxt ctxt) = isMonadStmtContext ctxt-isMonadStmtContext _ = False -- ListComp, PatGuard, ArrowExpr+isMonadStmtContext (HsDoStmt flavour) = isMonadDoStmtContext flavour+isMonadStmtContext (PatGuard _) = False+isMonadStmtContext ArrowExpr = False +isMonadDoStmtContext :: HsDoFlavour -> Bool+isMonadDoStmtContext ListComp = False+isMonadDoStmtContext MonadComp = True+isMonadDoStmtContext DoExpr{} = True+isMonadDoStmtContext MDoExpr{} = True+isMonadDoStmtContext GhciStmtCtxt = True+ isMonadCompContext :: HsStmtContext id -> Bool-isMonadCompContext MonadComp = True-isMonadCompContext _ = False+isMonadCompContext (HsDoStmt flavour) = isMonadDoCompContext flavour+isMonadCompContext (ParStmtCtxt _) = False+isMonadCompContext (TransStmtCtxt _) = False+isMonadCompContext (PatGuard _) = False+isMonadCompContext ArrowExpr = False +isMonadDoCompContext :: HsDoFlavour -> Bool+isMonadDoCompContext MonadComp = True+isMonadDoCompContext ListComp = False+isMonadDoCompContext GhciStmtCtxt = False+isMonadDoCompContext (DoExpr _) = False+isMonadDoCompContext (MDoExpr _) = False+ matchSeparator :: HsMatchContext p -> SDoc matchSeparator (FunRhs {}) = text "=" matchSeparator CaseAlt = text "->"@@ -1806,24 +1823,13 @@ ----------------- pprAStmtContext, pprStmtContext :: (Outputable (IdP p), UnXRec p) => HsStmtContext p -> SDoc-pprAStmtContext ctxt = article <+> pprStmtContext ctxt- where- pp_an = text "an"- pp_a = text "a"- article = case ctxt of- MDoExpr Nothing -> pp_an- GhciStmtCtxt -> pp_an- _ -> pp_a-+pprAStmtContext (HsDoStmt flavour) = pprAHsDoFlavour flavour+pprAStmtContext ctxt = text "a" <+> pprStmtContext ctxt ------------------pprStmtContext GhciStmtCtxt = text "interactive GHCi command"-pprStmtContext (DoExpr m) = prependQualified m (text "'do' block")-pprStmtContext (MDoExpr m) = prependQualified m (text "'mdo' block")-pprStmtContext ArrowExpr = text "'do' block in an arrow command"-pprStmtContext ListComp = text "list comprehension"-pprStmtContext MonadComp = text "monad comprehension"+pprStmtContext (HsDoStmt flavour) = pprHsDoFlavour flavour pprStmtContext (PatGuard ctxt) = text "pattern guard for" $$ pprMatchContext ctxt+pprStmtContext ArrowExpr = text "'do' block in an arrow command" -- Drop the inner contexts when reporting errors, else we get -- Unexpected transform statement@@ -1836,6 +1842,21 @@ pprStmtContext (TransStmtCtxt c) = ifPprDebug (sep [text "transformed branch of", pprAStmtContext c]) (pprStmtContext c)++pprAHsDoFlavour, pprHsDoFlavour :: HsDoFlavour -> SDoc+pprAHsDoFlavour flavour = article <+> pprHsDoFlavour flavour+ where+ pp_an = text "an"+ pp_a = text "a"+ article = case flavour of+ MDoExpr Nothing -> pp_an+ GhciStmtCtxt -> pp_an+ _ -> pp_a+pprHsDoFlavour (DoExpr m) = prependQualified m (text "'do' block")+pprHsDoFlavour (MDoExpr m) = prependQualified m (text "'mdo' block")+pprHsDoFlavour ListComp = text "list comprehension"+pprHsDoFlavour MonadComp = text "monad comprehension"+pprHsDoFlavour GhciStmtCtxt = text "interactive GHCi command" prependQualified :: Maybe ModuleName -> SDoc -> SDoc prependQualified Nothing t = t
compiler/Language/Haskell/Syntax/Lit.hs view
@@ -20,7 +20,6 @@ import GHC.Prelude -import {-# SOURCE #-} Language.Haskell.Syntax.Expr ( HsExpr ) import GHC.Types.Basic (PprPrec(..), topPrec ) import GHC.Types.SourceText import GHC.Core.Type@@ -100,8 +99,7 @@ data HsOverLit p = OverLit { ol_ext :: (XOverLit p),- ol_val :: OverLitVal,- ol_witness :: HsExpr p} -- Note [Overloaded literal witnesses]+ ol_val :: OverLitVal} | XOverLit !(XXOverLit p)@@ -120,28 +118,11 @@ negateOverLitVal (HsFractional f) = HsFractional (negateFractionalLit f) negateOverLitVal _ = panic "negateOverLitVal: argument is not a number" -{--Note [Overloaded literal witnesses]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-*Before* type checking, the HsExpr in an HsOverLit is the-name of the coercion function, 'fromInteger' or 'fromRational'.-*After* type checking, it is a witness for the literal, such as- (fromInteger 3) or lit_78-This witness should replace the literal.--This dual role is unusual, because we're replacing 'fromInteger' with-a call to fromInteger. Reason: it allows commoning up of the fromInteger-calls, which wouldn't be possible if the desugarer made the application.--The PostTcType in each branch records the type the overload literal is-found to have.--}- -- Comparison operations are needed when grouping literals -- for compiling pattern-matching (module GHC.HsToCore.Match.Literal) instance (Eq (XXOverLit p)) => Eq (HsOverLit p) where- (OverLit _ val1 _) == (OverLit _ val2 _) = val1 == val2- (XOverLit val1) == (XOverLit val2) = val1 == val2+ (OverLit _ val1) == (OverLit _ val2) = val1 == val2+ (XOverLit val1) == (XOverLit val2) = val1 == val2 _ == _ = panic "Eq HsOverLit" instance Eq OverLitVal where@@ -151,8 +132,8 @@ _ == _ = False instance (Ord (XXOverLit p)) => Ord (HsOverLit p) where- compare (OverLit _ val1 _) (OverLit _ val2 _) = val1 `compare` val2- compare (XOverLit val1) (XOverLit val2) = val1 `compare` val2+ compare (OverLit _ val1) (OverLit _ val2) = val1 `compare` val2+ compare (XOverLit val1) (XOverLit val2) = val1 `compare` val2 compare _ _ = panic "Ord HsOverLit" instance Ord OverLitVal where
compiler/Language/Haskell/Syntax/Type.hs view
@@ -938,10 +938,6 @@ hsScaledThing :: HsScaled pass a -> a hsScaledThing (HsScaled _ t) = t -instance Outputable a => Outputable (HsScaled pass a) where- ppr (HsScaled _cnt t) = -- ppr cnt <> ppr t- ppr t- {- Note [Unit tuples] ~~~~~~~~~~~~~~~~~~
+ 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-parser.cabal view
@@ -1,7 +1,7 @@ cabal-version: >=1.22 build-type: Simple name: ghc-lib-parser-version: 0.20210801+version: 0.20210901 license: BSD3 license-file: LICENSE category: Development@@ -41,10 +41,13 @@ ghc-lib/stage0/compiler/build/GHC/Platform/Constants.hs ghc-lib/stage0/compiler/build/GHC/Parser.hs ghc-lib/stage0/compiler/build/GHC/Parser/Lexer.hs- 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@@ -54,7 +57,7 @@ default-language: Haskell2010 exposed: False include-dirs:- includes+ rts/include ghc-lib/stage0/lib ghc-lib/stage0/compiler/build compiler@@ -181,6 +184,7 @@ GHC.Core.PatSyn GHC.Core.Ppr GHC.Core.Predicate+ GHC.Core.Reduction GHC.Core.Rules GHC.Core.Seq GHC.Core.SimpleOpt@@ -231,6 +235,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
ghc-lib/stage0/compiler/build/GHC/Parser.hs view
@@ -12150,8 +12150,8 @@ getPRIMFLOAT (L _ (ITprimfloat x)) = x getPRIMDOUBLE (L _ (ITprimdouble x)) = x getINLINE (L _ (ITinline_prag _ inl conl)) = (inl,conl)-getSPEC_INLINE (L _ (ITspec_inline_prag _ True)) = (Inline, FunLike)-getSPEC_INLINE (L _ (ITspec_inline_prag _ False)) = (NoInline,FunLike)+getSPEC_INLINE (L _ (ITspec_inline_prag src True)) = (Inline src,FunLike)+getSPEC_INLINE (L _ (ITspec_inline_prag src False)) = (NoInline src,FunLike) getCOMPLETE_PRAGs (L _ (ITcomplete_prag x)) = x getVOCURLY (L (RealSrcSpan l _) ITvocurly) = srcSpanStartCol l @@ -12164,7 +12164,7 @@ getPRIMWORDs (L _ (ITprimword src _)) = src -- See Note [Pragma source text] in "GHC.Types.Basic" for the following-getINLINE_PRAGs (L _ (ITinline_prag src _ _)) = src+getINLINE_PRAGs (L _ (ITinline_prag _ inl _)) = inlineSpecSource inl getSPEC_PRAGs (L _ (ITspec_prag src)) = src getSPEC_INLINE_PRAGs (L _ (ITspec_inline_prag src _)) = src getSOURCE_PRAGs (L _ (ITsource_prag src)) = src
ghc-lib/stage0/compiler/build/GHC/Parser/Lexer.hs view
@@ -1578,6 +1578,7 @@ varsym_suffix :: Action varsym_suffix = sym $ \span _ s -> if | s == fsLit "@" -> failMsgP (\srcLoc -> mkPlainErrorMsgEnvelope srcLoc $ PsErrSuffixAT)+ | s == fsLit "." -> return ITdot | otherwise -> do { addPsMessage (mkSrcSpanPs span)@@ -3331,14 +3332,14 @@ oneWordPrags = Map.fromList [ ("rules", rulePrag), ("inline",- strtoken (\s -> (ITinline_prag (SourceText s) Inline FunLike))),+ strtoken (\s -> (ITinline_prag (SourceText s) (Inline (SourceText s)) FunLike))), ("inlinable",- strtoken (\s -> (ITinline_prag (SourceText s) Inlinable FunLike))),+ strtoken (\s -> (ITinline_prag (SourceText s) (Inlinable (SourceText s)) FunLike))), ("inlineable",- strtoken (\s -> (ITinline_prag (SourceText s) Inlinable FunLike))),+ strtoken (\s -> (ITinline_prag (SourceText s) (Inlinable (SourceText s)) FunLike))), -- Spelling variant ("notinline",- strtoken (\s -> (ITinline_prag (SourceText s) NoInline FunLike))),+ strtoken (\s -> (ITinline_prag (SourceText s) (NoInline (SourceText s)) FunLike))), ("specialize", strtoken (\s -> ITspec_prag (SourceText s))), ("source", strtoken (\s -> ITsource_prag (SourceText s))), ("warning", strtoken (\s -> ITwarning_prag (SourceText s))),@@ -3359,9 +3360,9 @@ twoWordPrags = Map.fromList [ ("inline conlike",- strtoken (\s -> (ITinline_prag (SourceText s) Inline ConLike))),+ strtoken (\s -> (ITinline_prag (SourceText s) (Inline (SourceText s)) ConLike))), ("notinline conlike",- strtoken (\s -> (ITinline_prag (SourceText s) NoInline ConLike))),+ strtoken (\s -> (ITinline_prag (SourceText s) (NoInline (SourceText s)) ConLike))), ("specialize inline", strtoken (\s -> (ITspec_inline_prag (SourceText s) True))), ("specialize notinline",
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
ghc-lib/stage0/libraries/ghc-boot/build/GHC/Version.hs view
@@ -3,19 +3,19 @@ import Prelude -- See Note [Why do we import Prelude here?] cProjectGitCommitId :: String-cProjectGitCommitId = "54d6b20192fe6fc244248c7766533a768c591bae"+cProjectGitCommitId = "922c6bc8dd8d089cfe4b90ec2120cb48959ba2b5" cProjectVersion :: String-cProjectVersion = "9.3.20210729"+cProjectVersion = "9.3.20210828" cProjectVersionInt :: String cProjectVersionInt = "903" cProjectPatchLevel :: String-cProjectPatchLevel = "20210729"+cProjectPatchLevel = "20210828" cProjectPatchLevel1 :: String-cProjectPatchLevel1 = "20210729"+cProjectPatchLevel1 = "20210828" cProjectPatchLevel2 :: String cProjectPatchLevel2 = ""
− 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/ghc-heap/GHC/Exts/Heap/ClosureTypes.hs view
@@ -12,7 +12,7 @@ {- --------------------------------------------- -- Enum representing closure types -- This is a mirror of:--- includes/rts/storage/ClosureTypes.h+-- rts/include/rts/storage/ClosureTypes.h -- ---------------------------------------------} data ClosureType
libraries/ghc-heap/GHC/Exts/Heap/Closures.hs view
@@ -98,7 +98,7 @@ type Closure = GenClosure Box -- | This is the representation of a Haskell value on the heap. It reflects--- <https://gitlab.haskell.org/ghc/ghc/blob/master/includes/rts/storage/Closures.h>+-- <https://gitlab.haskell.org/ghc/ghc/blob/master/rts/include/rts/storage/Closures.h> -- -- The data type is parametrized by `b`: the type to store references in. -- Usually this is a 'Box' with the type synonym 'Closure'.
libraries/ghc-heap/GHC/Exts/Heap/InfoTable/Types.hsc view
@@ -28,7 +28,7 @@ type EntryFunPtr = FunPtr (Ptr () -> IO (Ptr ())) -- | This is a somewhat faithful representation of an info table. See--- <https://gitlab.haskell.org/ghc/ghc/blob/master/includes/rts/storage/InfoTables.h>+-- <https://gitlab.haskell.org/ghc/ghc/blob/master/rts/include/rts/storage/InfoTables.h> -- for more details on this data structure. data StgInfoTable = StgInfoTable { entry :: Maybe EntryFunPtr, -- Just <=> not TABLES_NEXT_TO_CODE
libraries/ghc-heap/GHC/Exts/Heap/ProfInfo/Types.hs view
@@ -7,14 +7,14 @@ import GHC.Generics -- | This is a somewhat faithful representation of StgTSOProfInfo. See--- <https://gitlab.haskell.org/ghc/ghc/blob/master/includes/rts/storage/TSO.h>+-- <https://gitlab.haskell.org/ghc/ghc/blob/master/rts/include/rts/storage/TSO.h> -- for more details on this data structure. data StgTSOProfInfo = StgTSOProfInfo { cccs :: Maybe CostCentreStack } deriving (Show, Generic, Eq, Ord) -- | This is a somewhat faithful representation of CostCentreStack. See--- <https://gitlab.haskell.org/ghc/ghc/blob/master/includes/rts/prof/CCS.h>+-- <https://gitlab.haskell.org/ghc/ghc/blob/master/rts/include/rts/prof/CCS.h> -- for more details on this data structure. data CostCentreStack = CostCentreStack { ccs_ccsID :: Int,@@ -32,7 +32,7 @@ } deriving (Show, Generic, Eq, Ord) -- | This is a somewhat faithful representation of CostCentre. See--- <https://gitlab.haskell.org/ghc/ghc/blob/master/includes/rts/prof/CCS.h>+-- <https://gitlab.haskell.org/ghc/ghc/blob/master/rts/include/rts/prof/CCS.h> -- for more details on this data structure. data CostCentre = CostCentre { cc_ccID :: Int,@@ -46,7 +46,7 @@ } deriving (Show, Generic, Eq, Ord) -- | This is a somewhat faithful representation of IndexTable. See--- <https://gitlab.haskell.org/ghc/ghc/blob/master/includes/rts/prof/CCS.h>+-- <https://gitlab.haskell.org/ghc/ghc/blob/master/rts/include/rts/prof/CCS.h> -- for more details on this data structure. data IndexTable = IndexTable { it_cc :: CostCentre,
libraries/ghci/GHCi/Message.hs view
@@ -462,7 +462,7 @@ #define MIN_VERSION_ghc_heap(major1,major2,minor) (\ (major1) < 9 || \ (major1) == 9 && (major2) < 3 || \- (major1) == 9 && (major2) == 3 && (minor) <= 20210729)+ (major1) == 9 && (major2) == 3 && (minor) <= 20210828) #endif /* MIN_VERSION_ghc_heap */ #if MIN_VERSION_ghc_heap(8,11,0) instance Binary Heap.StgTSOProfInfo
libraries/template-haskell/Language/Haskell/TH/Lib.hs view
@@ -44,6 +44,7 @@ appE, appTypeE, uInfixE, parensE, infixE, infixApp, sectionL, sectionR, lamE, lam1E, lamCaseE, tupE, unboxedTupE, unboxedSumE, condE, multiIfE, letE, caseE, appsE, listE, sigE, recConE, recUpdE, stringE, fieldExp,+ getFieldE, projectionE, -- **** Ranges fromE, fromThenE, fromToE, fromThenToE,
libraries/template-haskell/Language/Haskell/TH/Lib/Internal.hs view
@@ -366,6 +366,14 @@ implicitParamVarE :: Quote m => String -> m Exp implicitParamVarE n = pure (ImplicitParamVarE n) +getFieldE :: Quote m => m Exp -> String -> m Exp+getFieldE e f = do+ e' <- e+ pure (GetFieldE e' f)++projectionE :: Quote m => [String] -> m Exp+projectionE xs = pure (ProjectionE xs)+ -- ** 'arithSeqE' Shortcuts fromE :: Quote m => m Exp -> m Exp fromE x = do { a <- x; pure (ArithSeqE (FromR a)) }
libraries/template-haskell/Language/Haskell/TH/Ppr.hs view
@@ -223,6 +223,8 @@ pprExp _ (UnboundVarE v) = pprName' Applied v pprExp _ (LabelE s) = text "#" <> text s pprExp _ (ImplicitParamVarE n) = text ('?' : n)+pprExp _ (GetFieldE e f) = pprExp appPrec e <> text ('.': f)+pprExp _ (ProjectionE xs) = parens $ hcat $ map ((char '.'<>) . text) xs pprFields :: [(Name,Exp)] -> Doc pprFields = sep . punctuate comma . map (\(s,e) -> pprName' Applied s <+> equals <+> ppr e)
libraries/template-haskell/Language/Haskell/TH/Syntax.hs view
@@ -2233,6 +2233,8 @@ -- or constructor name. | LabelE String -- ^ @{ #x }@ ( Overloaded label ) | ImplicitParamVarE String -- ^ @{ ?x }@ ( Implicit parameter )+ | GetFieldE Exp String -- ^ @{ exp.field }@ ( Overloaded Record Dot )+ | ProjectionE [String] -- ^ @(.x)@ or @(.x.y)@ (Record projections) deriving( Show, Eq, Ord, Data, Generic ) type FieldExp = (Name,Exp)@@ -2545,6 +2547,10 @@ -- @ -- -- In @MkBar@, 'ForallC' will quantify @a@, @b@, and @c@.+--+-- Multiplicity annotations for data types are currently not supported+-- in Template Haskell (i.e. all fields represented by Template Haskell+-- will be linear). data Con = NormalC Name [BangType] -- ^ @C Int a@ | RecC Name [VarBangType] -- ^ @C { v :: Int, w :: a }@ | InfixC BangType Name BangType -- ^ @Int :+ a@
+ rts/include/ghcconfig.h view
@@ -0,0 +1,4 @@+#pragma once++#include "ghcautoconf.h"+#include "ghcplatform.h"