ghc-lib 0.20220901 → 0.20221001
raw patch · 167 files changed
+3417/−2981 lines, 167 filesdep ~ghc-lib-parserPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: ghc-lib-parser
API changes (from Hackage documentation)
- GHC.CmmToAsm.Monad: [natm_modloc] :: NatM_State -> ModLocation
- GHC.CmmToAsm.Monad: getModLoc :: NatM ModLocation
- GHC.CmmToAsm.Monad: mapAccumLNat :: (acc -> x -> NatM (acc, y)) -> acc -> [x] -> NatM (acc, [y])
- GHC.Plugins: mapStepResult :: (ev1 -> ev2) -> NormaliseStepResult ev1 -> NormaliseStepResult ev2
- GHC.Tc.Errors: solverReportInfo_ExpectedActuals :: TcSolverReportInfo -> [(Type, Type)]
- GHC.Tc.Gen.Pat: polyPatSig :: TcType -> SDoc
- GHC.Utils.Monad.State.Lazy: data State s a
- GHC.Utils.Monad.State.Lazy: evalState :: State s a -> s -> a
- GHC.Utils.Monad.State.Lazy: execState :: State s a -> s -> s
- GHC.Utils.Monad.State.Lazy: get :: State s s
- GHC.Utils.Monad.State.Lazy: gets :: (s -> a) -> State s a
- GHC.Utils.Monad.State.Lazy: instance GHC.Base.Applicative (GHC.Utils.Monad.State.Lazy.State s)
- GHC.Utils.Monad.State.Lazy: instance GHC.Base.Functor (GHC.Utils.Monad.State.Lazy.State s)
- GHC.Utils.Monad.State.Lazy: instance GHC.Base.Monad (GHC.Utils.Monad.State.Lazy.State s)
- GHC.Utils.Monad.State.Lazy: modify :: (s -> s) -> State s ()
- GHC.Utils.Monad.State.Lazy: pattern State :: (s -> (# a, s #)) -> State s a
- GHC.Utils.Monad.State.Lazy: put :: s -> State s ()
- GHC.Utils.Monad.State.Lazy: runState :: State s a -> s -> (a, s)
- GHC.Utils.Monad.State.Lazy: state :: (s -> (a, s)) -> State s a
+ GHC.Core.Opt.DmdAnal: [dmd_do_boxity] :: DmdAnalOpts -> !Bool
+ GHC.Iface.Ext.Ast: instance GHC.Iface.Ext.Ast.HasLoc a => GHC.Iface.Ext.Ast.HasLoc (Language.Haskell.Syntax.Decls.DataDefnCons a)
+ GHC.Iface.Ext.Ast: instance GHC.Iface.Ext.Ast.ToHie a => GHC.Iface.Ext.Ast.ToHie (GHC.Base.NonEmpty a)
+ GHC.Iface.Ext.Ast: instance GHC.Iface.Ext.Ast.ToHie a => GHC.Iface.Ext.Ast.ToHie (Language.Haskell.Syntax.Decls.DataDefnCons a)
- GHC.CmmToAsm: cmmNativeGen :: forall statics instr jumpDest. (Instruction instr, OutputableP Platform statics, Outputable jumpDest) => Logger -> ModLocation -> NcgImpl statics instr jumpDest -> UniqSupply -> DwarfFiles -> LabelMap DebugBlock -> RawCmmDecl -> Int -> IO (UniqSupply, DwarfFiles, [NatCmmDecl statics instr], [CLabel], Maybe [RegAllocStats statics instr], Maybe [RegAllocStats], LabelMap [UnwindPoint])
+ GHC.CmmToAsm: cmmNativeGen :: forall statics instr jumpDest. (Instruction instr, OutputableP Platform statics, Outputable jumpDest) => Logger -> NcgImpl statics instr jumpDest -> UniqSupply -> DwarfFiles -> LabelMap DebugBlock -> RawCmmDecl -> Int -> IO (UniqSupply, DwarfFiles, [NatCmmDecl statics instr], [CLabel], Maybe [RegAllocStats statics instr], Maybe [RegAllocStats], LabelMap [UnwindPoint])
- GHC.CmmToAsm.Monad: NatM_State :: UniqSupply -> Int -> [CLabel] -> Maybe Reg -> NCGConfig -> ModLocation -> DwarfFiles -> LabelMap DebugBlock -> CFG -> NatM_State
+ GHC.CmmToAsm.Monad: NatM_State :: UniqSupply -> Int -> [CLabel] -> Maybe Reg -> NCGConfig -> DwarfFiles -> LabelMap DebugBlock -> CFG -> NatM_State
- GHC.CmmToAsm.Monad: data NatM result
+ GHC.CmmToAsm.Monad: data NatM a
- GHC.CmmToAsm.Monad: mkNatM_State :: UniqSupply -> Int -> NCGConfig -> ModLocation -> DwarfFiles -> LabelMap DebugBlock -> CFG -> NatM_State
+ GHC.CmmToAsm.Monad: mkNatM_State :: UniqSupply -> Int -> NCGConfig -> DwarfFiles -> LabelMap DebugBlock -> CFG -> NatM_State
- GHC.Core.Opt.DmdAnal: DmdAnalOpts :: !Bool -> !Int -> !Int -> DmdAnalOpts
+ GHC.Core.Opt.DmdAnal: DmdAnalOpts :: !Bool -> !Bool -> !Int -> !Int -> DmdAnalOpts
- GHC.Rename.Utils: mapFvRn :: (a -> RnM (b, FreeVars)) -> [a] -> RnM ([b], FreeVars)
+ GHC.Rename.Utils: mapFvRn :: Traversable f => (a -> RnM (b, FreeVars)) -> f a -> RnM (f b, FreeVars)
- GHC.Tc.Gen.Foreign: checkCTarget :: ForeignImport p -> CCallTarget -> TcM ()
+ GHC.Tc.Gen.Foreign: checkCTarget :: ForeignImport GhcRn -> CCallTarget -> TcM ()
- GHC.Tc.TyCl: dataDeclChecks :: Name -> NewOrData -> Maybe (LHsContext GhcRn) -> [LConDecl GhcRn] -> TcM Bool
+ GHC.Tc.TyCl: dataDeclChecks :: Name -> Maybe (LHsContext GhcRn) -> DataDefnCons (LConDecl GhcRn) -> TcM Bool
- GHC.Tc.TyCl: kcConDecls :: NewOrData -> TcKind -> [LConDecl GhcRn] -> TcM ()
+ GHC.Tc.TyCl: kcConDecls :: Foldable f => NewOrData -> TcKind -> f (LConDecl GhcRn) -> TcM ()
- GHC.Tc.TyCl: tcConDecls :: NewOrData -> DataDeclInfo -> KnotTied TyCon -> [TcTyConBinder] -> TcKind -> [LConDecl GhcRn] -> TcM [DataCon]
+ GHC.Tc.TyCl: tcConDecls :: DataDeclInfo -> KnotTied TyCon -> [TcTyConBinder] -> TcKind -> DataDefnCons (LConDecl GhcRn) -> TcM (DataDefnCons DataCon)
Files
- compiler/ClosureTypes.h +2/−1
- compiler/GHC.hs +1/−1
- compiler/GHC/ByteCode/Instr.hs +5/−5
- compiler/GHC/Cmm/CommonBlockElim.hs +5/−16
- compiler/GHC/Cmm/ContFlowOpt.hs +1/−1
- compiler/GHC/Cmm/Dataflow.hs +1/−1
- compiler/GHC/Cmm/DebugBlock.hs +1/−1
- compiler/GHC/Cmm/Dominators.hs +2/−4
- compiler/GHC/Cmm/Lint.hs +7/−12
- compiler/GHC/Cmm/Liveness.hs +1/−1
- compiler/GHC/Cmm/Parser.y +5/−6
- compiler/GHC/Cmm/Sink.hs +3/−3
- compiler/GHC/CmmToAsm.hs +15/−20
- compiler/GHC/CmmToAsm/AArch64/CodeGen.hs +5/−5
- compiler/GHC/CmmToAsm/AArch64/Instr.hs +3/−3
- compiler/GHC/CmmToAsm/AArch64/Ppr.hs +97/−89
- compiler/GHC/CmmToAsm/BlockLayout.hs +1/−1
- compiler/GHC/CmmToAsm/CFG.hs +7/−7
- compiler/GHC/CmmToAsm/CFG/Dominators.hs +3/−3
- compiler/GHC/CmmToAsm/CPrim.hs +1/−1
- compiler/GHC/CmmToAsm/Monad.hs +16/−48
- compiler/GHC/CmmToAsm/PPC/CodeGen.hs +1/−1
- compiler/GHC/CmmToAsm/Reg/Graph.hs +2/−2
- compiler/GHC/CmmToAsm/Reg/Graph/Base.hs +1/−1
- compiler/GHC/CmmToAsm/Reg/Graph/TrivColorable.hs +2/−2
- compiler/GHC/CmmToAsm/Reg/Linear.hs +2/−2
- compiler/GHC/CmmToAsm/Reg/Linear/AArch64.hs +1/−1
- compiler/GHC/CmmToAsm/Reg/Liveness.hs +6/−8
- compiler/GHC/CmmToAsm/X86/CodeGen.hs +5/−5
- compiler/GHC/CmmToC.hs +45/−45
- compiler/GHC/CmmToLlvm.hs +3/−2
- compiler/GHC/CmmToLlvm/Base.hs +14/−20
- compiler/GHC/CmmToLlvm/CodeGen.hs +10/−10
- compiler/GHC/CmmToLlvm/Ppr.hs +1/−1
- compiler/GHC/Core/Opt/CSE.hs +38/−31
- compiler/GHC/Core/Opt/CallArity.hs +2/−2
- compiler/GHC/Core/Opt/DmdAnal.hs +155/−61
- compiler/GHC/Core/Opt/Exitify.hs +3/−3
- compiler/GHC/Core/Opt/FloatOut.hs +1/−1
- compiler/GHC/Core/Opt/LiberateCase.hs +1/−1
- compiler/GHC/Core/Opt/Pipeline.hs +11/−10
- compiler/GHC/Core/Opt/SetLevels.hs +2/−2
- compiler/GHC/Core/Opt/SpecConstr.hs +26/−10
- compiler/GHC/Core/Opt/Specialise.hs +63/−80
- compiler/GHC/Core/Opt/WorkWrap.hs +50/−29
- compiler/GHC/Core/Opt/WorkWrap/Utils.hs +11/−11
- compiler/GHC/CoreToStg/Prep.hs +4/−7
- compiler/GHC/Data/Graph/Color.hs +1/−1
- compiler/GHC/Data/Graph/Ops.hs +3/−3
- compiler/GHC/Driver/GenerateCgIPEStub.hs +1/−1
- compiler/GHC/Driver/Main.hs +6/−4
- compiler/GHC/Driver/Make.hs +13/−12
- compiler/GHC/Driver/MakeFile.hs +4/−2
- compiler/GHC/Driver/Pipeline.hs +4/−4
- compiler/GHC/Driver/Pipeline/Execute.hs +9/−7
- compiler/GHC/HsToCore.hs +2/−3
- compiler/GHC/HsToCore/Binds.hs +9/−8
- compiler/GHC/HsToCore/Docs.hs +6/−5
- compiler/GHC/HsToCore/Expr.hs +6/−6
- compiler/GHC/HsToCore/Foreign/C.hs +3/−4
- compiler/GHC/HsToCore/Match.hs +1/−1
- compiler/GHC/HsToCore/Match/Constructor.hs +10/−11
- compiler/GHC/HsToCore/Match/Literal.hs +1/−1
- compiler/GHC/HsToCore/Monad.hs +2/−2
- compiler/GHC/HsToCore/Pmc.hs +1/−1
- compiler/GHC/HsToCore/Pmc/Desugar.hs +1/−1
- compiler/GHC/HsToCore/Pmc/Solver.hs +7/−7
- compiler/GHC/HsToCore/Quote.hs +10/−8
- compiler/GHC/HsToCore/Ticks.hs +11/−12
- compiler/GHC/HsToCore/Utils.hs +3/−3
- compiler/GHC/Iface/Binary.hs +2/−2
- compiler/GHC/Iface/Ext/Ast.hs +16/−5
- compiler/GHC/Iface/Ext/Binary.hs +1/−1
- compiler/GHC/Iface/Ext/Types.hs +5/−5
- compiler/GHC/Iface/Load.hs +1/−1
- compiler/GHC/Iface/Make.hs +1/−1
- compiler/GHC/Iface/Recomp.hs +7/−7
- compiler/GHC/Iface/Rename.hs +2/−6
- compiler/GHC/Iface/Tidy.hs +6/−8
- compiler/GHC/IfaceToCore.hs +16/−23
- compiler/GHC/Linker/Loader.hs +6/−6
- compiler/GHC/Linker/MacOS.hs +1/−1
- compiler/GHC/Llvm/Types.hs +1/−1
- compiler/GHC/Plugins.hs +1/−1
- compiler/GHC/Rename/Bind.hs +55/−26
- compiler/GHC/Rename/Env.hs +2/−2
- compiler/GHC/Rename/Expr.hs +23/−20
- compiler/GHC/Rename/Fixity.hs +1/−1
- compiler/GHC/Rename/HsType.hs +22/−22
- compiler/GHC/Rename/Module.hs +151/−34
- compiler/GHC/Rename/Names.hs +49/−33
- compiler/GHC/Rename/Pat.hs +2/−2
- compiler/GHC/Rename/Splice.hs +10/−10
- compiler/GHC/Rename/Unbound.hs +2/−4
- compiler/GHC/Rename/Utils.hs +25/−17
- compiler/GHC/Runtime/Debugger.hs +1/−1
- compiler/GHC/Runtime/Eval.hs +2/−2
- compiler/GHC/Runtime/Heap/Inspect.hs +3/−3
- compiler/GHC/Stg/Debug.hs +1/−1
- compiler/GHC/Stg/InferTags.hs +2/−2
- compiler/GHC/Stg/InferTags/Rewrite.hs +44/−50
- compiler/GHC/Stg/Lint.hs +6/−6
- compiler/GHC/Stg/Pipeline.hs +1/−1
- compiler/GHC/Stg/Unarise.hs +2/−2
- compiler/GHC/StgToByteCode.hs +2/−2
- compiler/GHC/StgToCmm/Bind.hs +1/−1
- compiler/GHC/StgToCmm/Env.hs +1/−1
- compiler/GHC/StgToCmm/Expr.hs +2/−2
- compiler/GHC/StgToCmm/Layout.hs +1/−1
- compiler/GHC/StgToCmm/Lit.hs +1/−1
- compiler/GHC/StgToCmm/Monad.hs +1/−1
- compiler/GHC/StgToCmm/Prim.hs +5/−1
- compiler/GHC/StgToCmm/TagCheck.hs +2/−2
- compiler/GHC/StgToCmm/Utils.hs +1/−1
- compiler/GHC/SysTools/Ar.hs +3/−3
- compiler/GHC/SysTools/Elf.hs +1/−1
- compiler/GHC/Tc/Deriv.hs +2/−2
- compiler/GHC/Tc/Deriv/Functor.hs +30/−2
- compiler/GHC/Tc/Deriv/Generate.hs +1/−1
- compiler/GHC/Tc/Deriv/Generics.hs +19/−4
- compiler/GHC/Tc/Deriv/Infer.hs +36/−17
- compiler/GHC/Tc/Errors.hs +169/−128
- compiler/GHC/Tc/Errors/Hole.hs +3/−4
- compiler/GHC/Tc/Gen/App.hs +7/−7
- compiler/GHC/Tc/Gen/Bind.hs +3/−3
- compiler/GHC/Tc/Gen/Export.hs +2/−2
- compiler/GHC/Tc/Gen/Expr.hs +6/−5
- compiler/GHC/Tc/Gen/Foreign.hs +8/−6
- compiler/GHC/Tc/Gen/Head.hs +2/−2
- compiler/GHC/Tc/Gen/HsType.hs +10/−10
- compiler/GHC/Tc/Gen/Match.hs +2/−1
- compiler/GHC/Tc/Gen/Pat.hs +0/−7
- compiler/GHC/Tc/Gen/Sig.hs +2/−2
- compiler/GHC/Tc/Gen/Splice.hs +24/−23
- compiler/GHC/Tc/Instance/Family.hs +3/−5
- compiler/GHC/Tc/Instance/FunDeps.hs +1/−1
- compiler/GHC/Tc/Instance/Typeable.hs +1/−1
- compiler/GHC/Tc/Module.hs +42/−40
- compiler/GHC/Tc/Solver.hs +6/−6
- compiler/GHC/Tc/Solver/Canonical.hs +6/−6
- compiler/GHC/Tc/Solver/Interact.hs +199/−71
- compiler/GHC/Tc/Solver/Monad.hs +11/−15
- compiler/GHC/Tc/TyCl.hs +122/−108
- compiler/GHC/Tc/TyCl/Class.hs +1/−1
- compiler/GHC/Tc/TyCl/Instance.hs +20/−24
- compiler/GHC/Tc/TyCl/PatSyn.hs +7/−7
- compiler/GHC/Tc/TyCl/Utils.hs +2/−2
- compiler/GHC/Tc/Utils/Backpack.hs +6/−5
- compiler/GHC/Tc/Utils/Env.hs +9/−9
- compiler/GHC/Tc/Utils/Instantiate.hs +3/−3
- compiler/GHC/Tc/Utils/Monad.hs +2/−2
- compiler/GHC/Tc/Utils/TcMType.hs +5/−5
- compiler/GHC/Tc/Utils/Unify.hs +5/−5
- compiler/GHC/Tc/Utils/Zonk.hs +2/−2
- compiler/GHC/Tc/Validity.hs +20/−20
- compiler/GHC/ThToHs.hs +20/−19
- compiler/GHC/Utils/Monad/State/Lazy.hs +0/−78
- ghc-lib.cabal +5/−3
- ghc-lib/stage0/compiler/build/primop-data-decl.hs-incl +3/−0
- ghc-lib/stage0/compiler/build/primop-docs.hs-incl +5/−1
- ghc-lib/stage0/compiler/build/primop-has-side-effects.hs-incl +3/−0
- ghc-lib/stage0/compiler/build/primop-list.hs-incl +3/−0
- ghc-lib/stage0/compiler/build/primop-out-of-line.hs-incl +3/−0
- ghc-lib/stage0/compiler/build/primop-primop-info.hs-incl +3/−0
- ghc-lib/stage0/compiler/build/primop-strictness.hs-incl +2/−0
- ghc-lib/stage0/compiler/build/primop-tag.hs-incl +1311/−1308
- ghc-lib/stage0/rts/build/include/GhclibDerivedConstants.h +13/−0
compiler/ClosureTypes.h view
@@ -87,4 +87,5 @@ #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+#define CONTINUATION 64+#define N_CLOSURE_TYPES 65
compiler/GHC.hs view
@@ -586,7 +586,7 @@ -- 'setSessionDynFlags' sets both @DynFlags@, and 'getSessionDynFlags' -- retrieves the program @DynFlags@ (for backwards compatibility). --- This is a compatability function which sets dynflags for the top session+-- This is a compatibility function which sets dynflags for the top session -- as well as the unit. setSessionDynFlags :: (HasCallStack, GhcMonad m) => DynFlags -> m () setSessionDynFlags dflags0 = do
compiler/GHC/ByteCode/Instr.hs view
@@ -68,12 +68,12 @@ | PUSH16 !Word16 | PUSH32 !Word16 - -- Push the specifiec local as a 8, 16, 32 bit value onto the stack, but the+ -- Push the specified local as a 8, 16, 32 bit value onto the stack, but the -- value will take the whole word on the stack (i.e., the stack will grow by -- a word) -- This is useful when extracting a packed constructor field for further use. -- Currently we expect all values on the stack to take full words, except for- -- the ones used for PACK (i.e., actually constracting new data types, in+ -- the ones used for PACK (i.e., actually constructing new data types, in -- which case we use PUSH{8,16,32}) | PUSH8_W !Word16 | PUSH16_W !Word16@@ -299,9 +299,9 @@ ppr (TESTEQ_P i lab) = text "TESTEQ_P" <+> ppr i <+> text "__" <> ppr lab ppr CASEFAIL = text "CASEFAIL" ppr (JMP lab) = text "JMP" <+> ppr lab- ppr (CCALL off marshall_addr flags) = text "CCALL " <+> ppr off- <+> text "marshall code at"- <+> text (show marshall_addr)+ ppr (CCALL off marshal_addr flags) = text "CCALL " <+> ppr off+ <+> text "marshal code at"+ <+> text (show marshal_addr) <+> (case flags of 0x1 -> text "(interruptible)" 0x2 -> text "(unsafe)"
compiler/GHC/Cmm/CommonBlockElim.hs view
@@ -18,6 +18,7 @@ import GHC.Cmm.Dataflow.Graph import GHC.Cmm.Dataflow.Label import GHC.Cmm.Dataflow.Collections+import Data.Functor.Classes (liftEq) import Data.Maybe (mapMaybe) import qualified Data.List as List import Data.Word@@ -213,7 +214,7 @@ = eqExprWith eqBid l1 l2 && eqExprWith eqBid r1 r2 eqMiddleWith eqBid (CmmUnsafeForeignCall t1 r1 a1) (CmmUnsafeForeignCall t2 r2 a2)- = t1 == t2 && r1 == r2 && eqListWith (eqExprWith eqBid) a1 a2+ = t1 == t2 && r1 == r2 && liftEq (eqExprWith eqBid) a1 a2 eqMiddleWith _ _ _ = False eqExprWith :: (BlockId -> BlockId -> Bool)@@ -224,12 +225,10 @@ CmmLoad e1 t1 a1 `eq` CmmLoad e2 t2 a2 = t1 `cmmEqType` t2 && e1 `eq` e2 && a1==a2 CmmReg r1 `eq` CmmReg r2 = r1==r2 CmmRegOff r1 i1 `eq` CmmRegOff r2 i2 = r1==r2 && i1==i2- CmmMachOp op1 es1 `eq` CmmMachOp op2 es2 = op1==op2 && es1 `eqs` es2+ CmmMachOp op1 es1 `eq` CmmMachOp op2 es2 = op1==op2 && liftEq eq es1 es2 CmmStackSlot a1 i1 `eq` CmmStackSlot a2 i2 = eqArea a1 a2 && i1==i2 _e1 `eq` _e2 = False - xs `eqs` ys = eqListWith eq xs ys- eqLit (CmmBlock id1) (CmmBlock id2) = eqBid id1 id2 eqLit l1 l2 = l1 == l2 @@ -251,7 +250,7 @@ (_,m',l') = blockSplit block' nodes' = filter (not . dont_care) (blockToList m') - equal = eqListWith (eqMiddleWith eqBid) nodes nodes' &&+ equal = liftEq (eqMiddleWith eqBid) nodes nodes' && eqLastWith eqBid l l' @@ -260,20 +259,10 @@ eqLastWith eqBid (CmmCondBranch c1 t1 f1 l1) (CmmCondBranch c2 t2 f2 l2) = c1 == c2 && l1 == l2 && eqBid t1 t2 && eqBid f1 f2 eqLastWith eqBid (CmmCall t1 c1 g1 a1 r1 u1) (CmmCall t2 c2 g2 a2 r2 u2) =- t1 == t2 && eqMaybeWith eqBid c1 c2 && a1 == a2 && r1 == r2 && u1 == u2 && g1 == g2+ t1 == t2 && liftEq eqBid c1 c2 && a1 == a2 && r1 == r2 && u1 == u2 && g1 == g2 eqLastWith eqBid (CmmSwitch e1 ids1) (CmmSwitch e2 ids2) = e1 == e2 && eqSwitchTargetWith eqBid ids1 ids2 eqLastWith _ _ _ = False--eqMaybeWith :: (a -> b -> Bool) -> Maybe a -> Maybe b -> Bool-eqMaybeWith eltEq (Just e) (Just e') = eltEq e e'-eqMaybeWith _ Nothing Nothing = True-eqMaybeWith _ _ _ = False--eqListWith :: (a -> b -> Bool) -> [a] -> [b] -> Bool-eqListWith f (a : as) (b : bs) = f a b && eqListWith f as bs-eqListWith _ [] [] = True-eqListWith _ _ _ = False -- | Given a block map, ensure that all "target" blocks are covered by -- the same ticks as the respective "source" blocks. This not only
compiler/GHC/Cmm/ContFlowOpt.hs view
@@ -334,7 +334,7 @@ In this case we could assume that we will end up with a jump for BOTH branches. In this case it might be best to put the likely path in the true branch especially if there are large numbers of predecessors as this saves- us the jump thats not taken. However I haven't tested this and as of early+ us the jump that's not taken. However I haven't tested this and as of early 2018 we almost never generate cmm where this would apply. -}
compiler/GHC/Cmm/Dataflow.hs view
@@ -87,7 +87,7 @@ Block n C C -> FactBase f -> FactBase f --- | Function for rewrtiting and analysis combined. To be used with+-- | Function for rewriting and analysis combined. To be used with -- @rewriteCmm@. -- -- Currently set to work with @UniqSM@ monad, but we could probably abstract
compiler/GHC/Cmm/DebugBlock.hs view
@@ -524,7 +524,7 @@ pprUnwindExpr :: Rational -> Platform -> UnwindExpr -> SDoc pprUnwindExpr p env = \case- UwConst i -> ppr i+ UwConst i -> int i UwReg g 0 -> ppr g UwReg g x -> pprUnwindExpr p env (UwPlus (UwReg g 0) (UwConst x)) UwDeref e -> char '*' <> pprUnwindExpr 3 env e
compiler/GHC/Cmm/Dominators.hs view
@@ -38,9 +38,7 @@ import GHC.Cmm.Dataflow.Label import GHC.Cmm -import GHC.Utils.Outputable( Outputable(..), text, int, hcat, (<+>)- , showSDocUnsafe- )+import GHC.Utils.Outputable( Outputable(..), text, int, hcat, (<+>)) import GHC.Utils.Misc import GHC.Utils.Panic @@ -188,7 +186,7 @@ findLabelIn :: HasDebugCallStack => Label -> LabelMap a -> a findLabelIn lbl = mapFindWithDefault failed lbl where failed =- panic $ "label " ++ showSDocUnsafe (ppr lbl) ++ " not found in result of analysis"+ pprPanic "label not found in result of analysis" (ppr lbl) -- | Use `gwdDominatorsOf` on the result of the dominator analysis to get -- a mapping from the `Label` of each reachable block to the dominator
compiler/GHC/Cmm/Lint.hs view
@@ -6,6 +6,7 @@ -- ----------------------------------------------------------------------------- {-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DerivingVia #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} module GHC.Cmm.Lint (@@ -26,7 +27,10 @@ import GHC.Cmm.CLabel (pprDebugCLabel) import GHC.Utils.Outputable -import Control.Monad (ap, unless)+import Control.Monad (unless)+import Control.Monad.Trans.Except (ExceptT (..), Except)+import Control.Monad.Trans.Reader (ReaderT (..))+import Data.Functor.Identity (Identity (..)) -- Things to check: -- - invariant on CmmBlock in GHC.Cmm.Expr (see comment there)@@ -261,17 +265,8 @@ -- just a basic error monad: newtype CmmLint a = CmmLint { unCL :: Platform -> Either SDoc a }- deriving (Functor)--instance Applicative CmmLint where- pure a = CmmLint (\_ -> Right a)- (<*>) = ap--instance Monad CmmLint where- CmmLint m >>= k = CmmLint $ \platform ->- case m platform of- Left e -> Left e- Right a -> unCL (k a) platform+ deriving stock (Functor)+ deriving (Applicative, Monad) via ReaderT Platform (Except SDoc) getPlatform :: CmmLint Platform getPlatform = CmmLint $ \platform -> Right platform
compiler/GHC/Cmm/Liveness.hs view
@@ -103,7 +103,7 @@ ----------------------------------------------------------------------------- -- | Specialization that only retains the keys for local variables. ----- Local variablas are mostly glorified Ints, and some parts of the compiler+-- Local variables are mostly glorified Ints, and some parts of the compiler -- really don't care about anything but the Int part. So we can avoid some -- overhead by computing a IntSet instead of a Set LocalReg which (unsurprisingly) -- is quite a bit faster.
compiler/GHC/Cmm/Parser.y view
@@ -449,7 +449,7 @@ platform <- getPlatform; ctx <- getContext; formals <- sequence (fromMaybe [] $3);- withName (renderWithContext ctx (pprCLabel platform CStyle entry_ret_label))+ withName (showSDocOneLine ctx (pprCLabel platform CStyle entry_ret_label)) $4; return (entry_ret_label, info, stk_formals, formals) } let do_layout = isJust $3@@ -492,15 +492,14 @@ , cit_prof = prof, cit_srt = Nothing, cit_clo = Nothing }, []) } - | 'INFO_TABLE_FUN' '(' NAME ',' INT ',' INT ',' INT ',' STRING ',' STRING ',' INT ')'- -- ptrs, nptrs, closure type, description, type, fun type+ | 'INFO_TABLE_FUN' '(' NAME ',' INT ',' INT ',' INT ',' STRING ',' STRING ',' INT ',' INT ')'+ -- ptrs, nptrs, closure type, description, type, arity, fun type {% do home_unit_id <- getHomeUnitId liftP $ pure $ do profile <- getProfile let prof = profilingInfo profile $11 $13- ty = Fun 0 (ArgSpec (fromIntegral $15))- -- Arity zero, arg_type $15+ ty = Fun (fromIntegral $15) (ArgSpec (fromIntegral $17)) rep = mkRTSRep (fromIntegral $9) $ mkHeapRep profile False (fromIntegral $5) (fromIntegral $7) ty@@ -510,7 +509,7 @@ , cit_prof = prof, cit_srt = Nothing, cit_clo = Nothing }, []) } -- we leave most of the fields zero here. This is only used- -- to generate the BCO info table in the RTS at the moment.+ -- to generate the BCO and CONTINUATION info tables in the RTS at the moment. | 'INFO_TABLE_CONSTR' '(' NAME ',' INT ',' INT ',' INT ',' INT ',' STRING ',' STRING ')' -- ptrs, nptrs, tag, closure type, description, type
compiler/GHC/Cmm/Sink.hs view
@@ -360,7 +360,7 @@ * The assignment `_c3 = [R1 + 1]`; (R1 already inlined on pickup) conflicts with R1 = R1, because it reads `R1` and the node writes to R1- * This is clearly no-sensical because `R1 = R1` doesn't affect R1's value.+ * This is clearly nonsensical because `R1 = R1` doesn't affect R1's value. The solutions is to check if we can discard nodes before and *after* simplifying them. We could only do it after as well, but I assume doing it early might save@@ -490,7 +490,7 @@ where (final_node, rest') = go usages live' node' (insertLRegSet l skipped) rest -- Avoid discarding of assignments to vars on the rhs.- -- See Note [Keeping assignemnts mentioned in skipped RHSs]+ -- See Note [Keeping assignments mentioned in skipped RHSs] -- usages' = foldLocalRegsUsed platform (\m r -> addToUFM m r 2) -- usages rhs live' = inline foldLocalRegsUsed platform (\m r -> insertLRegSet r m)@@ -518,7 +518,7 @@ inl_exp (CmmMachOp op args) = cmmMachOpFold platform op args inl_exp other = other -{- Note [Keeping assignemnts mentioned in skipped RHSs]+{- Note [Keeping assignments mentioned in skipped RHSs] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ If we have to assignments: [z = y, y = e1] and we skip z we *must* retain the assignment y = e1. This is because
compiler/GHC/CmmToAsm.hs view
@@ -78,7 +78,7 @@ ) where -import GHC.Prelude+import GHC.Prelude hiding (head) import qualified GHC.CmmToAsm.X86 as X86 import qualified GHC.CmmToAsm.PPC as PPC@@ -139,7 +139,8 @@ import GHC.Data.Stream (Stream) import qualified GHC.Data.Stream as Stream -import Data.List (sortBy, groupBy)+import Data.List (sortBy)+import Data.List.NonEmpty (groupAllWith, head) import Data.Maybe import Data.Ord ( comparing ) import Control.Monad@@ -331,7 +332,7 @@ dbgMap = debugToMap ndbgs -- Generate native code- (ngs',us') <- cmmNativeGens logger config modLoc ncgImpl h+ (ngs',us') <- cmmNativeGens logger config ncgImpl h dbgMap us cmms ngs 0 -- Link native code information into debug blocks@@ -355,7 +356,6 @@ (OutputableP Platform statics, Outputable jumpDest, Instruction instr) => Logger -> NCGConfig- -> ModLocation -> NcgImpl statics instr jumpDest -> BufHandle -> LabelMap DebugBlock@@ -365,7 +365,7 @@ -> Int -> IO (NativeGenAcc statics instr, UniqSupply) -cmmNativeGens logger config modLoc ncgImpl h dbgMap = go+cmmNativeGens logger config ncgImpl h dbgMap = go where go :: UniqSupply -> [RawCmmDecl] -> NativeGenAcc statics instr -> Int@@ -378,7 +378,7 @@ let fileIds = ngs_dwarfFiles ngs (us', fileIds', native, imports, colorStats, linearStats, unwinds) <- {-# SCC "cmmNativeGen" #-}- cmmNativeGen logger modLoc ncgImpl us fileIds dbgMap+ cmmNativeGen logger ncgImpl us fileIds dbgMap cmm count -- Generate .file directives for every new file that has been@@ -387,7 +387,7 @@ let newFileIds = sortBy (comparing snd) $ nonDetEltsUFM $ fileIds' `minusUFM` fileIds -- See Note [Unique Determinism and code generation]- pprDecl (f,n) = text "\t.file " <> ppr n <+>+ pprDecl (f,n) = text "\t.file " <> int n <+> pprFilePathString (unpackFS f) emitNativeCode logger config h $ vcat $@@ -432,7 +432,6 @@ cmmNativeGen :: forall statics instr jumpDest. (Instruction instr, OutputableP Platform statics, Outputable jumpDest) => Logger- -> ModLocation -> NcgImpl statics instr jumpDest -> UniqSupply -> DwarfFiles@@ -448,7 +447,7 @@ , LabelMap [UnwindPoint] -- unwinding information for blocks ) -cmmNativeGen logger modLoc ncgImpl us fileIds dbgMap cmm count+cmmNativeGen logger ncgImpl us fileIds dbgMap cmm count = do let config = ncgConfig ncgImpl let platform = ncgPlatform config@@ -478,7 +477,7 @@ -- generate native code from cmm let ((native, lastMinuteImports, fileIds', nativeCfgWeights), usGen) = {-# SCC "genMachCode" #-}- initUs us $ genMachCode config modLoc+ initUs us $ genMachCode config (cmmTopCodeGen ncgImpl) fileIds dbgMap opt_cmm cmmCfg @@ -698,7 +697,7 @@ checkLayout :: [NatCmmDecl statics instr] -> [NatCmmDecl statics instr] -> [NatCmmDecl statics instr] checkLayout procsUnsequenced procsSequenced =- assertPpr (setNull diff) (ppr "Block sequencing dropped blocks:" <> ppr diff)+ assertPpr (setNull diff) (text "Block sequencing dropped blocks:" <> ppr diff) procsSequenced where blocks1 = foldl' (setUnion) setEmpty $@@ -771,23 +770,20 @@ -- Generate "symbol stubs" for all external symbols that might -- come from a dynamic library. dyld_stubs :: [CLabel] -> SDoc-{- dyld_stubs imps = vcat $ map pprDyldSymbolStub $- map head $ group $ sort imps-} -- (Hack) sometimes two Labels pretty-print the same, but have -- different uniques; so we compare their text versions... dyld_stubs imps | needImportedSymbols config = vcat $ (pprGotDeclaration config :) $- map ( pprImportedSymbol config . fst . head) $- groupBy (\(_,a) (_,b) -> a == b) $- sortBy (\(_,a) (_,b) -> compare a b) $+ fmap (pprImportedSymbol config . fst . head) $+ groupAllWith snd $ map doPpr $ imps | otherwise = Outputable.empty - doPpr lbl = (lbl, renderWithContext+ doPpr lbl = (lbl, showSDocOneLine (ncgAsmContext config) (pprAsmLabel platform lbl)) @@ -902,7 +898,6 @@ genMachCode :: NCGConfig- -> ModLocation -> (RawCmmDecl -> NatM [NatCmmDecl statics instr]) -> DwarfFiles -> LabelMap DebugBlock@@ -915,10 +910,10 @@ , CFG ) -genMachCode config modLoc cmmTopCodeGen fileIds dbgMap cmm_top cmm_cfg+genMachCode config cmmTopCodeGen fileIds dbgMap cmm_top cmm_cfg = do { initial_us <- getUniqueSupplyM ; let initial_st = mkNatM_State initial_us 0 config- modLoc fileIds dbgMap cmm_cfg+ fileIds dbgMap cmm_cfg (new_tops, final_st) = initNat initial_st (cmmTopCodeGen cmm_top) final_delta = natm_delta final_st final_imports = natm_imports final_st
compiler/GHC/CmmToAsm/AArch64/CodeGen.hs view
@@ -179,13 +179,13 @@ -- Using pprExpr will hide the AST, @ANN@ will end up in the assembly with -- -dppr-debug. The idea is that we can trivially see how a cmm expression--- ended up producing the assmebly we see. By having the verbatim AST printed--- we can simply check the patterns that were matched to arrive at the assmebly+-- ended up producing the assembly we see. By having the verbatim AST printed+-- we can simply check the patterns that were matched to arrive at the assembly -- we generated. -- -- pprExpr will hide a lot of noise of the underlying data structure and print -- the expression into something that can be easily read by a human. However--- going back to the exact CmmExpr representation can be labourous and adds+-- going back to the exact CmmExpr representation can be laborious and adds -- indirections to find the matches that lead to the assembly. -- -- An improvement oculd be to have@@ -937,7 +937,7 @@ -- careful with the floating point operations. -- SLE is effectively LE or unordered (NaN) -- SLT is the same. ULE, and ULT will not return true for NaN.- -- This is a bit counter intutive. Don't let yourself be fooled by+ -- This is a bit counter-intuitive. Don't let yourself be fooled by -- the S/U prefix for floats, it's only meaningful for integers. MO_F_Ge w -> floatCond w (\d x y -> toOL [ CMP x y, CSET d OGE ]) MO_F_Le w -> floatCond w (\d x y -> toOL [ CMP x y, CSET d OLE ]) -- x <= y <=> y > x@@ -1550,7 +1550,7 @@ genCCall (ForeignTarget target cconv) dest_regs arg_regs bid -- TODO: Optimize using paired stores and loads (STP, LDP). It is- -- automomatically done by the allocator for us. However it's not optimal,+ -- automatically done by the allocator for us. However it's not optimal, -- as we'd rather want to have control over -- all spill/load registers, so we can optimize with instructions like -- STP xA, xB, [sp, #-16]!
compiler/GHC/CmmToAsm/AArch64/Instr.hs view
@@ -338,8 +338,8 @@ -- -- Using sp to compute the offset will violate assumptions about the stack pointer -- pointing to the top of the stack during signal handling. As we can't force--- every signal to use its own stack, we have to ensure that the stack poitner--- always poitns to the top of the stack, and we can't use it for computation.+-- every signal to use its own stack, we have to ensure that the stack pointer+-- always points to the top of the stack, and we can't use it for computation. -- -- | An instruction to spill a register into a spill slot. mkSpillInstr@@ -541,7 +541,7 @@ | PUSH_STACK_FRAME | POP_STACK_FRAME -- 1. Arithmetic Instructions ----------------------------------------------- -- | ADC Operand Operand Operang -- rd = rn + rm + C+ -- | ADC Operand Operand Operand -- rd = rn + rm + C -- | ADCS ... | ADD Operand Operand Operand -- rd = rn + rm -- | ADDS Operand Operand Operand -- rd = rn + rm
compiler/GHC/CmmToAsm/AArch64/Ppr.hs view
@@ -180,7 +180,7 @@ -- Note [Always use objects for info tables] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -- See discussion in X86.Ppr for why this is necessary. Essentially we need to--- ensure that we never pass function symbols when we migth want to lookup the+-- ensure that we never pass function symbols when we might want to lookup the -- info table. If we did, we could end up with procedure linking tables -- (PLT)s, and thus the lookup wouldn't point to the function, but into the -- jump table.@@ -263,7 +263,7 @@ ImmInteger i -> char '#' <> integer i -- TODO: This will only work for- -- The floating point value must be expressable as ±n ÷ 16 × 2^r,+ -- The floating point value must be expressible as ±n ÷ 16 × 2^r, -- where n and r are integers such that 16 ≤ n ≤ 31 and -3 ≤ r ≤ 4. -- and 0 needs to be encoded as wzr/xzr. --@@ -273,7 +273,7 @@ -- This is something the x86 backend does. -- -- We could also just turn them into statics :-/ Which is what the- -- PowerPC backend odes.+ -- PowerPC backend does. ImmFloat f | f == 0 -> text "wzr" ImmFloat f -> char '#' <> float (fromRational f) ImmDouble d | d == 0 -> text "xzr"@@ -307,7 +307,7 @@ OpRegShift w r s i -> pprReg w r <> comma <+> pprShift s <+> char '#' <> int i OpImm im -> pprIm plat im OpImmShift im s i -> pprIm plat im <> comma <+> pprShift s <+> char '#' <> int i- -- TODO: Address compuation always use registers as 64bit -- is this correct?+ -- TODO: Address computation always use registers as 64bit -- is this correct? OpAddr (AddrRegReg r1 r2) -> char '[' <+> pprReg W64 r1 <> comma <+> pprReg W64 r2 <+> char ']' OpAddr (AddrRegImm r1 im) -> char '[' <+> pprReg W64 r1 <> comma <+> pprImm plat im <+> char ']' OpAddr (AddrReg r1) -> char '[' <+> pprReg W64 r1 <+> char ']'@@ -373,60 +373,60 @@ -- AArch64 Instruction Set -- 1. Arithmetic Instructions ------------------------------------------------ ADD o1 o2 o3- | isFloatOp o1 && isFloatOp o2 && isFloatOp o3 -> text "\tfadd" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3- | otherwise -> text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3- CMN o1 o2 -> text "\tcmn" <+> pprOp platform o1 <> comma <+> pprOp platform o2+ | isFloatOp o1 && isFloatOp o2 && isFloatOp o3 -> op3 (text "\tfadd") o1 o2 o3+ | otherwise -> op3 (text "\tadd") o1 o2 o3+ CMN o1 o2 -> op2 (text "\tcmn") o1 o2 CMP o1 o2- | isFloatOp o1 && isFloatOp o2 -> text "\tfcmp" <+> pprOp platform o1 <> comma <+> pprOp platform o2- | otherwise -> text "\tcmp" <+> pprOp platform o1 <> comma <+> pprOp platform o2- MSUB o1 o2 o3 o4 -> text "\tmsub" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3 <> comma <+> pprOp platform o4+ | isFloatOp o1 && isFloatOp o2 -> op2 (text "\tfcmp") o1 o2+ | otherwise -> op2 (text "\tcmp") o1 o2+ MSUB o1 o2 o3 o4 -> op4 (text "\tmsub") o1 o2 o3 o4 MUL o1 o2 o3- | isFloatOp o1 && isFloatOp o2 && isFloatOp o3 -> text "\tfmul" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3- | otherwise -> text "\tmul" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3- SMULH o1 o2 o3 -> text "\tsmulh" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3- SMULL o1 o2 o3 -> text "\tsmull" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3+ | isFloatOp o1 && isFloatOp o2 && isFloatOp o3 -> op3 (text "\tfmul") o1 o2 o3+ | otherwise -> op3 (text "\tmul") o1 o2 o3+ SMULH o1 o2 o3 -> op3 (text "\tsmulh") o1 o2 o3+ SMULL o1 o2 o3 -> op3 (text "\tsmull") o1 o2 o3 NEG o1 o2- | isFloatOp o1 && isFloatOp o2 -> text "\tfneg" <+> pprOp platform o1 <> comma <+> pprOp platform o2- | otherwise -> text "\tneg" <+> pprOp platform o1 <> comma <+> pprOp platform o2+ | isFloatOp o1 && isFloatOp o2 -> op2 (text "\tfneg") o1 o2+ | otherwise -> op2 (text "\tneg") o1 o2 SDIV o1 o2 o3 | isFloatOp o1 && isFloatOp o2 && isFloatOp o3- -> text "\tfdiv" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3- SDIV o1 o2 o3 -> text "\tsdiv" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3+ -> op3 (text "\tfdiv") o1 o2 o3+ SDIV o1 o2 o3 -> op3 (text "\tsdiv") o1 o2 o3 SUB o1 o2 o3- | isFloatOp o1 && isFloatOp o2 && isFloatOp o3 -> text "\tfsub" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3- | otherwise -> text "\tsub" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3- UDIV o1 o2 o3 -> text "\tudiv" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3+ | isFloatOp o1 && isFloatOp o2 && isFloatOp o3 -> op3 (text "\tfsub") o1 o2 o3+ | otherwise -> op3 (text "\tsub") o1 o2 o3+ UDIV o1 o2 o3 -> op3 (text "\tudiv") o1 o2 o3 -- 2. Bit Manipulation Instructions ------------------------------------------- SBFM o1 o2 o3 o4 -> text "\tsbfm" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3 <> comma <+> pprOp platform o4- UBFM o1 o2 o3 o4 -> text "\tubfm" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3 <> comma <+> pprOp platform o4+ SBFM o1 o2 o3 o4 -> op4 (text "\tsbfm") o1 o2 o3 o4+ UBFM o1 o2 o3 o4 -> op4 (text "\tubfm") o1 o2 o3 o4 -- signed and unsigned bitfield extract- SBFX o1 o2 o3 o4 -> text "\tsbfx" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3 <> comma <+> pprOp platform o4- UBFX o1 o2 o3 o4 -> text "\tubfx" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3 <> comma <+> pprOp platform o4- SXTB o1 o2 -> text "\tsxtb" <+> pprOp platform o1 <> comma <+> pprOp platform o2- UXTB o1 o2 -> text "\tuxtb" <+> pprOp platform o1 <> comma <+> pprOp platform o2- SXTH o1 o2 -> text "\tsxth" <+> pprOp platform o1 <> comma <+> pprOp platform o2- UXTH o1 o2 -> text "\tuxth" <+> pprOp platform o1 <> comma <+> pprOp platform o2+ SBFX o1 o2 o3 o4 -> op4 (text "\tsbfx") o1 o2 o3 o4+ UBFX o1 o2 o3 o4 -> op4 (text "\tubfx") o1 o2 o3 o4+ SXTB o1 o2 -> op2 (text "\tsxtb") o1 o2+ UXTB o1 o2 -> op2 (text "\tuxtb") o1 o2+ SXTH o1 o2 -> op2 (text "\tsxth") o1 o2+ UXTH o1 o2 -> op2 (text "\tuxth") o1 o2 -- 3. Logical and Move Instructions ------------------------------------------- AND o1 o2 o3 -> text "\tand" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3- ANDS o1 o2 o3 -> text "\tands" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3- ASR o1 o2 o3 -> text "\tasr" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3- BIC o1 o2 o3 -> text "\tbic" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3- BICS o1 o2 o3 -> text "\tbics" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3- EON o1 o2 o3 -> text "\teon" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3- EOR o1 o2 o3 -> text "\teor" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3- LSL o1 o2 o3 -> text "\tlsl" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3- LSR o1 o2 o3 -> text "\tlsr" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3+ AND o1 o2 o3 -> op3 (text "\tand") o1 o2 o3+ ANDS o1 o2 o3 -> op3 (text "\tands") o1 o2 o3+ ASR o1 o2 o3 -> op3 (text "\tasr") o1 o2 o3+ BIC o1 o2 o3 -> op3 (text "\tbic") o1 o2 o3+ BICS o1 o2 o3 -> op3 (text "\tbics") o1 o2 o3+ EON o1 o2 o3 -> op3 (text "\teon") o1 o2 o3+ EOR o1 o2 o3 -> op3 (text "\teor") o1 o2 o3+ LSL o1 o2 o3 -> op3 (text "\tlsl") o1 o2 o3+ LSR o1 o2 o3 -> op3 (text "\tlsr") o1 o2 o3 MOV o1 o2- | isFloatOp o1 || isFloatOp o2 -> text "\tfmov" <+> pprOp platform o1 <> comma <+> pprOp platform o2- | otherwise -> text "\tmov" <+> pprOp platform o1 <> comma <+> pprOp platform o2- MOVK o1 o2 -> text "\tmovk" <+> pprOp platform o1 <> comma <+> pprOp platform o2- MVN o1 o2 -> text "\tmvn" <+> pprOp platform o1 <> comma <+> pprOp platform o2- ORN o1 o2 o3 -> text "\torn" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3- ORR o1 o2 o3 -> text "\torr" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3- ROR o1 o2 o3 -> text "\tror" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3- TST o1 o2 -> text "\ttst" <+> pprOp platform o1 <> comma <+> pprOp platform o2+ | isFloatOp o1 || isFloatOp o2 -> op2 (text "\tfmov") o1 o2+ | otherwise -> op2 (text "\tmov") o1 o2+ MOVK o1 o2 -> op2 (text "\tmovk") o1 o2+ MVN o1 o2 -> op2 (text "\tmvn") o1 o2+ ORN o1 o2 o3 -> op3 (text "\torn") o1 o2 o3+ ORR o1 o2 o3 -> op3 (text "\torr") o1 o2 o3+ ROR o1 o2 o3 -> op3 (text "\tror") o1 o2 o3+ TST o1 o2 -> op2 (text "\ttst") o1 o2 -- 4. Branch Instructions ---------------------------------------------------- J t -> pprInstr platform (B t)@@ -459,83 +459,91 @@ -- address. Not observing the correct size when loading will lead -- inevitably to crashes. STR _f o1@(OpReg W8 (RegReal (RealRegSingle i))) o2 | i < 32 ->- text "\tstrb" <+> pprOp platform o1 <> comma <+> pprOp platform o2+ op2 (text "\tstrb") o1 o2 STR _f o1@(OpReg W16 (RegReal (RealRegSingle i))) o2 | i < 32 ->- text "\tstrh" <+> pprOp platform o1 <> comma <+> pprOp platform o2- STR _f o1 o2 -> text "\tstr" <+> pprOp platform o1 <> comma <+> pprOp platform o2+ op2 (text "\tstrh") o1 o2+ STR _f o1 o2 -> op2 (text "\tstr") o1 o2 #if defined(darwin_HOST_OS) LDR _f o1 (OpImm (ImmIndex lbl' off)) | Just (_info, lbl) <- dynamicLinkerLabelInfo lbl' ->- text "\tadrp" <+> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl <> text "@gotpage" $$- text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl <> text "@gotpageoff" <> text "]" $$- text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> char '#' <> int off -- TODO: check that off is in 12bits.+ op_adrp o1 (pprAsmLabel platform lbl <> text "@gotpage") $$+ op_ldr o1 (pprAsmLabel platform lbl <> text "@gotpageoff") $$+ op_add o1 (char '#' <> int off) -- TODO: check that off is in 12bits. LDR _f o1 (OpImm (ImmIndex lbl off)) | isForeignLabel lbl ->- text "\tadrp" <+> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl <> text "@gotpage" $$- text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl <> text "@gotpageoff" <> text "]" $$- text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> char '#' <> int off -- TODO: check that off is in 12bits.+ op_adrp o1 (pprAsmLabel platform lbl <> text "@gotpage") $$+ op_ldr o1 (pprAsmLabel platform lbl <> text "@gotpageoff") $$+ op_add o1 (char '#' <> int off) -- TODO: check that off is in 12bits. LDR _f o1 (OpImm (ImmIndex lbl off)) ->- text "\tadrp" <+> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl <> text "@page" $$- text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl <> text "@pageoff" $$- text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> char '#' <> int off -- TODO: check that off is in 12bits.+ op_adrp o1 (pprAsmLabel platform lbl <> text "@page") $$+ op_add o1 (pprAsmLabel platform lbl <> text "@pageoff") $$+ op_add o1 (char '#' <> int off) -- TODO: check that off is in 12bits. LDR _f o1 (OpImm (ImmCLbl lbl')) | Just (_info, lbl) <- dynamicLinkerLabelInfo lbl' ->- text "\tadrp" <+> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl <> text "@gotpage" $$- text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl <> text "@gotpageoff" <> text "]"+ op_adrp o1 (pprAsmLabel platform lbl <> text "@gotpage") $$+ op_ldr o1 (pprAsmLabel platform lbl <> text "@gotpageoff") LDR _f o1 (OpImm (ImmCLbl lbl)) | isForeignLabel lbl ->- text "\tadrp" <+> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl <> text "@gotpage" $$- text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl <> text "@gotpageoff" <> text "]"+ op_adrp o1 (pprAsmLabel platform lbl <> text "@gotpage") $$+ op_ldr o1 (pprAsmLabel platform lbl <> text "@gotpageoff") LDR _f o1 (OpImm (ImmCLbl lbl)) ->- text "\tadrp" <+> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl <> text "@page" $$- text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl <> text "@pageoff"+ op_adrp o1 (pprAsmLabel platform lbl <> text "@page") $$+ op_add o1 (pprAsmLabel platform lbl <> text "@pageoff")+ #else LDR _f o1 (OpImm (ImmIndex lbl' off)) | Just (_info, lbl) <- dynamicLinkerLabelInfo lbl' ->- text "\tadrp" <+> pprOp platform o1 <> comma <+> text ":got:" <> pprAsmLabel platform lbl $$- text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> text ":got_lo12:" <> pprAsmLabel platform lbl <> text "]" $$- text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> char '#' <> int off -- TODO: check that off is in 12bits.+ op_adrp o1 (text ":got:" <> pprAsmLabel platform lbl) $$+ op_ldr o1 (text ":got_lo12:" <> pprAsmLabel platform lbl) $$+ op_add o1 (char '#' <> int off) -- TODO: check that off is in 12bits. LDR _f o1 (OpImm (ImmIndex lbl off)) | isForeignLabel lbl ->- text "\tadrp" <+> pprOp platform o1 <> comma <+> text ":got:" <> pprAsmLabel platform lbl $$- text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> text ":got_lo12:" <> pprAsmLabel platform lbl <> text "]" $$- text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> char '#' <> int off -- TODO: check that off is in 12bits.+ op_adrp o1 (text ":got:" <> pprAsmLabel platform lbl) $$+ op_ldr o1 (text ":got_lo12:" <> pprAsmLabel platform lbl) $$+ op_add o1 (char '#' <> int off) -- TODO: check that off is in 12bits. LDR _f o1 (OpImm (ImmIndex lbl off)) ->- text "\tadrp" <+> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl $$- text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> text ":lo12:" <> pprAsmLabel platform lbl $$- text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> char '#' <> int off -- TODO: check that off is in 12bits.+ op_adrp o1 (pprAsmLabel platform lbl) $$+ op_add o1 (text ":lo12:" <> pprAsmLabel platform lbl) $$+ op_add o1 (char '#' <> int off) -- TODO: check that off is in 12bits. LDR _f o1 (OpImm (ImmCLbl lbl')) | Just (_info, lbl) <- dynamicLinkerLabelInfo lbl' ->- text "\tadrp" <+> pprOp platform o1 <> comma <+> text ":got:" <> pprAsmLabel platform lbl $$- text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> text ":got_lo12:" <> pprAsmLabel platform lbl <> text "]"+ op_adrp o1 (text ":got:" <> pprAsmLabel platform lbl) $$+ op_ldr o1 (text ":got_lo12:" <> pprAsmLabel platform lbl) LDR _f o1 (OpImm (ImmCLbl lbl)) | isForeignLabel lbl ->- text "\tadrp" <+> pprOp platform o1 <> comma <+> text ":got:" <> pprAsmLabel platform lbl $$- text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> text ":got_lo12:" <> pprAsmLabel platform lbl <> text "]"+ op_adrp o1 (text ":got:" <> pprAsmLabel platform lbl) $$+ op_ldr o1 (text ":got_lo12:" <> pprAsmLabel platform lbl) LDR _f o1 (OpImm (ImmCLbl lbl)) ->- text "\tadrp" <+> pprOp platform o1 <> comma <+> pprAsmLabel platform lbl $$- text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> text ":lo12:" <> pprAsmLabel platform lbl+ op_adrp o1 (pprAsmLabel platform lbl) $$+ op_add o1 (text ":lo12:" <> pprAsmLabel platform lbl)+ #endif LDR _f o1@(OpReg W8 (RegReal (RealRegSingle i))) o2 | i < 32 ->- text "\tldrb" <+> pprOp platform o1 <> comma <+> pprOp platform o2+ op2 (text "\tldrb") o1 o2 LDR _f o1@(OpReg W16 (RegReal (RealRegSingle i))) o2 | i < 32 ->- text "\tldrh" <+> pprOp platform o1 <> comma <+> pprOp platform o2- LDR _f o1 o2 -> text "\tldr" <+> pprOp platform o1 <> comma <+> pprOp platform o2+ op2 (text "\tldrh") o1 o2+ LDR _f o1 o2 -> op2 (text "\tldr") o1 o2 - STP _f o1 o2 o3 -> text "\tstp" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3- LDP _f o1 o2 o3 -> text "\tldp" <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3+ STP _f o1 o2 o3 -> op3 (text "\tstp") o1 o2 o3+ LDP _f o1 o2 o3 -> op3 (text "\tldp") o1 o2 o3 -- 8. Synchronization Instructions ------------------------------------------- DMBSY -> text "\tdmb sy" -- 9. Floating Point Instructions --------------------------------------------- FCVT o1 o2 -> text "\tfcvt" <+> pprOp platform o1 <> comma <+> pprOp platform o2- SCVTF o1 o2 -> text "\tscvtf" <+> pprOp platform o1 <> comma <+> pprOp platform o2- FCVTZS o1 o2 -> text "\tfcvtzs" <+> pprOp platform o1 <> comma <+> pprOp platform o2- FABS o1 o2 -> text "\tfabs" <+> pprOp platform o1 <> comma <+> pprOp platform o2+ FCVT o1 o2 -> op2 (text "\tfcvt") o1 o2+ SCVTF o1 o2 -> op2 (text "\tscvtf") o1 o2+ FCVTZS o1 o2 -> op2 (text "\tfcvtzs") o1 o2+ FABS o1 o2 -> op2 (text "\tfabs") o1 o2+ where op2 op o1 o2 = op <+> pprOp platform o1 <> comma <+> pprOp platform o2+ op3 op o1 o2 o3 = op <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3+ op4 op o1 o2 o3 o4 = op <+> pprOp platform o1 <> comma <+> pprOp platform o2 <> comma <+> pprOp platform o3 <> comma <+> pprOp platform o4+ op_ldr o1 rest = text "\tldr" <+> pprOp platform o1 <> comma <+> text "[" <> pprOp platform o1 <> comma <+> rest <> text "]"+ op_adrp o1 rest = text "\tadrp" <+> pprOp platform o1 <> comma <+> rest+ op_add o1 rest = text "\tadd" <+> pprOp platform o1 <> comma <+> pprOp platform o1 <> comma <+> rest pprBcond :: Cond -> SDoc pprBcond c = text "b." <> pprCond c@@ -560,7 +568,7 @@ VS -> text "vs" -- Overflow ; Unordered (at least one NaN operand) VC -> text "vc" -- No overflow ; Not unordered - -- Orderd variants. Respecting NaN.+ -- Ordered variants. Respecting NaN. OLT -> text "mi" OLE -> text "ls" OGE -> text "ge"
compiler/GHC/CmmToAsm/BlockLayout.hs view
@@ -758,7 +758,7 @@ -- builds if something slips through. assert (null unplaced) $ --pprTraceIt "placedBlocks" $- -- ++ [] is stil kinda expensive+ -- ++ [] is still kinda expensive if null unplaced then blockList else blockList ++ unplaced getBlock bid = expectJust "Block placement" $ mapLookup bid blockMap in
compiler/GHC/CmmToAsm/CFG.hs view
@@ -219,7 +219,7 @@ -- | Check if the nodes in the cfg and the set of blocks are the same.--- In a case of a missmatch we panic and show the difference.+-- In a case of a mismatch we panic and show the difference. sanityCheckCfg :: CFG -> LabelSet -> SDoc -> Bool sanityCheckCfg m blockSet msg | blockSet == cfgNodes@@ -307,7 +307,7 @@ -- Create a unification variable for each of the nodes in a rewrite cuts_vars <- traverse (\p -> (p,) <$> fresh (Just p)) (concatMap (\(a, b) -> [a] ++ maybe [] (:[]) b) cuts_list) let cuts_map = mapFromList cuts_vars :: LabelMap (Point s (Maybe BlockId))- -- Then unify according the the rewrites in the cuts map+ -- Then unify according to the rewrites in the cuts map mapM_ (\(from, to) -> expectJust "shortcutWeightMap" (mapLookup from cuts_map) `union` expectJust "shortcutWeightMap" (maybe (Just null) (flip mapLookup cuts_map) to) ) cuts_list -- Then recover the unique representative, which is the result of following@@ -414,11 +414,11 @@ getEdgeWeight :: CFG -> BlockId -> BlockId -> EdgeWeight getEdgeWeight cfg from to =- edgeWeight $ expectJust "Edgeweight for noexisting block" $+ edgeWeight $ expectJust "Edgeweight for nonexisting block" $ getEdgeInfo from to cfg getTransitionSource :: BlockId -> BlockId -> CFG -> TransitionSource-getTransitionSource from to cfg = transitionSource $ expectJust "Source info for noexisting block" $+getTransitionSource from to cfg = transitionSource $ expectJust "Source info for nonexisting block" $ getEdgeInfo from to cfg reverseEdges :: CFG -> CFG@@ -660,7 +660,7 @@ (CmmCall { cml_cont = Nothing }) -> [] other -> panic "Foo" $- assertPpr False (ppr "Unknown successor cause:" <>+ assertPpr False (text "Unknown successor cause:" <> (pdoc platform branch <+> text "=>" <> pdoc platform (G.successors other))) $ map (\x -> ((bid,x),mkEdgeInfo 0)) $ G.successors other where@@ -1020,11 +1020,11 @@ loops (lehPredicts) and one to predict that backedges are more likely than any other edge. -The back edge case is special as it superceeds any other heuristic if it+The back edge case is special as it supersedes any other heuristic if it applies. Do NOT rely solely on nofib results for benchmarking this. I recommend at least-comparing megaparsec and container benchmarks. Nofib does not seeem to have+comparing megaparsec and container benchmarks. Nofib does not seem to have many instances of "loopy" Cmm where these make a difference. TODO:
compiler/GHC/CmmToAsm/CFG/Dominators.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE BangPatterns #-}+{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE Strict #-}@@ -526,10 +527,9 @@ ----------------------------------------------------------------------------- --- Nothing better than reinvinting the state monad.+-- Nothing better than reinventing the state monad. newtype S z s a = S {unS :: forall o. (a -> s -> ST z o) -> s -> ST z o}-instance Functor (S z s) where- fmap f (S g) = S (\k -> g (k . f))+ deriving (Functor) instance Monad (S z s) where return = pure S g >>= f = S (\k -> g (\a -> unS (f a) k))
compiler/GHC/CmmToAsm/CPrim.hs view
@@ -87,7 +87,7 @@ atomicRMWLabel :: Width -> AtomicMachOp -> FastString atomicRMWLabel w amop = case amop of -- lots of boring cases, but we do it this way to get shared FastString- -- literals (compared to concatening strings and allocating FastStrings at+ -- literals (compared to concatenating strings and allocating FastStrings at -- runtime) AMO_Add -> case w of W8 -> fsLit "hs_atomic_add8"
compiler/GHC/CmmToAsm/Monad.hs view
@@ -1,5 +1,7 @@ {-# LANGUAGE DeriveFunctor #-}-{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE ViewPatterns #-} -- ----------------------------------------------------------------------------- --@@ -20,7 +22,6 @@ addImmediateSuccessorNat, updateCfgNat, getUniqueNat,- mapAccumLNat, setDeltaNat, getConfig, getPlatform,@@ -32,7 +33,6 @@ getPicBaseMaybeNat, getPicBaseNat, getCfgWeights,- getModLoc, getFileId, getDebugBlock, @@ -67,10 +67,9 @@ import GHC.Types.Unique ( Unique ) import GHC.Unit.Module -import Control.Monad ( ap )- import GHC.Utils.Outputable (SDoc, ppr) import GHC.Utils.Panic (pprPanic)+import GHC.Utils.Monad.State.Strict (State (..), runState, state) import GHC.Utils.Misc import GHC.CmmToAsm.CFG import GHC.CmmToAsm.CFG.Weight@@ -111,7 +110,6 @@ natm_imports :: [(CLabel)], natm_pic :: Maybe Reg, natm_config :: NCGConfig,- natm_modloc :: ModLocation, natm_fileid :: DwarfFiles, natm_debug_map :: LabelMap DebugBlock, natm_cfg :: CFG@@ -122,38 +120,35 @@ type DwarfFiles = UniqFM FastString (FastString, Int) -newtype NatM result = NatM (NatM_State -> (result, NatM_State))- deriving (Functor)+newtype NatM a = NatM' (State NatM_State a)+ deriving stock (Functor)+ deriving (Applicative, Monad) via State NatM_State +pattern NatM :: (NatM_State -> (a, NatM_State)) -> NatM a+pattern NatM f <- NatM' (runState -> f)+ where NatM f = NatM' (state f)+{-# COMPLETE NatM #-}+ unNat :: NatM a -> NatM_State -> (a, NatM_State) unNat (NatM a) = a -mkNatM_State :: UniqSupply -> Int -> NCGConfig -> ModLocation ->+mkNatM_State :: UniqSupply -> Int -> NCGConfig -> DwarfFiles -> LabelMap DebugBlock -> CFG -> NatM_State mkNatM_State us delta config- = \loc dwf dbg cfg ->+ = \dwf dbg cfg -> NatM_State { natm_us = us , natm_delta = delta , natm_imports = [] , natm_pic = Nothing , natm_config = config- , natm_modloc = loc , natm_fileid = dwf , natm_debug_map = dbg , natm_cfg = cfg } initNat :: NatM_State -> NatM a -> (a, NatM_State)-initNat init_st m- = case unNat m init_st of { (r,st) -> (r,st) }--instance Applicative NatM where- pure = returnNat- (<*>) = ap--instance Monad NatM where- (>>=) = thenNat+initNat = flip unNat instance MonadUnique NatM where getUniqueSupplyM = NatM $ \st ->@@ -164,27 +159,6 @@ case takeUniqFromSupply (natm_us st) of (uniq, us') -> (uniq, st {natm_us = us'}) -thenNat :: NatM a -> (a -> NatM b) -> NatM b-thenNat expr cont- = NatM $ \st -> case unNat expr st of- (result, st') -> unNat (cont result) st'--returnNat :: a -> NatM a-returnNat result- = NatM $ \st -> (result, st)--mapAccumLNat :: (acc -> x -> NatM (acc, y))- -> acc- -> [x]- -> NatM (acc, [y])--mapAccumLNat _ b []- = return (b, [])-mapAccumLNat f b (x:xs)- = do (b__2, x__2) <- f b x- (b__3, xs__2) <- mapAccumLNat f b__2 xs- return (b__3, x__2:xs__2)- getUniqueNat :: NatM Unique getUniqueNat = NatM $ \ st -> case takeUniqFromSupply $ natm_us st of@@ -244,9 +218,7 @@ getBlockIdNat :: NatM BlockId getBlockIdNat- = do u <- getUniqueNat- return (mkBlockId u)-+ = mkBlockId <$> getUniqueNat getNewLabelNat :: NatM CLabel getNewLabelNat@@ -308,10 +280,6 @@ -> do reg <- getNewRegNat rep NatM (\state -> (reg, state { natm_pic = Just reg }))--getModLoc :: NatM ModLocation-getModLoc- = NatM $ \ st -> (natm_modloc st, st) -- | Get native code generator configuration getConfig :: NatM NCGConfig
compiler/GHC/CmmToAsm/PPC/CodeGen.hs view
@@ -2145,7 +2145,7 @@ -- See Note [Sub-word subtlety during jump-table indexing] in -- GHC.CmmToAsm.X86.CodeGen for why we must first offset, then widen. indexExpr0 = cmmOffset platform expr offset- -- We widen to a native-width register to santize the high bits+ -- We widen to a native-width register to sanitize the high bits indexExpr = CmmMachOp (MO_UU_Conv expr_w (platformWordWidth platform)) [indexExpr0]
compiler/GHC/CmmToAsm/Reg/Graph.hs view
@@ -355,8 +355,8 @@ in graph2 --- | Add some coalesence edges to the graph--- Coalesences between virtual and real regs are recorded as preferences.+-- | Add some coalescence edges to the graph+-- Coalescences between virtual and real regs are recorded as preferences. graphAddCoalesce :: (Reg, Reg) -> Color.Graph VirtualReg RegClass RealReg
compiler/GHC/CmmToAsm/Reg/Graph/Base.hs view
@@ -109,7 +109,7 @@ $ powersetLS regsC -- for each of the subsets of C, the regs which conflict- -- with posiblities for N+ -- with possibilities for N regsS_conflict = map (\s -> intersectUniqSets regsN (regAliasS s)) regsS
compiler/GHC/CmmToAsm/Reg/Graph/TrivColorable.hs view
@@ -109,7 +109,7 @@ ArchPPC -> 16 ArchPPC_64 _ -> 15 ArchARM _ _ _ -> panic "trivColorable ArchARM"- -- We should be able to allocate *a lot* more in princple.+ -- We should be able to allocate *a lot* more in principle. -- essentially all 32 - SP, so 31, we'd trash the link reg -- as well as the platform and all others though. ArchAArch64 -> 18@@ -142,7 +142,7 @@ ArchPPC -> 0 ArchPPC_64 _ -> 0 ArchARM _ _ _ -> panic "trivColorable ArchARM"- -- we can in princple address all the float regs as+ -- we can in principle address all the float regs as -- segments. So we could have 64 Float regs. Or -- 128 Half regs, or even 256 Byte regs. ArchAArch64 -> 0
compiler/GHC/CmmToAsm/Reg/Linear.hs view
@@ -595,7 +595,7 @@ -- we need to ensure they are emitted in the correct order. We used to only -- emit single instructions in mkSpill/mkReload/mkRegRegMove. -- As such order of spills and reloads didn't matter. However, with- -- mutliple instructions potentially issued by those functions we need to be+ -- multiple instructions potentially issued by those functions we need to be -- careful to not break execution order. Reversing the spills (clobber will -- also spill), will ensure they are emitted in the right order. --@@ -618,7 +618,7 @@ ] -- pprTrace "patched-code" ((vcat $ map (docToSDoc . pprInstr) code)) $ do--- pprTrace "pached-fixup" ((ppr fixup_blocks)) $ do+-- pprTrace "patched-fixup" ((ppr fixup_blocks)) $ do return (code, fixup_blocks)
compiler/GHC/CmmToAsm/Reg/Linear/AArch64.hs view
@@ -35,7 +35,7 @@ -- | - Operates on 32-bit | - Separate reg. bank, | - Separate reg. bank, | -- | GP ARM registers | 32x64-bit NEON regs | 32x128-bit NEON regs | -- | - 8-bit/16-bit integer | - 8/16/32/64-bit int | - 8/16/32/64-bit int |--- | | - Single percision fp | - Single percision fp |+-- | | - Single precision fp | - Single precision fp | -- | | | - Double precision fp | -- | | | - Single/Double fp are | -- | | | IEEE compliant |
compiler/GHC/CmmToAsm/Reg/Liveness.hs view
@@ -67,7 +67,7 @@ import GHC.Data.Bag import GHC.Utils.Monad.State.Strict -import Data.List (mapAccumL, groupBy, partition)+import Data.List (mapAccumL, partition) import Data.Maybe import Data.IntSet (IntSet) @@ -911,13 +911,11 @@ -> a -> b -> (a,c) - iterateUntilUnchanged f eq a b- = head $- concatMap tail $- groupBy (\(a1, _) (a2, _) -> eq a1 a2) $- iterate (\(a, _) -> f a b) $- (a, panic "RegLiveness.livenessSCCs")-+ iterateUntilUnchanged f eq aa b = go aa+ where+ go a = if eq a a' then ac else go a'+ where+ ac@(a', _) = f a b linearLiveness :: Instruction instr
compiler/GHC/CmmToAsm/X86/CodeGen.hs view
@@ -2015,10 +2015,10 @@ -- Use ASSERT so we don't break releases if -- LTT/LE creep in somehow. LTT ->- assertPpr False (ppr "Should have been turned into >")+ assertPpr False (text "Should have been turned into >") and_ordered LE ->- assertPpr False (ppr "Should have been turned into >=")+ assertPpr False (text "Should have been turned into >=") and_ordered _ -> and_ordered @@ -3068,7 +3068,7 @@ -- ja _c2g2 -- jmp _c2g1 ----- Removing the jump reduces the pressure on the branch predidiction system+-- Removing the jump reduces the pressure on the branch prediction system -- and plays better with the uOP cache. condFltReg :: Bool -> Cond -> CmmExpr -> CmmExpr -> NatM Register@@ -3088,9 +3088,9 @@ GU -> plain_test dst GEU -> plain_test dst -- Use ASSERT so we don't break releases if these creep in.- LTT -> assertPpr False (ppr "Should have been turned into >") $+ LTT -> assertPpr False (text "Should have been turned into >") $ and_ordered dst- LE -> assertPpr False (ppr "Should have been turned into >=") $+ LE -> assertPpr False (text "Should have been turned into >=") $ and_ordered dst _ -> and_ordered dst)
compiler/GHC/CmmToC.hs view
@@ -1,6 +1,9 @@ {-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DerivingVia #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-}+{-# LANGUAGE PatternSynonyms #-}+{-# LANGUAGE ViewPatterns #-} ----------------------------------------------------------------------------- --@@ -48,6 +51,7 @@ import GHC.Utils.Outputable import GHC.Utils.Panic+import GHC.Utils.Monad.State.Strict (State (..), runState, state) import GHC.Utils.Misc import GHC.Utils.Trace @@ -55,9 +59,9 @@ import qualified Data.ByteString as BS import Data.Char import Data.List (intersperse)+import Data.List.NonEmpty (NonEmpty (..)) import Data.Map (Map) import qualified Data.Map as Map-import Control.Monad (ap) import GHC.Float -- --------------------------------------------------------------------------@@ -130,7 +134,7 @@ -- BasicBlocks are self-contained entities: they always end in a jump. -- -- Like nativeGen/AsmCodeGen, we could probably reorder blocks to turn--- as many jumps as possible into fall throughs.+-- as many jumps as possible into fallthroughs. -- pprBBlock :: Platform -> CmmBlock -> SDoc@@ -248,7 +252,7 @@ -- can't add the @n suffix ourselves, because -- it isn't valid C. | CmmNeverReturns <- ret ->- pprCall platform cast_fn cconv hresults hargs <> semi+ pprCall platform cast_fn cconv hresults hargs <> semi <> text "__builtin_unreachable();" | not (isMathFun lbl) -> pprForeignCall platform (pprCLabel platform CStyle lbl) cconv hresults hargs _ ->@@ -344,7 +348,7 @@ rep = typeWidth (cmmExprType platform e) -- fall through case- caseify (ix:ixs, ident) = vcat (map do_fallthrough ixs) $$ final_branch ix+ caseify (ix:|ixs, ident) = vcat (map do_fallthrough ixs) $$ final_branch ix where do_fallthrough ix = hsep [ text "case" , pprHexVal platform ix rep <> colon ,@@ -354,8 +358,6 @@ hsep [ text "case" , pprHexVal platform ix rep <> colon , text "goto" , (pprBlockId ident) <> semi ] - caseify (_ , _ ) = panic "pprSwitch: switch with no cases!"- def | Just l <- mbdef = text "default: goto" <+> pprBlockId l <> semi | otherwise = text "default: __builtin_unreachable();" @@ -853,7 +855,7 @@ (panic $ "PprC.pprMachOp_for_C: MO_VF_Quot" ++ " should have been handled earlier!") - MO_AlignmentCheck {} -> panic "-falignment-santisation not supported by unregisterised backend"+ MO_AlignmentCheck {} -> panic "-falignment-sanitisation not supported by unregisterised backend" signedOp :: MachOp -> Bool -- Argument type(s) are signed ints signedOp (MO_S_Quot _) = True@@ -967,39 +969,37 @@ -- Not adding it for now (MO_Prefetch_Data _ ) -> unsupported - MO_I64_ToI -> dontReach64- MO_I64_FromI -> dontReach64- MO_W64_ToW -> dontReach64- MO_W64_FromW -> dontReach64- MO_x64_Neg -> dontReach64- MO_x64_Add -> dontReach64- MO_x64_Sub -> dontReach64- MO_x64_Mul -> dontReach64- MO_I64_Quot -> dontReach64- MO_I64_Rem -> dontReach64- MO_W64_Quot -> dontReach64- MO_W64_Rem -> dontReach64- MO_x64_And -> dontReach64- MO_x64_Or -> dontReach64- MO_x64_Xor -> dontReach64- MO_x64_Not -> dontReach64- MO_x64_Shl -> dontReach64- MO_I64_Shr -> dontReach64- MO_W64_Shr -> dontReach64- MO_x64_Eq -> dontReach64- MO_x64_Ne -> dontReach64- MO_I64_Ge -> dontReach64- MO_I64_Gt -> dontReach64- MO_I64_Le -> dontReach64- MO_I64_Lt -> dontReach64- MO_W64_Ge -> dontReach64- MO_W64_Gt -> dontReach64- MO_W64_Le -> dontReach64- MO_W64_Lt -> dontReach64+ MO_I64_ToI -> text "hs_int64ToInt"+ MO_I64_FromI -> text "hs_intToInt64"+ MO_W64_ToW -> text "hs_word64ToWord"+ MO_W64_FromW -> text "hs_wordToWord64"+ MO_x64_Neg -> text "hs_neg64"+ MO_x64_Add -> text "hs_add64"+ MO_x64_Sub -> text "hs_sub64"+ MO_x64_Mul -> text "hs_mul64"+ MO_I64_Quot -> text "hs_quotInt64"+ MO_I64_Rem -> text "hs_remInt64"+ MO_W64_Quot -> text "hs_quotWord64"+ MO_W64_Rem -> text "hs_remWord64"+ MO_x64_And -> text "hs_and64"+ MO_x64_Or -> text "hs_or64"+ MO_x64_Xor -> text "hs_xor64"+ MO_x64_Not -> text "hs_not64"+ MO_x64_Shl -> text "hs_uncheckedShiftL64"+ MO_I64_Shr -> text "hs_uncheckedIShiftRA64"+ MO_W64_Shr -> text "hs_uncheckedShiftRL64"+ MO_x64_Eq -> text "hs_eq64"+ MO_x64_Ne -> text "hs_ne64"+ MO_I64_Ge -> text "hs_geInt64"+ MO_I64_Gt -> text "hs_gtInt64"+ MO_I64_Le -> text "hs_leInt64"+ MO_I64_Lt -> text "hs_ltInt64"+ MO_W64_Ge -> text "hs_geWord64"+ MO_W64_Gt -> text "hs_gtWord64"+ MO_W64_Le -> text "hs_leWord64"+ MO_W64_Lt -> text "hs_ltWord64" where unsupported = panic ("pprCallishMachOp_for_C: " ++ show mop ++ " not supported!")- dontReach64 = panic ("pprCallishMachOp_for_C: " ++ show mop- ++ " should be not be encountered because the regular primop for this 64-bit operation is used instead.") -- --------------------------------------------------------------------- -- Useful #defines@@ -1236,14 +1236,14 @@ <> semi type TEState = (UniqSet LocalReg, Map CLabel ())-newtype TE a = TE { unTE :: TEState -> (a, TEState) } deriving (Functor)--instance Applicative TE where- pure a = TE $ \s -> (a, s)- (<*>) = ap+newtype TE a = TE' (State TEState a)+ deriving stock (Functor)+ deriving (Applicative, Monad) via State TEState -instance Monad TE where- TE m >>= k = TE $ \s -> case m s of (a, s') -> unTE (k a) s'+pattern TE :: (TEState -> (a, TEState)) -> TE a+pattern TE f <- TE' (runState -> f)+ where TE f = TE' (state f)+{-# COMPLETE TE #-} te_lbl :: CLabel -> TE () te_lbl lbl = TE $ \(temps,lbls) -> ((), (temps, Map.insert lbl () lbls))
compiler/GHC/CmmToLlvm.hs view
@@ -11,7 +11,7 @@ ) where -import GHC.Prelude+import GHC.Prelude hiding ( head ) import GHC.Llvm import GHC.CmmToLlvm.Base@@ -37,6 +37,7 @@ import qualified GHC.Data.Stream as Stream import Control.Monad ( when, forM_ )+import Data.List.NonEmpty ( head ) import Data.Maybe ( fromMaybe, catMaybes ) import System.IO @@ -68,7 +69,7 @@ "System LLVM version: " <> text (llvmVersionStr ver) $$ "We will try though..." let isS390X = platformArch (llvmCgPlatform cfg) == ArchS390X- let major_ver = head . llvmVersionList $ ver+ let major_ver = head . llvmVersionNE $ ver when (isS390X && major_ver < 10 && doWarn) $ putMsg logger $ "Warning: For s390x the GHC calling convention is only supported since LLVM version 10." <+> "You are using LLVM version: " <> text (llvmVersionStr ver)
compiler/GHC/CmmToLlvm/Base.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DerivingVia #-} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} @@ -57,8 +58,9 @@ import GHC.Utils.Logger import Data.Maybe (fromJust)-import Control.Monad (ap)-import Data.List (sortBy, groupBy, isPrefixOf)+import Control.Monad.Trans.State (StateT (..))+import Data.List (isPrefixOf)+import qualified Data.List.NonEmpty as NE import Data.Ord (comparing) -- ----------------------------------------------------------------------------@@ -191,7 +193,7 @@ -- set of real registers to be passed. E.g. FloatReg, DoubleReg and XmmReg -- all use the same real regs on X86-64 (XMM registers). --- classes = groupBy sharesClass fprLive+ classes = NE.groupBy sharesClass fprLive sharesClass a b = regsOverlap platform (norm a) (norm b) -- check if mapped to overlapping registers norm x = CmmGlobal ((fpr_ctor x) 1) -- get the first register of the family @@ -201,10 +203,10 @@ -- E.g. sortedRs = [ F2, XMM4, D5] -- output = [D1, D3] padded = concatMap padClass classes- padClass rs = go sortedRs [1..]+ padClass rs = go (NE.toList sortedRs) 1 where- sortedRs = sortBy (comparing fpr_num) rs- maxr = last sortedRs+ sortedRs = NE.sortBy (comparing fpr_num) rs+ maxr = NE.last sortedRs ctor = fpr_ctor maxr go [] _ = []@@ -215,10 +217,9 @@ text "Found two different Cmm registers (" <> ppr c1 <> text "," <> ppr c2 <> text ") both alive AND mapped to the same real register: " <> ppr real <> text ". This isn't currently supported by the LLVM backend."- go (c:cs) (f:fs)- | fpr_num c == f = go cs fs -- already covered by a real register- | otherwise = ctor f : go (c:cs) fs -- add padding register- go _ _ = undefined -- unreachable+ go (c:cs) f+ | fpr_num c == f = go cs f -- already covered by a real register+ | otherwise = ctor f : go (c:cs) (f + 1) -- add padding register fpr_ctor :: GlobalReg -> Int -> GlobalReg fpr_ctor (FloatReg _) = FloatReg@@ -275,15 +276,8 @@ -- | The Llvm monad. Wraps @LlvmEnv@ state as well as the @IO@ monad newtype LlvmM a = LlvmM { runLlvmM :: LlvmEnv -> IO (a, LlvmEnv) }- deriving (Functor)--instance Applicative LlvmM where- pure x = LlvmM $ \env -> return (x, env)- (<*>) = ap--instance Monad LlvmM where- m >>= f = LlvmM $ \env -> do (x, env') <- runLlvmM m env- runLlvmM (f x) env'+ deriving stock (Functor)+ deriving (Applicative, Monad) via StateT LlvmEnv IO instance HasLogger LlvmM where getLogger = LlvmM $ \env -> return (envLogger env, env)@@ -447,7 +441,7 @@ ctx <- llvmCgContext <$> getConfig platform <- getPlatform let sdoc = pprCLabel platform CStyle lbl- str = Outp.renderWithContext ctx sdoc+ str = Outp.showSDocOneLine ctx sdoc return (fsLit str) -- ----------------------------------------------------------------------------
compiler/GHC/CmmToLlvm/CodeGen.hs view
@@ -758,7 +758,7 @@ let (vars', stmts) = unzip done return (vars', toOL stmts) --- | Cast an LLVM variable to a specific type, panicing if it can't be done.+-- | Cast an LLVM variable to a specific type, panicking if it can't be done. castVar :: Signage -> LlvmVar -> LlvmType -> LlvmM (LlvmVar, LlvmStatement) castVar signage v t | getVarType v == t = return (v, Nop)@@ -1203,10 +1203,10 @@ other -> pprPanic "genStore: ptr not right type!"- (pdoc platform addr <+> text (- "Size of Ptr: " ++ show (llvmPtrBits platform) ++- ", Size of var: " ++ show (llvmWidthInBits platform other) ++- ", Var: " ++ renderWithContext (llvmCgContext cfg) (ppVar cfg vaddr)))+ (pdoc platform addr $$+ text "Size of Ptr:" <+> ppr (llvmPtrBits platform) $$+ text "Size of var:" <+> ppr (llvmWidthInBits platform other) $$+ text "Var:" <+> ppVar cfg vaddr) mkStore :: LlvmVar -> LlvmVar -> AlignmentSpec -> LlvmStatement mkStore vval vptr alignment =@@ -1255,7 +1255,7 @@ lit = LMLitVar $ LMIntLit expLit expTy llvmExpectName- | isInt expTy = fsLit $ "llvm.expect." ++ renderWithContext (llvmCgContext cfg) (ppr expTy)+ | isInt expTy = fsLit $ "llvm.expect." ++ showSDocOneLine (llvmCgContext cfg) (ppr expTy) | otherwise = panic "genExpectedLit: Type not an int!" (llvmExpect, stmts, top) <-@@ -1874,10 +1874,10 @@ doExprW (cmmToLlvmType ty) (MExpr meta $ mkLoad atomic ptr align) other -> pprPanic "exprToVar: CmmLoad expression is not right type!"- (pdoc platform e <+> text (- "Size of Ptr: " ++ show (llvmPtrBits platform) ++- ", Size of var: " ++ show (llvmWidthInBits platform other) ++- ", Var: " ++ renderWithContext (llvmCgContext cfg) (ppVar cfg iptr)))+ (pdoc platform e $$+ text "Size of Ptr:" <+> ppr (llvmPtrBits platform) $$+ text "Size of var:" <+> ppr (llvmWidthInBits platform other) $$+ text "Var:" <+> (ppVar cfg iptr)) {- Note [Alignment of vector-typed values]
compiler/GHC/CmmToLlvm/Ppr.hs view
@@ -56,7 +56,7 @@ funDec <- llvmFunSig live lbl link cfg <- getConfig platform <- getPlatform- let buildArg = fsLit . renderWithContext (llvmCgContext cfg). ppPlainName cfg+ let buildArg = fsLit . showSDocOneLine (llvmCgContext cfg). ppPlainName cfg funArgs = map buildArg (llvmFunArgs platform live) funSect = llvmFunSection cfg (decName funDec)
compiler/GHC/Core/Opt/CSE.hs view
@@ -19,7 +19,7 @@ import GHC.Types.Id ( Id, idType, idHasRules, zapStableUnfolding , idInlineActivation, setInlineActivation , zapIdOccInfo, zapIdUsageInfo, idInlinePragma- , isJoinId, isJoinId_maybe )+ , isJoinId, isJoinId_maybe, idUnfolding ) import GHC.Core.Utils ( mkAltExpr , exprIsTickedString , stripTicksE, stripTicksT, mkTicks )@@ -144,7 +144,7 @@ the binding instead? Well, not at top level! See Note [Top level and postInlineUnconditionally] in GHC.Core.Opt.Simplify.Utils; and in any case CSE applies only to the /bindings/ of the program, and we leave-it to the simplifier to propate effects to the RULES. Finally, it+it to the simplifier to propagate effects to the RULES. Finally, it doesn't seem worth the effort to discard the nested bindings because the simplifier will do it next. @@ -228,7 +228,7 @@ might replace <rhs> by 'bar', and then later be unable to see that it really was <rhs>. -An except to the rule is when the INLINE pragma is not from the user, e.g. from+An exception to the rule is when the INLINE pragma is not from the user, e.g. from WorkWrap (see Note [Wrapper activation]). We can tell because noUserInlineSpec is then true. @@ -262,28 +262,32 @@ but now bar's inlining behaviour will change, and importing modules might see that. So it seems dodgy and we don't do it. -Stable unfoldings are also created during worker/wrapper when we decide-that a function's definition is so small that it should always inline.-In this case we still want to do CSE (#13340). Hence the use of-isAnyInlinePragma rather than isStableUnfolding.+Wrinkles -Now consider- foo = <expr>- bar {-# Unf = Stable ... #-}- = <expr>+* Stable unfoldings are also created during worker/wrapper when we+ decide that a function's definition is so small that it should+ always inline, or indeed for the wrapper function itself. In this+ case we still want to do CSE (#13340). Hence the use of+ isStableUserUnfolding/isStableSystemUnfolding rather than+ isStableUnfolding. -where the unfolding was added by strictness analysis, say. Then-CSE goes ahead, so we get- bar = foo-and probably use SUBSTITUTE that will make 'bar' dead. But just-possibly not -- see Note [Dealing with ticks]. In that case we might-be left with- bar = tick t1 (tick t2 foo)-in which case we would really like to get rid of the stable unfolding-(generated by the strictness analyser, say). Hence the zapStableUnfolding-in cse_bind. Not a big deal, and only makes a difference when ticks-get into the picture.+* Consider+ foo = <expr>+ bar {-# Unf = Stable ... #-}+ = <expr>+ where the unfolding was added by strictness analysis, say. Then+ CSE goes ahead, so we get+ bar = foo+ and probably use SUBSTITUTE that will make 'bar' dead. But just+ possibly not -- see Note [Dealing with ticks]. In that case we might+ be left with+ bar = tick t1 (tick t2 foo)+ in which case we would really like to get rid of the stable unfolding+ (generated by the strictness analyser, say). + Hence the zapStableUnfolding in cse_bind. Not a big deal, and only+ makes a difference when ticks get into the picture.+ Note [Corner case for case expressions] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Here is another reason that we do not use SUBSTITUTE for@@ -356,7 +360,7 @@ Note [Separate envs for let rhs and body] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-Substituting occurances of the binder in the rhs with the+Substituting occurrences of the binder in the rhs with the renamed binder is wrong for non-recursive bindings. Why? Consider this core. @@ -508,14 +512,17 @@ -- | Given a binder `let x = e`, this function -- determines whether we should add `e -> x` to the cs_map noCSE :: InId -> Bool-noCSE id = not (isAlwaysActive (idInlineActivation id)) &&- not (noUserInlineSpec (inlinePragmaSpec (idInlinePragma id)))- -- See Note [CSE for INLINE and NOINLINE]- || isAnyInlinePragma (idInlinePragma id)- -- See Note [CSE for stable unfoldings]- || isJoinId id- -- See Note [CSE for join points?]-+noCSE id+ | isJoinId id = no_cse -- See Note [CSE for join points?]+ | isStableUserUnfolding unf = no_cse -- See Note [CSE for stable unfoldings]+ | user_activation_control = no_cse -- See Note [CSE for INLINE and NOINLINE]+ | otherwise = yes_cse+ where+ unf = idUnfolding id+ user_activation_control = not (isAlwaysActive (idInlineActivation id))+ && not (noUserInlineSpec (inlinePragmaSpec (idInlinePragma id)))+ yes_cse = False+ no_cse = True {- Note [Take care with literal strings] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
compiler/GHC/Core/Opt/CallArity.hs view
@@ -150,7 +150,7 @@ any useful co-call information. Return (fv e)² * Case alternatives alt₁,alt₂,...:- Only one can be execuded, so+ Only one can be executed, so Return (alt₁ ∪ alt₂ ∪...) * App e₁ e₂ (and analogously Case scrut alts), with non-trivial e₂: We get the results from both sides, with the argument evaluated at most once.@@ -277,7 +277,7 @@ Note [Analysis type signature] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -The work-hourse of the analysis is the function `callArityAnal`, with the+The workhorse of the analysis is the function `callArityAnal`, with the following type: type CallArityRes = (UnVarGraph, VarEnv Arity)
compiler/GHC/Core/Opt/DmdAnal.hs view
@@ -59,9 +59,18 @@ -- | Options for the demand analysis data DmdAnalOpts = DmdAnalOpts- { dmd_strict_dicts :: !Bool -- ^ Use strict dictionaries- , dmd_unbox_width :: !Int -- ^ Use strict dictionaries+ { dmd_strict_dicts :: !Bool+ -- ^ Value of `-fdicts-strict` (on by default).+ -- When set, all functons are implicitly strict in dictionary args.+ , dmd_do_boxity :: !Bool+ -- ^ Governs whether the analysis should update boxity signatures.+ -- See Note [Don't change boxity without worker/wrapper].+ , dmd_unbox_width :: !Int+ -- ^ Value of `-fdmd-unbox-width`.+ -- See Note [Unboxed demand on function bodies returning small products] , dmd_max_worker_args :: !Int+ -- ^ Value of `-fmax-worker-args`.+ -- Don't unbox anything if we end up with more than this many args. } -- This is a strict alternative to (,)@@ -146,6 +155,40 @@ most memory-intensive part of the compilation process, so this added seqBinds makes a big difference in peak memory usage. +Note [Don't change boxity without worker/wrapper]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+Consider (T21754)+ f n = n+1+ {-# NOINLINE f #-}+With `-fno-worker-wrapper`, we should not give `f` a boxity signature that says+that it unboxes its argument! Client modules would never be able to cancel away+the box for n. Likewise we shouldn't give `f` the CPR property.++Similarly, in the last run of DmdAnal before codegen (which does not have a+worker/wrapper phase) we should not change boxity in any way. Remember: an+earlier result of the demand analyser, complete with worker/wrapper, has aleady+given a demand signature (with boxity info) to the function.+(The "last run" is mainly there to attach demanded-once info to let-bindings.)++In general, we should not run Note [Boxity analysis] unless worker/wrapper+follows to exploit the boxity and make sure that calling modules can observe the+reported boxity.++Hence DmdAnal is configured by a flag `dmd_do_boxity` that is True only+if worker/wrapper follows after DmdAnal. If it is not set, and the signature+is not subject to Note [Boxity for bottoming functions], DmdAnal tries+to transfer over the previous boxity to the new demand signature, in+`setIdDmdAndBoxSig`.++Why isn't CprAnal configured with a similar flag? Because if we aren't going to+do worker/wrapper we don't run CPR analysis at all. (see GHC.Core.Opt.Pipeline)++It might be surprising that we only try to preserve *arg* boxity, not boxity on+FVs. But FV demands won't make it into interface files anyway, so it's a waste+of energy.+Besides, W/W zaps the `DmdEnv` portion of a signature, so we don't know the old+boxity to begin with; see Note [Zapping DmdEnv after Demand Analyzer].+ Note [Analysing top-level bindings] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider a CoreProgram like@@ -157,7 +200,7 @@ where e* are exported, but n* are not. Intuitively, we can see that @n1@ is only ever called with two arguments and in every call site, the first component of the result of the call-is evaluated. Thus, we'd like it to have idDemandInfo @LCL(CM(P(1L,A))@.+is evaluated. Thus, we'd like it to have idDemandInfo @LC(L,C(M,P(1L,A))@. NB: We may *not* give e2 a similar annotation, because it is exported and external callers might use it in arbitrary ways, expressed by 'topDmd'. This can then be exploited by Nested CPR and eta-expansion,@@ -257,6 +300,16 @@ TopLevel | not (isInterestingTopLevelFn id) -> topDmd _ -> dmd +-- | Update the demand signature, but be careful not to change boxity info if+-- `dmd_do_boxity` is True or if the signature is bottom.+-- See Note [Don't change boxity without worker/wrapper]+-- and Note [Boxity for bottoming functions].+setIdDmdAndBoxSig :: DmdAnalOpts -> Id -> DmdSig -> Id+setIdDmdAndBoxSig opts id sig = setIdDmdSig id $+ if dmd_do_boxity opts || isBottomingSig sig+ then sig+ else transferArgBoxityDmdSig (idDmdSig id) sig+ -- | Let bindings can be processed in two ways: -- Down (RHS before body) or Up (body before RHS). -- This function handles the up variant.@@ -362,7 +415,7 @@ -- and Note [Analysing with absent demand] = (toPlusDmdArg $ multDmdType n' dmd_ty, e') --- Main Demand Analsysis machinery+-- Main Demand Analysis machinery dmdAnal, dmdAnal' :: AnalEnv -> SubDemand -- The main one takes a *SubDemand* -> CoreExpr -> WithDmdType CoreExpr@@ -455,8 +508,9 @@ !(!bndrs', !scrut_sd) | DataAlt _ <- alt_con -- See Note [Demand on the scrutinee of a product case]+ , let !scrut_sd = scrutSubDmd case_bndr_sd fld_dmds -- See Note [Demand on case-alternative binders]- , (!scrut_sd, fld_dmds') <- addCaseBndrDmd case_bndr_sd fld_dmds+ , let !fld_dmds' = fieldBndrDmds scrut_sd (length fld_dmds) , let !bndrs' = setBndrsDemandInfo bndrs fld_dmds' = (bndrs', scrut_sd) | otherwise@@ -560,7 +614,6 @@ = False dmdAnalSumAlts :: AnalEnv -> SubDemand -> Id -> [CoreAlt] -> WithDmdType [CoreAlt]- dmdAnalSumAlts _ _ _ [] = WithDmdType botDmdType [] -- Base case is botDmdType, for empty case alternatives -- This is a unit for lubDmdType, and the right result@@ -580,29 +633,30 @@ -- See Note [Demand on case-alternative binders] -- we can't use the scrut_sd, because it says 'Prod' and we'll use -- topSubDmd anyway for scrutinees of sum types.- (!_scrut_sd, dmds') = addCaseBndrDmd case_bndr_sd dmds+ scrut_sd = scrutSubDmd case_bndr_sd dmds+ dmds' = fieldBndrDmds scrut_sd (length dmds) -- Do not put a thunk into the Alt !new_ids = setBndrsDemandInfo bndrs dmds' = -- pprTrace "dmdAnalSumAlt" (ppr con $$ ppr case_bndr $$ ppr dmd $$ ppr alt_ty) $ WithDmdType alt_ty (Alt con new_ids rhs') --- Precondition: The SubDemand is not a Call -- See Note [Demand on the scrutinee of a product case]--- and Note [Demand on case-alternative binders]-addCaseBndrDmd :: SubDemand -- On the case binder- -> [Demand] -- On the fields of the constructor- -> (SubDemand, [Demand])- -- SubDemand on the case binder incl. field demands- -- and final demands for the components of the constructor-addCaseBndrDmd case_sd fld_dmds- | Just (_, ds) <- viewProd (length fld_dmds) scrut_sd- -- , pprTrace "addCaseBndrDmd" (ppr case_sd $$ ppr fld_dmds $$ ppr scrut_sd) True- = (scrut_sd, ds)- | otherwise- = pprPanic "was a call demand" (ppr case_sd $$ ppr fld_dmds) -- See the Precondition- where- scrut_sd = case_sd `plusSubDmd` mkProd Unboxed fld_dmds+scrutSubDmd :: SubDemand -> [Demand] -> SubDemand+scrutSubDmd case_sd fld_dmds =+ -- pprTraceWith "scrutSubDmd" (\scrut_sd -> ppr case_sd $$ ppr fld_dmds $$ ppr scrut_sd) $+ case_sd `plusSubDmd` mkProd Unboxed fld_dmds +-- See Note [Demand on case-alternative binders]+fieldBndrDmds :: SubDemand -- on the scrutinee+ -> Arity+ -> [Demand] -- Final demands for the components of the DataCon+fieldBndrDmds scrut_sd n_flds =+ case viewProd n_flds scrut_sd of+ Just (_, ds) -> ds+ Nothing -> replicate n_flds topDmd+ -- Either an arity mismatch or scrut_sd was a call demand.+ -- See Note [Untyped demand on case-alternative binders]+ {- Note [Anticipating ANF in demand analysis] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~@@ -670,7 +724,7 @@ values are evaluated even if they are not used. Example from #9254: f :: (() -> (# Int#, () #)) -> () -- Strictness signature is- -- <1C1(P(A,1L))>+ -- <1C(1,P(A,1L))> -- I.e. calls k, but discards first component of result f k = case k () of (# _, r #) -> r @@ -830,6 +884,44 @@ This is needed even for non-product types, in case the case-binder is used but the components of the case alternative are not. +Note [Untyped demand on case-alternative binders]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+With unsafeCoerce, #8037 and #22039 taught us that the demand on the case binder+may be a call demand or have a different number of fields than the constructor+of the case alternative it is used in. From T22039:++ blarg :: (Int, Int) -> Int+ blarg (x,y) = x+y+ -- blarg :: <1!P(1L,1L)>++ f :: Either Int Int -> Int+ f Left{} = 0+ f e = blarg (unsafeCoerce e)+ ==> { desugars to }+ f = \ (ds_d1nV :: Either Int Int) ->+ case ds_d1nV of wild_X1 {+ Left ds_d1oV -> lvl_s1Q6;+ Right ipv_s1Pl ->+ blarg+ (case unsafeEqualityProof @(*) @(Either Int Int) @(Int, Int) of+ { UnsafeRefl co_a1oT ->+ wild_X1 `cast` (Sub (Sym co_a1oT) :: Either Int Int ~R# (Int, Int))+ })+ }++The case binder `e`/`wild_X1` has demand 1!P(1L,1L), with two fields, from the call+to `blarg`, but `Right` only has one field. Although the code will crash when+executed, we must be able to analyse it in 'fieldBndrDmds' and conservatively+approximate with Top instead of panicking because of the mismatch.+In #22039, this kind of code was guarded behind a safe `cast` and thus dead+code, but nevertheless led to a panic of the compiler.++You might wonder why the same problem doesn't come up when scrutinising a+product type instead of a sum type. It appears that for products, `wild_X1`+will be inlined before DmdAnal.++See also Note [mkWWstr and unsafeCoerce] for a related issue.+ Note [Aggregated demand for cardinality] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ FIXME: This Note should be named [LetUp vs. LetDown] and probably predates@@ -979,7 +1071,8 @@ sig = mkDmdSigForArity threshold_arity (DmdType sig_fv final_rhs_dmds rhs_div) - final_id = id `setIdDmdSig` sig+ opts = ae_opts env+ final_id = setIdDmdAndBoxSig opts id sig !final_env = extendAnalEnv top_lvl env final_id sig -- See Note [Aggregated demand for cardinality]@@ -1137,10 +1230,10 @@ ( B -> j 4 ) ( C -> \y. blah ) -The entire thing is in a C1(L) context, so j's strictness signature+The entire thing is in a C(1,L) context, so j's strictness signature will be [A]b meaning one absent argument, returns bottom. That seems odd because-there's a \y inside. But it's right because when consumed in a C1(L)+there's a \y inside. But it's right because when consumed in a C(1,L) context the RHS of the join point is indeed bottom. Note [Demand signatures are computed for a threshold arity based on idArity]@@ -1183,12 +1276,12 @@ then \y -> ... y ... else \y -> ... y ... -We'd analyse `f` under a unary call demand C1(L), corresponding to idArity+We'd analyse `f` under a unary call demand C(1,L), corresponding to idArity being 1. That's enough to look under the manifest lambda and find out how a unary call would use `x`, but not enough to look into the lambdas in the if branches. -On the other hand, if we analysed for call demand C1(C1(L)), we'd get useful+On the other hand, if we analysed for call demand C(1,C(1,L)), we'd get useful strictness info for `y` (and more precise info on `x`) and possibly CPR information, but @@ -1337,7 +1430,7 @@ Again we want `wombat` to pretend to take its Int-typed argument unboxed, even though it has to pass it boxed to `f`, so that `g` can take its-arugment unboxed (and rebox it before calling `wombat`).+argument unboxed (and rebox it before calling `wombat`). So here's what we do: while summarising `indexError`'s boxity signature in `finaliseArgBoxities`:@@ -1401,7 +1494,7 @@ demand analysis propagates throughout the program. Failing to implement the strategy laid out in the signature can result in reboxing in unexpected places. Hence, we must completely anticipate-unboxing decisions during demand analysis and reflect these decicions+unboxing decisions during demand analysis and reflect these decisions in demand annotations. That is the job of 'finaliseArgBoxities', which is defined here and called from demand analysis. @@ -1421,8 +1514,8 @@ Consider let x = e in body where the demand on 'x' is 1!P(blah). We want to unbox x according to-Note [Thunk splitting] in GHC.Core.Opt.WorkWrap. We must do this becuase-worker/wrapper ignores stricness and looks only at boxity flags; so if+Note [Thunk splitting] in GHC.Core.Opt.WorkWrap. We must do this because+worker/wrapper ignores strictness and looks only at boxity flags; so if x's demand is L!P(blah) we might still split it (wrongly). We want to switch to Boxed on any lazy demand. @@ -1597,31 +1690,33 @@ Note [Do not unbox class dictionaries] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-If we have- f :: Ord a => [a] -> Int -> a- {-# INLINABLE f #-}-and we worker/wrapper f, we'll get a worker with an INLINABLE pragma-(see Note [Worker/wrapper for INLINABLE functions] in GHC.Core.Opt.WorkWrap),-which can still be specialised by the type-class specialiser, something like- fw :: Ord a => [a] -> Int# -> a+We never unbox class dictionaries in worker/wrapper. -BUT if f is strict in the Ord dictionary, we might unpack it, to get- fw :: (a->a->Bool) -> [a] -> Int# -> a-and the type-class specialiser can't specialise that. An example is #6056.+1. INLINABLE functions+ If we have+ f :: Ord a => [a] -> Int -> a+ {-# INLINABLE f #-}+ and we worker/wrapper f, we'll get a worker with an INLINABLE pragma+ (see Note [Worker/wrapper for INLINABLE functions] in GHC.Core.Opt.WorkWrap),+ which can still be specialised by the type-class specialiser, something like+ fw :: Ord a => [a] -> Int# -> a -But in any other situation, a dictionary is just an ordinary value,-and can be unpacked. So we track the INLINABLE pragma, and discard the boxity-flag in finaliseArgBoxities (see the isClassPred test).+ BUT if f is strict in the Ord dictionary, we might unpack it, to get+ fw :: (a->a->Bool) -> [a] -> Int# -> a+ and the type-class specialiser can't specialise that. An example is #6056. -Historical note: #14955 describes how I got this fix wrong the first time.+ Historical note: #14955 describes how I got this fix wrong the first time.+ I got aware of the issue in T5075 by the change in boxity of loop between+ demand analysis runs. -Note that the simplicity of this fix implies that INLINE functions (such as-wrapper functions after the WW run) will never say that they unbox class-dictionaries. That's not ideal, but not worth losing sleep over, as INLINE-functions will have been inlined by the time we run demand analysis so we'll-see the unboxing around the worker in client modules. I got aware of the issue-in T5075 by the change in boxity of loop between demand analysis runs.+2. -fspecialise-aggressively. As #21286 shows, the same phenomenon can occur+ occur without INLINABLE, when we use -fexpose-all-unfoldings and+ -fspecialise-aggressively to do vigorous cross-module specialisation. +TL;DR we /never/ unbox class dictionaries. Unboxing the dictionary, and passing+a raft of higher-order functions isn't a huge win anyway -- you really want to+specialise the function.+ Note [Worker argument budget] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ In 'finaliseArgBoxities' we don't want to generate workers with zillions of@@ -1686,7 +1781,6 @@ -- uses the info on the binders directly. where opts = ae_opts env- is_inlinable_fn = isStableUnfolding (realIdUnfolding fn) (bndrs, _body) = collectBinders rhs max_wkr_args = dmd_max_worker_args opts `max` arity -- See Note [Worker argument budget]@@ -1704,8 +1798,7 @@ get_dmd :: Id -> Type -> Demand get_dmd bndr bndr_ty- | isClassPred bndr_ty- , is_inlinable_fn = trimBoxity dmd+ | isClassPred bndr_ty = trimBoxity dmd -- See Note [Do not unbox class dictionaries] -- NB: 'ty' has not been normalised, so this will (rightly) -- catch newtype dictionaries too.@@ -1819,8 +1912,9 @@ dmdFix top_lvl env let_dmd orig_pairs = loop 1 initial_pairs where+ opts = ae_opts env -- See Note [Initialising strictness]- initial_pairs | ae_virgin env = [(setIdDmdSig id botSig, rhs) | (id, rhs) <- orig_pairs ]+ initial_pairs | ae_virgin env = [(setIdDmdAndBoxSig opts id botSig, rhs) | (id, rhs) <- orig_pairs ] | otherwise = orig_pairs -- If fixed-point iteration does not yield a result we use this instead@@ -1894,7 +1988,7 @@ 1. GADTs 2. Recursive products and widening -More on both below. But the botttom line is: we really don't want to+More on both below. But the bottom line is: we really don't want to have a binder whose demand is more deeply-nested than its type "allows". So in findBndrDmd we call trimToType and findTypeShape to trim the demand on the binder to a form that matches the type@@ -1917,7 +2011,7 @@ f _ (MkT n t) = f n t Here f is lazy in T, but its *usage* is infinite: P(L,P(L,P(L, ...))).-Notice that this happens because T is a product type, and is recrusive.+Notice that this happens because T is a product type, and is recursive. If we are not careful, we'll fail to iterate to a fixpoint in dmdFix, and bale out entirely, which is inefficient and over-conservative. @@ -2199,7 +2293,7 @@ * Generally CBV is more efficient. * Dictionaries are always non-bottom; and never take much work to- compute. E.g. a dfun from an instance decl always returns a dicionary+ compute. E.g. a dfun from an instance decl always returns a dictionary record immediately. See DFunUnfolding in CoreSyn. See also Note [Recursive superclasses] in TcInstDcls. @@ -2215,7 +2309,7 @@ See #17758 for more background and perf numbers. -The implementation is extremly simple: just make the strictness+The implementation is extremely simple: just make the strictness analyser strictify the demand on a dictionary binder in 'findBndrDmd'. @@ -2296,7 +2390,7 @@ This way, correct information finds its way into the module interface (strictness signatures!) and the code generator (single-entry thunks!) -Note that, in contrast, the single-call information (CM(..)) /can/ be+Note that, in contrast, the single-call information (C(M,..)) /can/ be relied upon, as the simplifier tends to be very careful about not duplicating actual function calls.
compiler/GHC/Core/Opt/Exitify.hs view
@@ -306,7 +306,7 @@ in … where the floated expression `x+x` is a bit more complicated, but still not-intersting.+interesting. Expressions are interesting when they move an occurrence of a variable outside the recursive `go` that can benefit from being obviously called once, for example:@@ -315,7 +315,7 @@ see that it is called at most once, and hence improve the function’s strictness signature -So we only hoist an exit expression out if it mentiones at least one free,+So we only hoist an exit expression out if it mentions at least one free, non-imported variable. Note [Jumps can be interesting]@@ -430,7 +430,7 @@ To prevent this, we need to recognize exit join points, and then disable inlining. -Exit join points, recognizeable using `isExitJoinId` are join points with an+Exit join points, recognizable using `isExitJoinId` are join points with an occurrence in a recursive group, and can be recognized (after the occurrence analyzer ran!) using `isExitJoinId`. This function detects joinpoints with `occ_in_lam (idOccinfo id) == True`,
compiler/GHC/Core/Opt/FloatOut.hs view
@@ -343,7 +343,7 @@ We may have a *nested* binding whose destination level is (FloatMe tOP_LEVEL), thus letrec { foo <0,0> = .... (let bar<0,0> = .. in ..) .... } The binding for bar will be in the "tops" part of the floating binds,-and thus not partioned by floatBody.+and thus not partitioned by floatBody. We could perhaps get rid of the 'tops' component of the floating binds, but this case works just as well.
compiler/GHC/Core/Opt/LiberateCase.hs view
@@ -173,7 +173,7 @@ {- Note [Not bottoming Ids] ~~~~~~~~~~~~~~~~~~~~~~~~~~~ Do not specialise error-functions (this is unusual, but I once saw it,-(actually in Data.Typable.Internal)+(actually in Data.Typeable.Internal) Note [Only functions!] ~~~~~~~~~~~~~~~~~~~~~~
compiler/GHC/Core/Opt/Pipeline.hs view
@@ -150,7 +150,7 @@ maybe_rule_check phase = runMaybe rule_check (CoreDoRuleCheck phase) maybe_strictness_before (Phase phase)- | phase `elem` strictnessBefore dflags = CoreDoDemand+ | phase `elem` strictnessBefore dflags = CoreDoDemand False maybe_strictness_before _ = CoreDoNothing @@ -171,8 +171,8 @@ simpl_gently = CoreDoSimplify $ initSimplifyOpts dflags extra_vars max_iter (initGentleSimplMode dflags) rule_base - dmd_cpr_ww = if ww_on then [CoreDoDemand,CoreDoCpr,CoreDoWorkerWrapper]- else [CoreDoDemand,CoreDoCpr]+ dmd_cpr_ww = if ww_on then [CoreDoDemand True,CoreDoCpr,CoreDoWorkerWrapper]+ else [CoreDoDemand False] -- NB: No CPR! See Note [Don't change boxity without worker/wrapper] demand_analyser = (CoreDoPasses (@@ -244,7 +244,7 @@ -- GHC.Iface.Tidy.StaticPtrTable. static_ptrs_float_outwards, - -- Run the simplier phases 2,1,0 to allow rewrite rules to fire+ -- Run the simplifier phases 2,1,0 to allow rewrite rules to fire runWhen do_simpl3 (CoreDoPasses $ [ simpl_phase (Phase phase) "main" max_iter | phase <- [phases, phases-1 .. 1] ] ++@@ -340,7 +340,7 @@ -- has run at all. See Note [Final Demand Analyser run] in GHC.Core.Opt.DmdAnal -- It is EXTREMELY IMPORTANT to run this pass, otherwise execution -- can become /exponentially/ more expensive. See #11731, #12996.- runWhen (strictness || late_dmd_anal) CoreDoDemand,+ runWhen (strictness || late_dmd_anal) (CoreDoDemand False), maybe_rule_check FinalPhase, @@ -417,7 +417,7 @@ with -O2 -flate-specialise 1. I found that running late-Specialise after SpecConstr, with no- simplification in between meant that the carefullly constructed+ simplification in between meant that the carefully constructed SpecConstr rule never got to fire. (It was something like lvl = f a -- Arity 1 ....g lvl....@@ -491,8 +491,8 @@ CoreDoExitify -> {-# SCC "Exitify" #-} updateBinds exitifyProgram - CoreDoDemand -> {-# SCC "DmdAnal" #-}- updateBindsM (liftIO . dmdAnal logger dflags fam_envs (mg_rules guts))+ CoreDoDemand before_ww -> {-# SCC "DmdAnal" #-}+ updateBindsM (liftIO . dmdAnal logger before_ww dflags fam_envs (mg_rules guts)) CoreDoCpr -> {-# SCC "CprAnal" #-} updateBindsM (liftIO . cprAnalProgram logger fam_envs)@@ -557,10 +557,11 @@ rule_fn (mg_binds guts)) return guts -dmdAnal :: Logger -> DynFlags -> FamInstEnvs -> [CoreRule] -> CoreProgram -> IO CoreProgram-dmdAnal logger dflags fam_envs rules binds = do+dmdAnal :: Logger -> Bool -> DynFlags -> FamInstEnvs -> [CoreRule] -> CoreProgram -> IO CoreProgram+dmdAnal logger before_ww dflags fam_envs rules binds = do let !opts = DmdAnalOpts { dmd_strict_dicts = gopt Opt_DictsStrict dflags+ , dmd_do_boxity = before_ww -- only run Boxity Analysis immediately preceding WW , dmd_unbox_width = dmdUnboxWidth dflags , dmd_max_worker_args = maxWorkerArgs dflags }
compiler/GHC/Core/Opt/SetLevels.hs view
@@ -772,7 +772,7 @@ - the expression is not a HNF, and - the expression is not bottoming -Exammples:+Examples: * Bottoming f x = case x of@@ -945,7 +945,7 @@ Example: ... let { v = \y. error (show x ++ show y) } in ... We want to abstract over x and float the whole thing to top:- lvl = \xy. errror (show x ++ show y)+ lvl = \xy. error (show x ++ show y) ...let {v = lvl x} in ... Then of course we don't want to separately float the body (error ...)
compiler/GHC/Core/Opt/SpecConstr.hs view
@@ -1,3 +1,7 @@+{-# LANGUAGE CPP #-}+#if __GLASGOW_HASKELL__ < 905+{-# LANGUAGE PatternSynonyms #-}+#endif {- ToDo [Oct 2013] ~~~~~~~~~~~~~~~@@ -974,6 +978,18 @@ scSubstId :: ScEnv -> InId -> OutExpr scSubstId env v = lookupIdSubst (sc_subst env) v ++-- Solo is only defined in base starting from ghc-9.2+#if !(MIN_VERSION_base(4, 16, 0))+data Solo a = Solo a+#endif++-- The Solo constructor was renamed to MkSolo in ghc 9.5+#if __GLASGOW_HASKELL__ < 905+pattern MkSolo :: a -> Solo a+pattern MkSolo a = Solo a+#endif+ -- The !subst ensures that we force the selection `(sc_subst env)`, which avoids -- retaining all of `env` when we only need `subst`. The `Solo` means that the -- substitution itself is lazy, because that type is often discarded.@@ -985,7 +1001,7 @@ scSubstTy :: ScEnv -> InType -> Solo OutType scSubstTy env ty = let !subst = sc_subst env- in Solo (substTyUnchecked subst ty)+ in MkSolo (substTyUnchecked subst ty) scSubstCo :: ScEnv -> Coercion -> Coercion scSubstCo env co = substCo (sc_subst env) co@@ -1271,7 +1287,7 @@ evalScrutOcc :: ArgOcc -- We use evalScrutOcc for -- - mkVarUsage: applied functions--- - scApp: dicts that are the arugment of a classop+-- - scApp: dicts that are the argument of a classop evalScrutOcc = ScrutOcc emptyUFM -- Experimentally, this version of combineOcc makes ScrutOcc "win", so@@ -1437,7 +1453,7 @@ e' -> scExpr (zapScSubst env) e' scExpr' env (Type t) =- let !(Solo ty') = scSubstTy env t+ let !(MkSolo ty') = scSubstTy env t in return (nullUsage, Type ty') scExpr' env (Coercion c) = return (nullUsage, Coercion (scSubstCo env c)) scExpr' _ e@(Lit {}) = return (nullUsage, e)@@ -1481,7 +1497,7 @@ -- The combined usage of the scrutinee is given -- by scrut_occ, which is passed to setScrutOcc, which -- in turn treats a bare-variable scrutinee specially- ; let !(Solo ty') = scSubstTy env ty+ ; let !(MkSolo ty') = scSubstTy env ty ; return (foldr combineUsage scrut_usg' alt_usgs, Case scrut' b' ty' alts') }@@ -1895,7 +1911,7 @@ add_void_arg = needsVoidWorkerArg fn arg_bndrs spec_lam_args1 (spec_lam_args, spec_call_args, spec_arity, spec_join_arity) | add_void_arg- -- See Note [SpecConst needs to add void args first]+ -- See Note [SpecConstr needs to add void args first] , (spec_lam_args, spec_call_args, _) <- addVoidWorkerArg spec_lam_args1 [] -- needsVoidWorkerArg: usual w/w hack to avoid generating -- a spec_rhs of unlifted type and no args.@@ -1982,8 +1998,8 @@ = rhs -{- Note [SpecConst needs to add void args first]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+{- Note [SpecConstr needs to add void args first]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider a function f start @t = e We want to specialize for a partially applied call `f True`.@@ -2002,7 +2018,7 @@ But if you look closely this wouldn't typecheck! If we substitute `f True` with `$sf void#` we expect the type argument to be applied first but we apply void# first.-The easist fix seems to be just to add the void argument to the front of the arguments.+The easiest fix seems to be just to add the void argument to the front of the arguments. Now we get: $sf :: Void# -> forall t. bla $sf void @t = $se@@ -2043,7 +2059,7 @@ -> ( [Var] -- Demand-decorated binders , DmdSig -- Strictness of specialised thing , Arity, Maybe JoinArity ) -- Arities of specialised thing--- Calcuate bits of IdInfo for the specialised function+-- Calculate bits of IdInfo for the specialised function -- See Note [Transfer strictness] -- See Note [Strictness information in worker binders] calcSpecInfo fn (CP { cp_qvars = qvars, cp_args = pats }) extra_bndrs@@ -2584,7 +2600,7 @@ , Just arg_occs <- mb_scrut dc = do { let (ty_args, rest_args) = splitAtList (dataConUnivTyVars dc) args con_str, matched_str :: [StrictnessMark]- -- con_str corrresponds 1-1 with the /value/ arguments+ -- con_str corresponds 1-1 with the /value/ arguments -- matched_str corresponds 1-1 with /all/ arguments con_str = dataConRepStrictness dc matched_str = match_vals con_str rest_args
compiler/GHC/Core/Opt/Specialise.hs view
@@ -63,6 +63,8 @@ import GHC.Unit.Module.ModGuts import GHC.Core.Unfold +import Data.List.NonEmpty ( NonEmpty (..) )+ {- ************************************************************************ * *@@ -307,7 +309,7 @@ Here, the specialised version of g is an application of g's rhs to the Ord dictionary for (Tree Int), which only the type checker can conjure up. There might not even *be* one, if (Tree Int) is not an instance of-Ord! (All the other specialision has suitable dictionaries to hand+Ord! (All the other specialisation has suitable dictionaries to hand from actual calls.) Problem. The type checker doesn't have to hand a convenient <f_rhs>, because@@ -647,6 +649,37 @@ * * ********************************************************************* -} +{- Note [Specialising imported functions]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+specImports specialises imported functions, based on calls in this module.++When -fspecialise-aggressively is on, we specialise any imported+function for which we have an unfolding. The+-fspecialise-aggressively flag is usually off, because we risk lots of+orphan modules from over-vigorous specialisation. (See Note [Orphans]+in GHC.Core.) However it's not a big deal: anything non-recursive with+an unfolding-template will probably have been inlined already.++When -fspecialise-aggressively is off, we are more selective about+specialisation (see canSpecImport):++(1) Without -fspecialise-aggressively, do not specialise+ DFunUnfoldings. Note [Do not specialise imported DFuns].++(2) Without -fspecialise-aggressively, specialise only imported things+ that have a /user-supplied/ INLINE or INLINABLE pragma (hence+ isAnyInlinePragma rather than isStableSource).++ In particular, we don't want to specialise workers created by+ worker/wrapper (for functions with no pragma) because they won't+ specialise usefully, and they generate quite a bit of useless code+ bloat.++ Specialise even INLINE things; it hasn't inlined yet, so perhaps+ it never will. Moreover it may have calls inside it that we want+ to specialise+-}+ specImports :: SpecEnv -> [CoreRule] -> UsageDetails@@ -768,23 +801,17 @@ -- See Note [Avoiding loops in specImports] canSpecImport :: DynFlags -> Id -> Maybe CoreExpr--- See Note [Specialise imported INLINABLE things] canSpecImport dflags fn- | CoreUnfolding { uf_src = src, uf_tmpl = rhs } <- unf- , isStableSource src- = Just rhs -- By default, specialise only imported things that have a stable- -- unfolding; that is, have an INLINE or INLINABLE pragma- -- Specialise even INLINE things; it hasn't inlined yet,- -- so perhaps it never will. Moreover it may have calls- -- inside it that we want to specialise-- -- CoreUnfolding case does /not/ include DFunUnfoldings;- -- We only specialise DFunUnfoldings with -fspecialise-aggressively- -- See Note [Do not specialise imported DFuns]+ | CoreUnfolding { uf_tmpl = rhs } <- unf+ -- See Note [Specialising imported functions] point (1).+ , isAnyInlinePragma (idInlinePragma fn)+ -- See Note [Specialising imported functions] point (2).+ = Just rhs | gopt Opt_SpecialiseAggressively dflags- = maybeUnfoldingTemplate unf -- With -fspecialise-aggressively, specialise anything- -- with an unfolding, stable or not, DFun or not+ = maybeUnfoldingTemplate unf+ -- With -fspecialise-aggressively, specialise anything+ -- with an unfolding, stable or not, DFun or not | otherwise = Nothing where@@ -809,7 +836,7 @@ allCallersInlined = all (isAnyInlinePragma . idInlinePragma) callers diag_opts = initDiagOpts dflags doWarn reason =- msg (mkMCDiagnostic diag_opts reason)+ msg (mkMCDiagnostic diag_opts reason Nothing) (vcat [ hang (text ("Could not specialise imported function") <+> quotes (ppr fn)) 2 (vcat [ text "when specialising" <+> quotes (ppr caller) | caller <- callers])@@ -1021,20 +1048,6 @@ Avoiding this recursive specialisation loop is one reason for the 'callers' stack passed to specImports and specImport. -Note [Specialise imported INLINABLE things]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-What imported functions do we specialise? The basic set is- * DFuns and things with INLINABLE pragmas.-but with -fspecialise-aggressively we add- * Anything with an unfolding template--#8874 has a good example of why we want to auto-specialise DFuns.--We have the -fspecialise-aggressively flag (usually off), because we-risk lots of orphan modules from over-vigorous specialisation.-However it's not a big deal: anything non-recursive with an-unfolding-template will probably have been inlined already.- Note [Glom the bindings if imported functions are specialised] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Suppose we have an imported, *recursive*, INLINABLE function@@ -1190,7 +1203,7 @@ | -- See Note [Floating dictionaries out of cases] interestingDict scrut' (idType case_bndr) , not (isDeadBinder case_bndr && null sc_args')- = do { (case_bndr_flt : sc_args_flt) <- mapM clone_me (case_bndr' : sc_args')+ = do { case_bndr_flt :| sc_args_flt <- mapM clone_me (case_bndr' :| sc_args') ; let case_bndr_flt' = case_bndr_flt `addDictUnfolding` scrut' scrut_bind = mkDB (NonRec case_bndr_flt scrut')@@ -1335,7 +1348,7 @@ fn3 = zapIdDemandInfo fn2 -- We zap the demand info because the binding may float,- -- which would invaidate the demand info (see #17810 for example).+ -- which would invalidate the demand info (see #17810 for example). -- Destroying demand info is not terrible; specialisation is -- always followed soon by demand analysis. @@ -1604,19 +1617,16 @@ simpl_opts = initSimpleOpts dflags --------------------------------------- -- Add a suitable unfolding if the spec_inl_prag says so- -- See Note [Inline specialisations]- (spec_inl_prag, spec_unf)- | not is_local && isStrongLoopBreaker (idOccInfo fn)- = (neverInlinePragma, noUnfolding)- -- See Note [Specialising imported functions] in "GHC.Core.Opt.OccurAnal"-- | isInlinablePragma inl_prag- = (inl_prag { inl_inline = NoUserInlinePrag }, noUnfolding)+ -- Add a suitable unfolding; see Note [Inline specialisations]+ spec_unf = specUnfolding simpl_opts spec_bndrs (`mkApps` spec_args)+ rule_lhs_args fn_unf + spec_inl_prag+ | not is_local -- See Note [Specialising imported functions]+ , isStrongLoopBreaker (idOccInfo fn) -- in GHC.Core.Opt.OccurAnal+ = neverInlinePragma | otherwise- = (inl_prag, specUnfolding simpl_opts spec_bndrs (`mkApps` spec_args)- rule_lhs_args fn_unf)+ = inl_prag -------------------------------------- -- Adding arity information just propagates it a bit faster@@ -1832,7 +1842,7 @@ $fCInt_$cm :: forall b. Show b => Int -> b -> String $fCInt_$cm b d x y = show @Int $dShowInt x ++ show @b d y -We want to specialise this! How? By doing the the method-selection rewrite in+We want to specialise this! How? By doing the method-selection rewrite in the Specialiser. Hence 1. In the App case of 'specExpr', try to apply the ClassOp/DFun rule on the@@ -2172,25 +2182,18 @@ Note [Inline specialisations] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Here is what we do with the InlinePragma of the original function- * Activation/RuleMatchInfo: both transferred to the- specialised function- * InlineSpec:- (a) An INLINE pragma is transferred- (b) An INLINABLE pragma is *not* transferred -Why (a): transfer INLINE pragmas? The point of INLINE was precisely to-specialise the function at its call site, and arguably that's not so-important for the specialised copies. BUT *pragma-directed*-specialisation now takes place in the typechecker/desugarer, with-manually specified INLINEs. The specialisation here is automatic.-It'd be very odd if a function marked INLINE was specialised (because-of some local use), and then forever after (including importing-modules) the specialised version wasn't INLINEd. After all, the-programmer said INLINE!+ * Activation/RuleMatchInfo: both inherited from the original function -You might wonder why we specialise INLINE functions at all. After-all they should be inlined, right? Two reasons:+ * InlineSpec: inherit from original function + * Unfolding: transfer a StableUnfolding iff it is UnfWhen+ See GHC.Core.Unfold.Make.specUnfolding+ and its Note [Specialising unfoldings]++InlineSpec: you might wonder why we specialise INLINE functions at all.+After all they should be inlined, right? Two reasons:+ * Even INLINE functions are sometimes not inlined, when they aren't applied to interesting arguments. But perhaps the type arguments alone are enough to specialise (even though the args are too boring@@ -2215,26 +2218,6 @@ (replicateM_ dMonadIO). We certainly want to specialise $wreplicateM_! This particular example had a huge effect on the call to replicateM_ in nofib/shootout/n-body.--Why (b): discard INLINABLE pragmas? See #4874 for persuasive examples.-Suppose we have- {-# INLINABLE f #-}- f :: Ord a => [a] -> Int- f xs = letrec f' = ...f'... in f'-Then, when f is specialised and optimised we might get- wgo :: [Int] -> Int#- wgo = ...wgo...- f_spec :: [Int] -> Int- f_spec xs = case wgo xs of { r -> I# r }-and we clearly want to inline f_spec at call sites. But if we still-have the big, un-optimised of f (albeit specialised) captured in an-INLINABLE pragma for f_spec, we won't get that optimisation.--So we simply drop INLINABLE pragmas when specialising. It's not really-a complete solution; ignoring specialisation for now, INLINABLE functions-don't get properly strictness analysed, for example. But it works well-for examples involving specialisation, which is the dominant use of-INLINABLE. See #4874. -} {- *********************************************************************
compiler/GHC/Core/Opt/WorkWrap.hs view
@@ -195,20 +195,48 @@ This comes up in practice (#6056). -Solution: do the w/w for strictness analysis, but transfer the Stable-unfolding to the *worker*. So we will get something like this:+Solution: - {-# INLINE[2] f #-}+* Do the w/w for strictness analysis, even for INLINABLE functions++* Transfer the Stable unfolding to the *worker*. How do we "transfer+ the unfolding"? Easy: by using the old one, wrapped in work_fn! See+ GHC.Core.Unfold.Make.mkWorkerUnfolding.++* We use the /original, user-specified/ function's InlineSpec pragma+ for both the wrapper and the worker (see `mkStrWrapperInlinePrag`).+ So if f is INLINEABLE, both worker and wrapper will get an InlineSpec+ of (Inlinable "blah").++ It's important that both get this, because the specialiser uses+ the existence of a /user-specified/ INLINE/INLINABLE pragma to+ drive specialisation of imported functions. See GHC.Core.Opt.Specialise+ Note [Specialising imported functions]++* Remember, the subsequent inlining behaviour of the wrapper is expressed by+ (a) the stable unfolding+ (b) the unfolding guidance of UnfWhen+ (c) the inl_act activation (see Note [Wrapper activation]++For our {-# INLINEABLE f #-} example above, we will get something a+bit like like this:++ {-# Has stable unfolding, active in phase 2;+ plus InlineSpec = INLINEABLE #-} f :: Ord a => [a] -> Int -> a f d x y = case y of I# y' -> fw d x y' - {-# INLINABLE[2] fw #-}+ {-# Has stable unfolding, plus InlineSpec = INLINEABLE #-} fw :: Ord a => [a] -> Int# -> a fw d x y' = let y = I# y' in ...f... -How do we "transfer the unfolding"? Easy: by using the old one, wrapped-in work_fn! See GHC.Core.Unfold.Make.mkWorkerUnfolding. +(Historical note: we used to always give the wrapper an INLINE pragma,+but CSE will not happen if there is a user-specified pragma, but+should happen for w/w’ed things (#14186). But now we simply propagate+any user-defined pragma info, so we'll defeat CSE (rightly) only when+there is a user-supplied INLINE/INLINEABLE pragma.)+ Note [No worker/wrapper for record selectors] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We sometimes generate a lot of record selectors, and generally the@@ -486,7 +514,7 @@ about INLINE things here. -What if `foo` has no specialiations, is worker/wrappered (with the+What if `foo` has no specialisations, is worker/wrappered (with the wrapper inlining very early), and exported; and then in an importing module we have {-# SPECIALISE foo : ... #-}? @@ -496,19 +524,6 @@ in which case we don't unpack dictionaries for the worker; see see Note [Do not unbox class dictionaries].) -Note [Wrapper NoUserInlinePrag]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-We use NoUserInlinePrag on the wrapper, to say that there is no-user-specified inline pragma. (The worker inherits that; see Note-[Worker/wrapper for INLINABLE functions].) The wrapper has no pragma-given by the user.--(Historical note: we used to give the wrapper an INLINE pragma, but-CSE will not happen if there is a user-specified pragma, but should-happen for w/w’ed things (#14186). We don't need a pragma, because-everything we needs is expressed by (a) the stable unfolding and (b)-the inl_act activation.)- Note [Drop absent bindings] ~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider (#19824):@@ -645,7 +660,7 @@ in p `seq` (v,v) I think we'll give `f` the strictness signature `<SP(M,A)>`, where the-`M` sayd that we'll evaluate the first component of the pair at most+`M` says that we'll evaluate the first component of the pair at most once. Why? Because the RHS of the thunk `v` is evaluated at most once. @@ -872,17 +887,23 @@ fn_rules = ruleInfoRules (ruleInfo fn_info) mkStrWrapperInlinePrag :: InlinePragma -> [CoreRule] -> InlinePragma--- See Note [Wrapper activation]-mkStrWrapperInlinePrag (InlinePragma { inl_act = act, inl_rule = rule_info }) rules+mkStrWrapperInlinePrag (InlinePragma { inl_inline = fn_inl+ , inl_act = fn_act+ , inl_rule = rule_info }) rules = InlinePragma { inl_src = SourceText "{-# INLINE"- , inl_inline = NoUserInlinePrag -- See Note [Wrapper NoUserInlinePrag] , inl_sat = Nothing++ , inl_inline = fn_inl+ -- See Note [Worker/wrapper for INLINABLE functions]+ , inl_act = activeAfter wrapper_phase+ -- See Note [Wrapper activation]+ , inl_rule = rule_info } -- RuleMatchInfo is (and must be) unaffected where -- See Note [Wrapper activation] wrapper_phase = foldr (laterPhase . get_rule_phase) earliest_inline_phase rules- earliest_inline_phase = beginPhase act `laterPhase` nextPhase InitialPhase+ earliest_inline_phase = beginPhase fn_act `laterPhase` nextPhase InitialPhase -- laterPhase (nextPhase InitialPhase) is a temporary hack -- to inline no earlier than phase 2. I got regressions in -- 'mate', due to changes in full laziness due to Note [Case@@ -904,15 +925,15 @@ Example: -- Original function- f [Demand=<L,1*C1(U)>] :: (a,a) -> a+ f [Demand=<L,1*C(1,U)>] :: (a,a) -> a f = \p -> ... -- Wrapper- f [Demand=<L,1*C1(U)>] :: a -> a -> a+ f [Demand=<L,1*C(1,U)>] :: a -> a -> a f = \p -> case p of (a,b) -> $wf a b -- Worker- $wf [Demand=<L,1*C1(C1(U))>] :: Int -> Int+ $wf [Demand=<L,1*C(1,C(1,U))>] :: Int -> Int $wf = \a b -> ... We need to check whether the original function is called once, with@@ -921,7 +942,7 @@ the original function. The demand on the worker is then calculated using mkWorkerDemand, and always of-the form [Demand=<L,1*(C1(...(C1(U))))>]+the form [Demand=<L,1*(C(1,...(C(1,U))))>] Note [Thunk splitting] ~~~~~~~~~~~~~~~~~~~~~~
compiler/GHC/Core/Opt/WorkWrap/Utils.hs view
@@ -389,7 +389,7 @@ -- | Inserts a `Void#` arg before the first argument. ----- Why as the first argument? See Note [SpecConst needs to add void args first]+-- Why as the first argument? See Note [SpecConstr needs to add void args first] -- in SpecConstr. addVoidWorkerArg :: [Var] -> [StrictnessMark] -> ([Var], -- Lambda bound args@@ -524,7 +524,7 @@ saw a type variable in the worker shadowing an outer term-variable binding. We avoid the issue by freshening the argument variables from the original fun-RHS through 'cloneBndrs', which will also take care of subsitution in binder+RHS through 'cloneBndrs', which will also take care of substitution in binder types. Fortunately, it's sufficient to pick the FVs of the arg vars as in-scope set, so that we don't need to do a FV traversal over the whole body of the original function.@@ -717,7 +717,7 @@ other cases where something went avoidably wrong. This warning also triggers for the stream fusion library within `text`.-We can'easily W/W constructed results like `Stream` because we have no simple+We can't easily W/W constructed results like `Stream` because we have no simple way to express existential types in the worker's type signature. Note [WW for calling convention]@@ -741,7 +741,7 @@ Performing W/W might not always be a win. In particular it's easy to break (badly written, but common) rule frameworks by doing additional W/W splits.-See #20364 for a more detailed explaination.+See #20364 for a more detailed explanation. Hence we have the following strategies with different trade-offs: @@ -751,7 +751,7 @@ B) Do W/W on just about anything where it might be beneficial.- + Exploits pretty much every oppertunity for unlifting.+ + Exploits pretty much every opportunity for unlifting. - A bit of compile time/code size cost for all the wrappers. - Can break rules which would otherwise fire. See #20364. @@ -764,7 +764,7 @@ - Requires either: ~ Eta-expansion at *all* call sites in order to generate an impedance matcher function. Leading to massive code bloat.- Essentially we end up creating a imprompto wrapper function+ Essentially we end up creating a impromptu wrapper function wherever we wouldn't inline the wrapper with a W/W approach. ~ There is the option of achieving this without eta-expansion if we instead expand the partial application code to check for demands on the calling convention and@@ -864,7 +864,7 @@ , args1 ++ args2 , wrap_fn1 . wrap_fn2 , wrap_arg:wrap_args ) }- go _ _ = panic "mkWWstr: Impossible - str/arg length missmatch"+ go _ _ = panic "mkWWstr: Impossible - str/arg length mismatch" ---------------------- -- mkWWstr_one wrap_var = (useful, work_args, wrap_fn, wrap_arg)@@ -909,7 +909,7 @@ fam_envs = wo_fam_envs opts arg_ty = idType arg arg_dmd = idDemandInfo arg- arg_str | isTyVar arg = NotMarkedStrict -- Type args don't get stricness marks+ arg_str | isTyVar arg = NotMarkedStrict -- Type args don't get strictness marks | otherwise = str_mark do_nothing = return (badWorker, [(arg,arg_str)], nop_fn, varToCoreExpr arg) @@ -1291,7 +1291,7 @@ -- through one of @dc@'s fields (so surely non-recursive). -- * @NonRecursiveOrUnsure@ when @fuel /= Infinity@ -- and @fuel@ expansions of nested data TyCons were not enough to prove--- non-recursivenss, nor arrive at an occurrence of @tc@ thus proving+-- non-recursiveness, nor arrive at an occurrence of @tc@ thus proving -- recursiveness. (So not sure if non-recursive.) -- * @NonRecursiveOrUnsure@ when we hit an abstract TyCon (one without -- visible DataCons), such as those imported from .hs-boot files.@@ -1595,7 +1595,7 @@ We want `$wh :: Int# -> [Int]`. We'd get `$wh :: Int# -> (# [Int] #)`. -By considering vars as unlifted that satsify 'exprIsHNF', we catch (3).+By considering vars as unlifted that satisfy 'exprIsHNF', we catch (3). Why not check for 'exprOkForSpeculation'? Quite perplexingly, evaluated vars are not ok-for-spec, see Note [exprOkForSpeculation and evaluated variables]. For (1) and (2) we would have to look at the term. WW only looks at the@@ -1607,7 +1607,7 @@ Remark on linearity: in both the case of the wrapper and the worker, we build a linear case to unpack constructed products. All the multiplicity information is kept in the constructors (both C and (#, #)).-In particular (#,#) is parametrised by the multiplicity of its fields.+In particular (#,#) is parameterised by the multiplicity of its fields. Specifically, in this instance, the multiplicity of the fields of (#,#) is chosen to be the same as those of C.
compiler/GHC/CoreToStg/Prep.hs view
@@ -129,7 +129,7 @@ annotate according to scoping rules when floating. 11. Collect cost centres (including cost centres in unfoldings) if we're in- profiling mode. We have to do this here beucase we won't have unfoldings+ profiling mode. We have to do this here because we won't have unfoldings after this pass (see `trimUnfolding` and Note [Drop unfoldings and rules]. 12. Eliminate case clutter in favour of unsafe coercions.@@ -179,7 +179,7 @@ Tiresome, but not difficult. These transformations get rid of "case clutter", leaving only casts.-We are doing no further significant tranformations, so the reasons+We are doing no further significant transformations, so the reasons for the case forms have disappeared. And it is extremely helpful for the ANF-ery, CoreToStg, and backends, if trivial expressions really do look trivial. #19700 was an example.@@ -1200,12 +1200,9 @@ arg_ty' = cpSubstTy env arg_ty CpeApp (Coercion co)- -> rebuild_app' env as (App fun' (Coercion co')) floats ss' rt_ticks req_depth+ -> rebuild_app' env as (App fun' (Coercion co')) floats (drop 1 ss) rt_ticks req_depth where co' = cpSubstCo env co- ss'- | null ss = []- | otherwise = tail ss CpeApp arg -> do let (ss1, ss_rest) -- See Note [lazyId magic] in GHC.Types.Id.Make@@ -2028,7 +2025,7 @@ {- Note [CpeTyCoEnv] ~~~~~~~~~~~~~~~~~~~~ The cpe_tyco_env :: Maybe CpeTyCoEnv field carries a substitution-for type and coercion varibles+for type and coercion variables * We need the coercion substitution to support the elimination of unsafeEqualityProof (see Note [Unsafe coercions])
compiler/GHC/Data/Graph/Color.hs view
@@ -95,7 +95,7 @@ -- try and color the problem nodes -- problem nodes are the ones that were left uncolored because they weren't triv.- -- theres a change we can color them here anyway.+ -- there's a change we can color them here anyway. (graph_prob, ksNoColor) = assignColors colors graph_triv ksProblems
compiler/GHC/Data/Graph/Ops.hs view
@@ -253,7 +253,7 @@ -- | Add a coalescence edge to the graph, creating nodes if required.--- It is considered adventageous to assign the same color to nodes in a coalesence.+-- It is considered advantageous to assign the same color to nodes in a coalescence. addCoalesce :: Uniquable k => (k, cls) -> (k, cls)@@ -491,7 +491,7 @@ = if elementOfUniqSet k (nodeCoalesce node) then node { nodeCoalesce = delOneFromUniqSet (nodeCoalesce node) k } else node -- panic "GHC.Data.Graph.Ops.freezeNode: edge to freeze wasn't in the coalesce set"- -- If the edge isn't actually in the coelesce set then just ignore it.+ -- If the edge isn't actually in the coalesce set then just ignore it. fm2 = nonDetStrictFoldUniqSet (adjustUFM_C (freezeEdge k)) fm1 -- It's OK to use a non-deterministic fold here because the@@ -609,7 +609,7 @@ $ nonDetEltsUFM $ graphMap graph , not $ null badNodes = pprPanic "GHC.Data.Graph.Ops.validateGraph"- ( text "Supposably colored graph has uncolored nodes."+ ( text "Supposedly colored graph has uncolored nodes." $$ text " uncolored nodes: " <> hcat (map (ppr . nodeId) badNodes) $$ doc )
compiler/GHC/Driver/GenerateCgIPEStub.hs view
@@ -43,7 +43,7 @@ But to make them readable / meaningful, one needs to know the source location of each return frame. Every return frame has a distinct info table and thus a distinct code pointer (for tables next to-code) or at least a distict address itself. Info Table Provernance Entries (IPE) are searchable by+code) or at least a distinct address itself. Info Table Provenance Entries (IPEs) are searchable by this pointer and contain a source location. The info table / info table code pointer to source location map is described in:
compiler/GHC/Driver/Main.hs view
@@ -1568,6 +1568,7 @@ (logDiagnostics $ singleMessage $ mkPlainMsgEnvelope diag_opts (warnUnsafeOnLoc dflags) $ GhcDriverMessage $ DriverUnknownMessage $+ UnknownDiagnostic $ mkPlainDiagnostic reason noHints $ whyUnsafe' dflags) @@ -1638,7 +1639,7 @@ -- Interface generators -------------------------------------------------------------- --- | Generate a striped down interface file, e.g. for boot files or when ghci+-- | Generate a stripped down interface file, e.g. for boot files or when ghci -- generates interface files. See Note [simpleTidyPgm - mkBootModDetailsTc] hscSimpleIface :: HscEnv -> TcGblEnv@@ -1865,7 +1866,7 @@ rawCmms return stub_c_exists where- no_loc = ModLocation{ ml_hs_file = Just filename,+ no_loc = ModLocation{ ml_hs_file = Just original_filename, ml_hi_file = panic "hscCompileCmmFile: no hi file", ml_obj_file = panic "hscCompileCmmFile: no obj file", ml_dyn_obj_file = panic "hscCompileCmmFile: no dyn obj file",@@ -2227,7 +2228,8 @@ [L _ i] -> return i _ -> liftIO $ throwOneError $ mkPlainErrorMsgEnvelope noSrcSpan $- GhcPsMessage $ PsUnknownMessage $ mkPlainError noHints $+ GhcPsMessage $ PsUnknownMessage $+ UnknownDiagnostic $ mkPlainError noHints $ text "parse error in import declaration" -- | Typecheck an expression (but don't run it)@@ -2258,7 +2260,7 @@ Just (L _ (BodyStmt _ expr _ _)) -> return expr _ -> throwOneError $ mkPlainErrorMsgEnvelope noSrcSpan $- GhcPsMessage $ PsUnknownMessage $ mkPlainError noHints $+ GhcPsMessage $ PsUnknownMessage $ UnknownDiagnostic $ mkPlainError noHints $ text "not an expression:" <+> quotes (text expr) hscParseStmt :: String -> Hsc (Maybe (GhciLStmt GhcPs))
compiler/GHC/Driver/Make.hs view
@@ -3,6 +3,7 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NondecreasingIndentation #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} {-# LANGUAGE FlexibleContexts #-}@@ -861,9 +862,9 @@ blocking. * runPipelines takes this list and eventually passes it to runLoop which executes each action and places the result into the right MVar.-* The amount of parrelism is controlled by a semaphore. This is just used around the+* The amount of parallelism is controlled by a semaphore. This is just used around the module compilation step, so that only the right number of modules are compiled at- the same time which reduces overal memory usage and allocations.+ the same time which reduces overall memory usage and allocations. * Each proper node has a LogQueue, which dictates where to send it's output. * The LogQueue is placed into the LogQueueQueue when the action starts and a worker thread processes the LogQueueQueue printing logs for each module in a stable order.@@ -967,8 +968,7 @@ -- | Simple wrapper around MVar which allows a functor instance. data ResultVar b = forall a . ResultVar (a -> b) (MVar (Maybe a)) -instance Functor ResultVar where- fmap f (ResultVar g var) = ResultVar (f . g) var+deriving instance Functor ResultVar mkResultVar :: MVar (Maybe a) -> ResultVar a mkResultVar = ResultVar id@@ -992,7 +992,7 @@ data BuildLoopState = BuildLoopState { buildDep :: M.Map NodeKey BuildResult -- The current way to build a specific TNodeKey, without cycles this just points to- -- the appropiate result of compiling a module but with+ -- the appropriate result of compiling a module but with -- cycles there can be additional indirection and can point to the result of typechecking a loop , nNODE :: Int , hug_var :: MVar HomeUnitGraph@@ -2229,9 +2229,9 @@ let deferDiagnostics _dflags !msgClass !srcSpan !msg = do let action = logMsg logger msgClass srcSpan msg case msgClass of- MCDiagnostic SevWarning _reason+ MCDiagnostic SevWarning _reason _code -> atomicModifyIORef' warnings $ \i -> (action: i, ())- MCDiagnostic SevError _reason+ MCDiagnostic SevError _reason _code -> atomicModifyIORef' errors $ \i -> (action: i, ()) MCFatal -> atomicModifyIORef' fatals $ \i -> (action: i, ())@@ -2252,7 +2252,8 @@ noModError :: HscEnv -> SrcSpan -> ModuleName -> FindResult -> MsgEnvelope GhcMessage -- ToDo: we don't have a proper line number for this error noModError hsc_env loc wanted_mod err- = mkPlainErrorMsgEnvelope loc $ GhcDriverMessage $ DriverUnknownMessage $ mkPlainError noHints $+ = mkPlainErrorMsgEnvelope loc $ GhcDriverMessage $+ DriverUnknownMessage $ UnknownDiagnostic $ mkPlainError noHints $ cannotFindModule hsc_env wanted_mod err {-@@ -2413,7 +2414,7 @@ -- Localise the hsc_env to use the cached flags hscSetFlags lcl_dynflags $ hydrated_hsc_env- -- Compile the module, locking with a semphore to avoid too many modules+ -- Compile the module, locking with a semaphore to avoid too many modules -- being compiled at the same time leading to high memory usage. wrapAction lcl_hsc_env $ do res <- upsweep_mod lcl_hsc_env env_messager old_hmi mod k n@@ -2631,9 +2632,9 @@ data XT = MkX T fx = ...g... ```-If in `--make` we compile R.hs-boot, then A.hs, then X.hs, we'll get a `ModDetails` for `X` that has an AbstractTyCon for `T` in the the argument type of `MkX`. So:+If in `--make` we compile R.hs-boot, then A.hs, then X.hs, we'll get a `ModDetails` for `X` that has an AbstractTyCon for `T` in the argument type of `MkX`. So: -* Either we should delay compiling X until after R has beeen compiled. (This is what we do)+* Either we should delay compiling X until after R has been compiled. (This is what we do) * Or we should rehydrate X after compiling R -- because it transitively depends on R.hs-boot. Ticket #20200 has exposed some issues to do with the knot-tying logic in GHC.Make, in `--make` mode.@@ -2845,7 +2846,7 @@ MC.bracket spawn_actions kill_actions $ \_ -> do mapM_ waitMakeAction acts --- | Execute each action in order, limiting the amount of parrelism by the given+-- | Execute each action in order, limiting the amount of parallelism by the given -- semaphore. runLoop :: (((forall a. IO a -> IO a) -> IO ()) -> IO a) -> MakeEnv -> [MakeAction] -> IO [a] runLoop _ _env [] = return []
compiler/GHC/Driver/MakeFile.hs view
@@ -27,6 +27,7 @@ import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Utils.Panic.Plain+import GHC.Types.Error (UnknownDiagnostic(..)) import GHC.Types.SourceError import GHC.Types.SrcLoc import GHC.Types.PkgQual@@ -260,7 +261,7 @@ -- Emit a dependency for each CPP import ; when (depIncludeCppDeps dflags) $ do- -- CPP deps are descovered in the module parsing phase by parsing+ -- CPP deps are discovered in the module parsing phase by parsing -- comment lines left by the preprocessor. -- Note that GHC.parseModule may throw an exception if the module -- fails to parse, which may not be desirable (see #16616).@@ -306,7 +307,8 @@ fail -> throwOneError $ mkPlainErrorMsgEnvelope srcloc $- GhcDriverMessage $ DriverUnknownMessage $ mkPlainError noHints $+ GhcDriverMessage $ DriverUnknownMessage $+ UnknownDiagnostic $ mkPlainError noHints $ cannotFindModule hsc_env imp fail -----------------------------
compiler/GHC/Driver/Pipeline.hs view
@@ -96,7 +96,7 @@ import GHC.Types.Basic ( SuccessFlag(..), ForeignSrcLang(..) )-import GHC.Types.Error ( singleMessage, getMessages )+import GHC.Types.Error ( singleMessage, getMessages, UnknownDiagnostic (..) ) import GHC.Types.Target import GHC.Types.SrcLoc import GHC.Types.SourceFile@@ -155,7 +155,7 @@ handler (ProgramError msg) = return $ Left $ singleMessage $ mkPlainErrorMsgEnvelope srcspan $- DriverUnknownMessage $ mkPlainError noHints $ text msg+ DriverUnknownMessage $ UnknownDiagnostic $ mkPlainError noHints $ text msg handler ex = throwGhcExceptionIO ex to_driver_messages :: Messages GhcMessage -> Messages DriverMessage@@ -589,7 +589,7 @@ -- This should never happen as viaCPipeline should only return `Nothing` when the stop phase is `StopC`. -- and the same should never happen for asPipeline -- Future refactoring to not check StopC for this case- Nothing -> pprPanic "compileForeign" (ppr stub_c)+ Nothing -> pprPanic "compileForeign" (text stub_c) Just fp -> return fp compileEmptyStub :: DynFlags -> HscEnv -> FilePath -> ModLocation -> ModuleName -> IO ()@@ -897,7 +897,7 @@ `TPipelineClass` to give different behaviours that the default `HookedPhase` implementation: * Additional logging of different phases-* Automatic parrelism (in the style of shake)+* Automatic parallelism (in the style of shake) * Easy consumption by external tools such as ghcide * Easier to create your own pipeline and extend existing pipelines.
compiler/GHC/Driver/Pipeline/Execute.hs view
@@ -584,7 +584,7 @@ -- Unicode or anything else (so we don't use Util.charToC -- here). If we get this wrong, then in -- GHC.HsToCore.Ticks.isGoodTickSrcSpan where we check that the filename in- -- a SrcLoc is the same as the source filenaame, the two will+ -- a SrcLoc is the same as the source filename, the two will -- look bogusly different. See test: -- libraries/hpc/tests/function/subdir/tough2.hs escape ('\\':cs) = '\\':'\\': escape cs@@ -838,7 +838,7 @@ | StopLn <- next_phase, Just loc <- maybe_location = return $ if dynamicNow dflags then ml_dyn_obj_file loc else ml_obj_file loc- -- 2. If output style is persistant then+ -- 2. If output style is persistent then | is_last_phase, Persistent <- output = persistent_fn -- 3. Specific file is only set when outputFile is set by -o -- If we are in dynamic mode but -dyno is not set then write to the same path as@@ -860,9 +860,11 @@ | otherwise = newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule suffix where- getOutputFile_ dflags = case outputFile_ dflags of- Nothing -> pprPanic "SpecificFile: No filename" (ppr $ (dynamicNow dflags, outputFile_ dflags, dynOutputFile_ dflags))- Just fn -> fn+ getOutputFile_ dflags =+ case outputFile_ dflags of+ Nothing -> pprPanic "SpecificFile: No filename" (ppr (dynamicNow dflags) $$+ text (fromMaybe "-" (dynOutputFile_ dflags)))+ Just fn -> fn hcsuf = hcSuf dflags odir = objectDir dflags@@ -1136,7 +1138,7 @@ Note [Object merging] ~~~~~~~~~~~~~~~~~~~~~ On most platforms one can "merge" a set of relocatable object files into a new,-partiall-linked-but-still-relocatable object. In a typical UNIX-style linker,+partially-linked-but-still-relocatable object. In a typical UNIX-style linker, this is accomplished with the `ld -r` command. We rely on this for two ends: * We rely on `ld -r` to squash together split sections, making GHCi loading@@ -1367,7 +1369,7 @@ At some point during compilation with -fhpc, in the function `GHC.HsToCore.Ticks.isGoodTickSrcSpan`, we compare the filename that a `SrcSpan` refers to with the name of the file we are currently compiling.- For some reason I don't yet understand, they can sometimes legitimally be+ For some reason I don't yet understand, they can sometimes legitimately be different, and then hpc ignores that SrcSpan. Problem
compiler/GHC/HsToCore.hs view
@@ -359,8 +359,7 @@ addExportFlagsAndRules :: Backend -> NameSet -> NameSet -> [CoreRule] -> [(Id, t)] -> [(Id, t)]-addExportFlagsAndRules bcknd exports keep_alive rules prs- = mapFst add_one prs+addExportFlagsAndRules bcknd exports keep_alive rules = mapFst add_one where add_one bndr = add_rules name (add_export name bndr) where@@ -788,7 +787,7 @@ info = noCafIdInfo `setInlinePragInfo` alwaysInlinePragma- `setUnfoldingInfo` mkCompulsoryUnfolding' rhs+ `setUnfoldingInfo` mkCompulsoryUnfolding rhs `setArityInfo` arity ty = mkSpecForAllTys [ runtimeRep1TyVar, runtimeRep2TyVar
compiler/GHC/HsToCore/Binds.hs view
@@ -390,7 +390,7 @@ makeCorePair dflags gbl_id is_default_method dict_arity rhs | is_default_method -- Default methods are *always* inlined -- See Note [INLINE and default methods] in GHC.Tc.TyCl.Instance- = (gbl_id `setIdUnfolding` mkCompulsoryUnfolding simpl_opts rhs, rhs)+ = (gbl_id `setIdUnfolding` mkCompulsoryUnfolding' simpl_opts rhs, rhs) | otherwise = case inlinePragmaSpec inline_prag of@@ -402,19 +402,20 @@ where simpl_opts = initSimpleOpts dflags inline_prag = idInlinePragma gbl_id- inlinable_unf = mkInlinableUnfolding simpl_opts rhs+ inlinable_unf = mkInlinableUnfolding simpl_opts StableUserSrc rhs inline_pair | Just arity <- inlinePragmaSat inline_prag -- Add an Unfolding for an INLINE (but not for NOINLINE) -- And eta-expand the RHS; see Note [Eta-expanding INLINE things] , let real_arity = dict_arity + arity- -- NB: The arity in the InlineRule takes account of the dictionaries- = ( gbl_id `setIdUnfolding` mkInlineUnfoldingWithArity real_arity simpl_opts rhs+ -- NB: The arity passed to mkInlineUnfoldingWithArity+ -- must take account of the dictionaries+ = ( gbl_id `setIdUnfolding` mkInlineUnfoldingWithArity simpl_opts StableUserSrc real_arity rhs , etaExpand real_arity rhs) | otherwise = pprTrace "makeCorePair: arity missing" (ppr gbl_id) $- (gbl_id `setIdUnfolding` mkInlineUnfolding simpl_opts rhs, rhs)+ (gbl_id `setIdUnfolding` mkInlineUnfoldingNoArity simpl_opts StableUserSrc rhs, rhs) dictArity :: [Var] -> Arity -- Don't count coercion variables in arity@@ -526,7 +527,7 @@ get to do the inlining, which is a Terribly Bad thing given that the user said "inline"! -To avoid this we pre-emptively eta-expand the definition, so that foo+To avoid this we preemptively eta-expand the definition, so that foo has the arity with which it is declared in the source code. In this example it has arity 2 (one for the Eq and one for x). Doing this should mean that (foo d) is a PAP and we don't share it.@@ -542,7 +543,7 @@ fromT :: T Bool -> Bool { fromT_1 ((TBool b)) = not b } } } -Note the nested AbsBind. The arity for the InlineRule on $cfromT should be+Note the nested AbsBind. The arity for the unfolding on $cfromT should be gotten from the binding for fromT_1. It might be better to have just one level of AbsBinds, but that requires more@@ -976,7 +977,7 @@ But be careful! That dInt might be GHC.Base.$fOrdInt, which is an External Name, and you can't bind them in a lambda or forall without getting things-confused. Likewise it might have an InlineRule or something, which would be+confused. Likewise it might have a stable unfolding or something, which would be utterly bogus. So we really make a fresh Id, with the same unique and type as the old one, but with an Internal name and no IdInfo.
compiler/GHC/HsToCore/Docs.hs view
@@ -28,6 +28,7 @@ import Control.Applicative import Control.Monad.IO.Class import Data.Bifunctor (first)+import Data.Foldable (toList) import Data.IntMap (IntMap) import qualified Data.IntMap as IM import Data.Map.Strict (Map)@@ -366,13 +367,13 @@ -> [(Name, [HsDoc GhcRn], IntMap (HsDoc GhcRn))] dataSubs dd = constrs ++ fields ++ derivs where- cons = map unLoc $ (dd_cons dd)+ cons = unLoc <$> dd_cons dd constrs = [ ( unLoc cname , maybeToList $ fmap unLoc $ con_doc c , conArgDocs c)- | c <- cons, cname <- getConNames c ]+ | c <- toList cons, cname <- getConNames c ] fields = [ (foExt n, maybeToList $ fmap unLoc doc, IM.empty)- | Just flds <- map getRecConArgs_maybe cons+ | Just flds <- toList $ fmap getRecConArgs_maybe cons , (L _ (ConDeclField _ ns _ doc)) <- (unLoc flds) , (L _ n) <- ns ] derivs = [ (instName, [unLoc doc], IM.empty)@@ -534,7 +535,7 @@ -- | Go through all class declarations and filter their sub-declarations filterClasses :: forall p doc. (IsPass p) => [(LHsDecl (GhcPass p), doc)] -> [(LHsDecl (GhcPass p), doc)]-filterClasses = map (first (mapLoc filterClass))+filterClasses = map (first (fmap filterClass)) where filterClass (TyClD x c@(ClassDecl {})) = TyClD x $ c { tcdSigs =@@ -554,7 +555,7 @@ -> (decl -> hsDecl) -> struct -> [GenLocated l hsDecl]-mkDecls field con = map (mapLoc con) . field+mkDecls field con = map (fmap con) . field -- | Extracts out individual maps of documentation added via Template Haskell's -- @putDoc@.
compiler/GHC/HsToCore/Expr.hs view
@@ -325,7 +325,7 @@ Notice it's crucial we still desugar to the correct (negate (fromIntegral ...)) despite performing the negation in order to check whether the application of negate will overflow.-For a user written Integer instance we can't predict the interation of negate and fromIntegral.+For a user written Integer instance we can't predict the interaction of negate and fromIntegral. Also note that this works for detecting the right result for `-128 :: Int8`.. which is in-range for Int8 but the correct result is achieved via two overflows.@@ -468,12 +468,12 @@ \begin{verbatim} T { op2 = e } ==>- let err = /\a -> recConErr a- T (recConErr t1 "M.hs/230/op1")+ let err = /\a -> recConError a+ T (recConError t1 "M.hs/230/op1") e- (recConErr t1 "M.hs/230/op3")+ (recConError t1 "M.hs/230/op3") \end{verbatim}-@recConErr@ then converts its argument string into a proper message+@recConError@ then converts its argument string into a proper message before printing it as \begin{verbatim} M.hs, line 230: missing field op1 was evaluated@@ -592,7 +592,7 @@ At the moment we use a simple heuristic to determine whether build will be fruitful: for small lists we assume the benefits of fusion will be worthwhile;-for long lists we assume that the benefits will be outweighted by the cost of+for long lists we assume that the benefits will be outweighed by the cost of code duplication. This magic length threshold is @maxBuildLength@. Also, fusion won't work at all if rewrite rules are disabled, so we don't use the build-based desugaring in this case.
compiler/GHC/HsToCore/Foreign/C.hs view
@@ -324,16 +324,15 @@ wrap_rhs = mkLams (tvs ++ args) wrapper_body wrap_rhs' = Cast wrap_rhs co simpl_opts = initSimpleOpts dflags- fn_id_w_inl = fn_id `setIdUnfolding` mkInlineUnfoldingWithArity- (length args)- simpl_opts+ fn_id_w_inl = fn_id `setIdUnfolding` mkInlineUnfoldingWithArity simpl_opts+ StableSystemSrc (length args) wrap_rhs' return ([(work_id, work_rhs), (fn_id_w_inl, wrap_rhs')], mempty, CStub cDoc [] []) toCName :: Id -> String-toCName i = renderWithContext defaultSDocContext (pprCode (ppr (idName i)))+toCName i = showSDocOneLine defaultSDocContext (pprCode (ppr (idName i))) toCType :: Type -> (Maybe Header, SDoc) toCType = f False
compiler/GHC/HsToCore/Match.hs view
@@ -753,7 +753,7 @@ it creates another equation if the match can fail (see @GHC.HsToCore.Expr.doDo@ function) \item @let@ patterns, are treated by @matchSimply@- List Comprension Patterns, are treated by @matchSimply@ also+ List Comprehension Patterns, are treated by @matchSimply@ also \end{itemize} We can't call @matchSimply@ with Lambda patterns,
compiler/GHC/HsToCore/Match/Constructor.hs view
@@ -36,8 +36,8 @@ import GHC.Utils.Panic import GHC.Utils.Panic.Plain import Control.Monad(liftM)-import Data.List (groupBy) import Data.List.NonEmpty (NonEmpty(..))+import qualified Data.List.NonEmpty as NE {- We are confronted with the first column of patterns in a set of@@ -143,13 +143,13 @@ -- and returns the types of the *value* args, which is what we want match_group :: [Id]- -> [(ConArgPats, EquationInfo)] -> DsM (MatchResult CoreExpr)+ -> NonEmpty (ConArgPats, EquationInfo)+ -> DsM (MatchResult CoreExpr) -- All members of the group have compatible ConArgPats match_group arg_vars arg_eqn_prs- = assert (notNull arg_eqn_prs) $- do { (wraps, eqns') <- liftM unzip (mapM shift arg_eqn_prs)+ = do { (wraps, eqns') <- liftM NE.unzip (mapM shift arg_eqn_prs) ; let group_arg_vars = select_arg_vars arg_vars arg_eqn_prs- ; match_result <- match (group_arg_vars ++ vars) ty eqns'+ ; match_result <- match (group_arg_vars ++ vars) ty (NE.toList eqns') ; return $ foldr1 (.) wraps <$> match_result } @@ -184,9 +184,9 @@ -- suggestions for the new variables -- Divide into sub-groups; see Note [Record patterns]- ; let groups :: [[(ConArgPats, EquationInfo)]]- groups = groupBy compatible_pats [ (pat_args (firstPat eqn), eqn)- | eqn <- eqn1:eqns ]+ ; let groups :: NonEmpty (NonEmpty (ConArgPats, EquationInfo))+ groups = NE.groupBy1 compatible_pats+ $ fmap (\eqn -> (pat_args (firstPat eqn), eqn)) (eqn1 :| eqns) ; match_results <- mapM (match_group arg_vars) groups @@ -210,8 +210,8 @@ -- Choose the right arg_vars in the right order for this group -- Note [Record patterns]- select_arg_vars :: [Id] -> [(ConArgPats, EquationInfo)] -> [Id]- select_arg_vars arg_vars ((arg_pats, _) : _)+ select_arg_vars :: [Id] -> NonEmpty (ConArgPats, EquationInfo) -> [Id]+ select_arg_vars arg_vars ((arg_pats, _) :| _) | RecCon flds <- arg_pats , let rpats = rec_flds flds , not (null rpats) -- Treated specially; cf conArgPats@@ -224,7 +224,6 @@ fld_var_env = mkNameEnv $ zipEqual "get_arg_vars" fields1 arg_vars lookup_fld (L _ rpat) = lookupNameEnv_NF fld_var_env (idName (hsRecFieldId rpat))- select_arg_vars _ [] = panic "matchOneCon/select_arg_vars []" ----------------- compatible_pats :: (ConArgPats,a) -> (ConArgPats,a) -> Bool
compiler/GHC/HsToCore/Match/Literal.hs view
@@ -118,7 +118,7 @@ There is a fun wrinkle to this, we used to simply compute the value for these literals and store it as `Rational`. While this might seem reasonable it meant typechecking literals of extremely large numbers-wasn't possible. This happend for example in #15646.+wasn't possible. This happened for example in #15646. There a user would write in GHCi e.g. `:t 1e1234111111111111111111111` which would trip up the compiler. The reason being we would parse it as
compiler/GHC/HsToCore/Monad.hs view
@@ -167,11 +167,11 @@ | MR_Fallible (CoreExpr -> DsM a) deriving (Functor) --- | Product is an "or" on falliblity---the combined match result is infallible+-- | Product is an "or" on fallibility---the combined match result is infallible -- only if the left and right argument match results both were. -- -- This is useful for combining a bunch of alternatives together and then--- getting the overall falliblity of the entire group. See 'mkDataConCase' for+-- getting the overall fallibility of the entire group. See 'mkDataConCase' for -- an example. instance Applicative MatchResult where pure v = MR_Infallible (pure v)
compiler/GHC/HsToCore/Pmc.hs view
@@ -318,7 +318,7 @@ -- * Formatting and reporting warnings -- --- | A datatype to accomodate the different call sites of+-- | A datatype to accommodate the different call sites of -- 'formatReportWarnings'. Used for extracting 'CIRB's from a concrete 'ann' -- through 'collectInMode'. Since this is only possible for a couple of -- well-known 'ann's, this is a GADT.
compiler/GHC/HsToCore/Pmc/Desugar.hs view
@@ -487,7 +487,7 @@ instances such as @Sing (a :: Bool)@ are a good example of this: If we would just drop the coercion, we'd get a type error when matching @pat@ against its value abstraction, with the result being that pmIsSatisfiable decides that every-possible data constructor fitting @pat@ is rejected as uninhabitated, leading to+possible data constructor fitting @pat@ is rejected as uninhabited, leading to a lot of false warnings. But we can check whether the coercion is a hole or if it is just refl, in
compiler/GHC/HsToCore/Pmc/Solver.hs view
@@ -409,7 +409,7 @@ -- (See "Type#type_classification" for what an algebraic type is.) -- -- This is qualified with \"like\" because of a particular special- -- case: TYPE (the underlyind kind behind Type, among others). TYPE+ -- case: TYPE (the underlying kind behind Type, among others). TYPE -- is conceptually a datatype (and thus algebraic), but in practice it is -- a primitive builtin type, so we must check for it specially. --@@ -1067,7 +1067,7 @@ * @x ~ Just y@, @x ≁ [Just]@. 'eqPmAltCon' returns @Equal@, so refute. * @x ~ Nothing@, @x ≁ [Just]@. 'eqPmAltCon' returns @Disjoint@, so negative info is redundant and should be discarded.-* @x ~ I# y@, @x ≁ [4,2]@. 'eqPmAltCon' returns @PossiblyOverlap@, so orthogal.+* @x ~ I# y@, @x ≁ [4,2]@. 'eqPmAltCon' returns @PossiblyOverlap@, so orthogonal. We keep this info in order to be able to refute a redundant match on i.e. 4 later on. @@ -1344,7 +1344,7 @@ -- Internally uses and updates the CompleteMatchs in vi_rcm. -- -- NB: Does /not/ filter each CompleteMatch with the oracle; members may--- remain that do not statisfy it. This lazy approach just+-- remain that do not satisfy it. This lazy approach just -- avoids doing unnecessary work. instantiate :: Int -> Nabla -> VarInfo -> MaybeT DsM VarInfo instantiate fuel nabla vi = {-# SCC "instantiate" #-}@@ -1481,7 +1481,7 @@ compareConLikeTestability :: ConLike -> ConLike -> Ordering -- We should instantiate DataCons first, because they are likely to occur in -- multiple COMPLETE sets at once and we might find that multiple COMPLETE sets--- are inhabitated by instantiating only a single DataCon.+-- are inhabited by instantiating only a single DataCon. compareConLikeTestability PatSynCon{} _ = GT compareConLikeTestability _ PatSynCon{} = GT compareConLikeTestability (RealDataCon a) (RealDataCon b) = mconcat@@ -1620,7 +1620,7 @@ definition be flagged as inexhaustive (no false positives). Via the LYG algorithm, we reduce both these properties to a property on-the inhabitation test of refinementment types:+the inhabitation test of refinement types: *Soundness*: If the inhabitation test says "no" for a given refinement type Nabla, then it provably has no inhabitant. *Completeness*: If the inhabitation test says "yes" for a given refinement type@@ -1736,7 +1736,7 @@ check if `MkT` is inhabitable in each of those three fields, which in turn will require us to check if `MkT` is inhabitable again... As you can see, the branching factor adds up quickly, and if the initial fuel is, say,-100, then the inhabiation test will effectively take forever.+100, then the inhabitation test will effectively take forever. To mitigate this, we check the branching factor every time we are about to do inhabitation testing in 'instCon'. If the branching factor exceeds 1@@ -1837,7 +1837,7 @@ Note [Instantiating a ConLike] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-`instCon` implements the the \(Inst\) function from Figure 8 of the LYG paper.+`instCon` implements the \(Inst\) function from Figure 8 of the LYG paper. Given the following type of ConLike `K`
compiler/GHC/HsToCore/Quote.hs view
@@ -98,6 +98,7 @@ import Data.Function import Control.Monad.Trans.Reader import Control.Monad.Trans.Class+import Data.Foldable ( toList ) data MetaWrappers = MetaWrappers { -- Applies its argument to a type argument `m` and dictionary `Quote m`@@ -517,17 +518,16 @@ -> HsDataDefn GhcRn -> MetaM (Core (M TH.Dec)) repDataDefn tc opts- (HsDataDefn { dd_ND = new_or_data, dd_ctxt = cxt, dd_kindSig = ksig+ (HsDataDefn { dd_ctxt = cxt, dd_kindSig = ksig , dd_cons = cons, dd_derivs = mb_derivs }) = do { cxt1 <- repLContext cxt ; derivs1 <- repDerivs mb_derivs- ; case (new_or_data, cons) of- (NewType, [con]) -> do { con' <- repC con+ ; case cons of+ NewTypeCon con -> do { con' <- repC con ; ksig' <- repMaybeLTy ksig ; repNewtype cxt1 tc opts ksig' con' derivs1 }- (NewType, _) -> lift $ failWithDs (DsMultipleConForNewtype (getConNames $ unLoc $ head cons))- (DataType, _) -> do { ksig' <- repMaybeLTy ksig+ DataTypeCons _ cons -> do { ksig' <- repMaybeLTy ksig ; consL <- mapM repC cons ; cons1 <- coreListM conTyConName consL ; repData cxt1 tc opts ksig' cons1@@ -2704,7 +2704,7 @@ arg_vtys <- repRecConArgs ips rep2 recCName [unC con', unC arg_vtys] -repGadtDataCons :: [LocatedN Name]+repGadtDataCons :: NonEmpty (LocatedN Name) -> HsConDeclGADTDetails GhcRn -> LHsType GhcRn -> MetaM (Core (M TH.Con))@@ -2714,11 +2714,11 @@ PrefixConGADT ps -> do arg_tys <- repPrefixConArgs ps res_ty' <- repLTy res_ty- rep2 gadtCName [ unC (nonEmptyCoreList cons'), unC arg_tys, unC res_ty']+ rep2 gadtCName [ unC (nonEmptyCoreList' cons'), unC arg_tys, unC res_ty'] RecConGADT ips _ -> do arg_vtys <- repRecConArgs ips res_ty' <- repLTy res_ty- rep2 recGadtCName [unC (nonEmptyCoreList cons'), unC arg_vtys,+ rep2 recGadtCName [unC (nonEmptyCoreList' cons'), unC arg_vtys, unC res_ty'] -- TH currently only supports linear constructors.@@ -3001,6 +3001,8 @@ nonEmptyCoreList [] = panic "coreList: empty argument" nonEmptyCoreList xs@(MkC x:_) = MkC (mkListExpr (exprType x) (map unC xs)) +nonEmptyCoreList' :: NonEmpty (Core a) -> Core [a]+nonEmptyCoreList' xs@(MkC x:|_) = MkC (mkListExpr (exprType x) (toList $ fmap unC xs)) coreStringLit :: MonadThings m => String -> m (Core String) coreStringLit s = do { z <- mkStringExpr s; return(MkC z) }
compiler/GHC/HsToCore/Ticks.hs view
@@ -35,7 +35,6 @@ import GHC.Utils.Outputable as Outputable import GHC.Utils.Panic-import GHC.Utils.Monad import GHC.Utils.Logger import GHC.Types.SrcLoc import GHC.Types.Basic@@ -528,7 +527,7 @@ (addTickLHsExprOptAlt True e3) addTickHsExpr (HsMultiIf ty alts) = do { let isOneOfMany = case alts of [_] -> False; _ -> True- ; alts' <- mapM (liftL $ addTickGRHS isOneOfMany False) alts+ ; alts' <- mapM (traverse $ addTickGRHS isOneOfMany False) alts ; return $ HsMultiIf ty alts' } addTickHsExpr (HsLet x tkLet binds tkIn e) = bindLocals (collectLocalBinders CollNoDictBinders binds) $ do@@ -586,7 +585,7 @@ addTickHsExpr (HsProc x pat cmdtop) = liftM2 (HsProc x) (addTickLPat pat)- (liftL (addTickHsCmdTop) cmdtop)+ (traverse (addTickHsCmdTop) cmdtop) addTickHsExpr (XExpr (WrapExpr (HsWrap w e))) = liftM (XExpr . WrapExpr . HsWrap w) $ (addTickHsExpr e) -- Explicitly no tick on inside@@ -615,7 +614,7 @@ -> TM (MatchGroup GhcTc (LHsExpr GhcTc)) addTickMatchGroup is_lam mg@(MG { mg_alts = L l matches }) = do let isOneOfMany = matchesOneOfMany matches- matches' <- mapM (liftL (addTickMatch isOneOfMany is_lam)) matches+ matches' <- mapM (traverse (addTickMatch isOneOfMany is_lam)) matches return $ mg { mg_alts = L l matches' } addTickMatch :: Bool -> Bool -> Match GhcTc (LHsExpr GhcTc)@@ -631,7 +630,7 @@ addTickGRHSs isOneOfMany isLambda (GRHSs x guarded local_binds) = bindLocals binders $ do local_binds' <- addTickHsLocalBinds local_binds- guarded' <- mapM (liftL (addTickGRHS isOneOfMany isLambda)) guarded+ guarded' <- mapM (traverse (addTickGRHS isOneOfMany isLambda)) guarded return $ GRHSs x guarded' local_binds' where binders = collectLocalBinders CollNoDictBinders local_binds@@ -665,7 +664,7 @@ -> TM ([ExprLStmt GhcTc], a) addTickLStmts' isGuard lstmts res = bindLocals (collectLStmtsBinders CollNoDictBinders lstmts) $- do { lstmts' <- mapM (liftL (addTickStmt isGuard)) lstmts+ do { lstmts' <- mapM (traverse (addTickStmt isGuard)) lstmts ; a <- res ; return (lstmts', a) } @@ -709,7 +708,7 @@ , trS_ret = returnExpr, trS_bind = bindExpr , trS_fmap = liftMExpr }) = do t_s <- addTickLStmts isGuard stmts- t_y <- fmapMaybeM addTickLHsExprRHS by+ t_y <- traverse addTickLHsExprRHS by t_u <- addTickLHsExprRHS using t_f <- addTickSyntaxExpr hpcSrcSpan returnExpr t_b <- addTickSyntaxExpr hpcSrcSpan bindExpr@@ -782,7 +781,7 @@ addTickHsIPBinds (IPBinds dictbinds ipbinds) = liftM2 IPBinds (return dictbinds)- (mapM (liftL (addTickIPBind)) ipbinds)+ (mapM (traverse (addTickIPBind)) ipbinds) addTickIPBind :: IPBind GhcTc -> TM (IPBind GhcTc) addTickIPBind (IPBind x nm e) =@@ -859,7 +858,7 @@ (addTickLHsExpr e) (return f) (return fix)- (mapM (liftL (addTickHsCmdTop)) cmdtop)+ (mapM (traverse (addTickHsCmdTop)) cmdtop) addTickHsCmd (XCmd (HsWrap w cmd)) = liftM XCmd $@@ -871,7 +870,7 @@ addTickCmdMatchGroup :: MatchGroup GhcTc (LHsCmd GhcTc) -> TM (MatchGroup GhcTc (LHsCmd GhcTc)) addTickCmdMatchGroup mg@(MG { mg_alts = (L l matches) }) = do- matches' <- mapM (liftL addTickCmdMatch) matches+ matches' <- mapM (traverse addTickCmdMatch) matches return $ mg { mg_alts = L l matches' } addTickCmdMatch :: Match GhcTc (LHsCmd GhcTc) -> TM (Match GhcTc (LHsCmd GhcTc))@@ -884,7 +883,7 @@ addTickCmdGRHSs (GRHSs x guarded local_binds) = bindLocals binders $ do local_binds' <- addTickHsLocalBinds local_binds- guarded' <- mapM (liftL addTickCmdGRHS) guarded+ guarded' <- mapM (traverse addTickCmdGRHS) guarded return $ GRHSs x guarded' local_binds' where binders = collectLocalBinders CollNoDictBinders local_binds@@ -907,7 +906,7 @@ -> TM ([LStmt GhcTc (LHsCmd GhcTc)], a) addTickLCmdStmts' lstmts res = bindLocals binders $ do- lstmts' <- mapM (liftL addTickCmdStmt) lstmts+ lstmts' <- mapM (traverse addTickCmdStmt) lstmts a <- res return (lstmts', a) where
compiler/GHC/HsToCore/Utils.hs view
@@ -422,7 +422,7 @@ Adding 'f x False = error "Non-exhaustive pattern..."' would violate the linearity of x.-Instead, we use 'f x False = case error "Non-exhausive pattern..." :: () of {}'.+Instead, we use 'f x False = case error "Non-exhaustive pattern..." :: () of {}'. This case expression accounts for linear variables by assigning bottom usage (See Note [Bottom as a usage] in GHC.Core.Multiplicity). This is done in mkErrorAppDs, called from mkFailExpr.@@ -494,7 +494,7 @@ let chp = case b of { True -> fst x; False -> 0 } case chp of _ { I# -> ...chp... } - But since chp is cheap, and the case is an alluring contet, we'll+ But since chp is cheap, and the case is an alluring context, we'll inline chp into the case scrutinee. Now there is only one use of chp, so we'll inline a second copy. Alas, we've now ruined the purpose of the seq, by re-introducing the space leak:@@ -1066,7 +1066,7 @@ -- Returns Just {..} if we're sure that the expression is True -- I.e. * 'True' datacon -- * 'otherwise' Id--- * Trivial wappings of these+-- * Trivial wrappings of these -- The arguments to Just are any HsTicks that we have found, -- because we still want to tick then, even it they are always evaluated. isTrueLHsExpr (L _ (HsVar _ (L _ v)))
compiler/GHC/Iface/Binary.hs view
@@ -118,7 +118,7 @@ check_tag <- get bh let tag = profileBuildTag profile- wantedGot "Way" tag check_tag ppr+ wantedGot "Way" tag check_tag text when (checkHiWay == CheckHiWay) $ errorOnMismatch "mismatched interface file profile tag" tag check_tag @@ -381,7 +381,7 @@ in return $! case lookupKnownKeyName u of Nothing -> pprPanic "getSymtabName:unknown known-key unique"- (ppr i $$ ppr (unpkUnique u))+ (ppr i $$ ppr u) Just n -> n _ -> pprPanic "getSymtabName:unknown name tag" (ppr i)
compiler/GHC/Iface/Ext/Ast.hs view
@@ -69,7 +69,9 @@ import qualified Data.Map as M import qualified Data.Set as S import Data.Data ( Data, Typeable )+import Data.Foldable ( toList ) import Data.Functor.Identity ( Identity(..) )+import Data.List.NonEmpty ( NonEmpty(..) ) import Data.Void ( Void, absurd ) import Control.Monad ( forM_ ) import Control.Monad.Trans.State.Strict@@ -556,6 +558,9 @@ loc [] = noSrcSpan loc xs = foldl1' combineSrcSpans $ map loc xs +instance HasLoc a => HasLoc (DataDefnCons a) where+ loc = loc . toList+ instance (HasLoc a, HiePass p) => HasLoc (FamEqn (GhcPass p) a) where loc (FamEqn _ a outer_bndrs b _ c) = case outer_bndrs of HsOuterImplicit{} ->@@ -589,6 +594,12 @@ instance (ToHie a) => ToHie [a] where toHie = concatMapM toHie +instance (ToHie a) => ToHie (NonEmpty a) where+ toHie = concatMapM toHie++instance (ToHie a) => ToHie (DataDefnCons a) where+ toHie = concatMapM toHie+ instance (ToHie a) => ToHie (Bag a) where toHie = toHie . bagToList @@ -944,7 +955,7 @@ name' :: LocatedN Name name' = case hiePass @p of HieRn -> name- HieTc -> mapLoc varName name+ HieTc -> fmap varName name toHie (StmtCtxt a) = toHie a toHie _ = pure [] @@ -1474,8 +1485,8 @@ quant_scope = mkLScopeA $ fromMaybe (noLocA []) $ dd_ctxt defn rhs_scope = sig_sc `combineScopes` con_sc `combineScopes` deriv_sc sig_sc = maybe NoScope mkLScopeA $ dd_kindSig defn- con_sc = foldr combineScopes NoScope $ map mkLScopeA $ dd_cons defn- deriv_sc = foldr combineScopes NoScope $ map mkLScopeA $ dd_derivs defn+ con_sc = foldr combineScopes NoScope $ mkLScopeA <$> dd_cons defn+ deriv_sc = foldr combineScopes NoScope $ mkLScopeA <$> dd_derivs defn ClassDecl { tcdCtxt = context , tcdLName = name , tcdTyVars = vars@@ -1568,7 +1579,7 @@ ] instance ToHie (HsDataDefn GhcRn) where- toHie (HsDataDefn _ _ ctx _ mkind cons derivs) = concatM+ toHie (HsDataDefn _ ctx _ mkind cons derivs) = concatM [ toHie ctx , toHie mkind , toHie cons@@ -1611,7 +1622,7 @@ ConDeclGADT { con_names = names, con_bndrs = L outer_bndrs_loc outer_bndrs , con_mb_cxt = ctx, con_g_args = args, con_res_ty = typ , con_doc = doc} ->- [ toHie $ map (C (Decl ConDec $ getRealSpanA span)) names+ [ toHie $ C (Decl ConDec $ getRealSpanA span) <$> names , case outer_bndrs of HsOuterImplicit{hso_ximplicit = imp_vars} -> bindingsOnly $ map (C $ TyVarBind (mkScopeA outer_bndrs_loc) resScope)
compiler/GHC/Iface/Ext/Binary.hs view
@@ -331,7 +331,7 @@ KnownKeyName u -> case lookupKnownKeyName u of Nothing -> pprPanic "fromHieName:unknown known-key unique"- (ppr (unpkUnique u))+ (ppr u) Just n -> pure n -- ** Reading and writing `HieName`'s
compiler/GHC/Iface/Ext/Types.hs view
@@ -28,7 +28,6 @@ import GHC.Types.Avail import GHC.Types.Unique import qualified GHC.Utils.Outputable as O ( (<>) )-import GHC.Utils.Misc import GHC.Utils.Panic import qualified Data.Array as A@@ -41,6 +40,7 @@ import Control.Applicative ( (<|>) ) import Data.Coerce ( coerce ) import Data.Function ( on )+import qualified Data.Semigroup as S type Span = RealSrcSpan @@ -621,7 +621,7 @@ ppr RecFieldDecl = text "declaration" ppr RecFieldAssign = text "assignment" ppr RecFieldMatch = text "pattern match"- ppr RecFieldOcc = text "occurence"+ ppr RecFieldOcc = text "occurrence" instance Binary RecFieldContext where put_ bh b = putByte bh (fromIntegral (fromEnum b))@@ -751,9 +751,9 @@ deriving (Eq) instance Ord HieName where- compare (ExternalName a b c) (ExternalName d e f) = compare (a,b) (d,e) `thenCmp` leftmost_smallest c f+ compare (ExternalName a b c) (ExternalName d e f) = compare (a,b) (d,e) S.<> leftmost_smallest c f -- TODO (int-index): Perhaps use RealSrcSpan in HieName?- compare (LocalName a b) (LocalName c d) = compare a c `thenCmp` leftmost_smallest b d+ compare (LocalName a b) (LocalName c d) = compare a c S.<> leftmost_smallest b d -- TODO (int-index): Perhaps use RealSrcSpan in HieName? compare (KnownKeyName a) (KnownKeyName b) = nonDetCmpUnique a b -- Not actually non deterministic as it is a KnownKey@@ -774,7 +774,7 @@ case lookupKnownKeyName u of Just n -> nameOccName n Nothing -> pprPanic "hieNameOcc:unknown known-key unique"- (ppr (unpkUnique u))+ (ppr u) toHieName :: Name -> HieName toHieName name
compiler/GHC/Iface/Load.hs view
@@ -300,7 +300,7 @@ loadSrcInterface doc mod want_boot maybe_pkg = do { res <- loadSrcInterface_maybe doc mod want_boot maybe_pkg ; case res of- Failed err -> failWithTc (TcRnUnknownMessage $ mkPlainError noHints err)+ Failed err -> failWithTc (mkTcRnUnknownMessage $ mkPlainError noHints err) Succeeded iface -> return iface } -- | Like 'loadSrcInterface', but returns a 'MaybeErr'.
compiler/GHC/Iface/Make.hs view
@@ -77,7 +77,7 @@ import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Utils.Panic.Plain-import GHC.Utils.Misc hiding ( eqListBy )+import GHC.Utils.Misc import GHC.Utils.Logger import GHC.Utils.Trace
compiler/GHC/Iface/Recomp.hs view
@@ -44,7 +44,7 @@ import GHC.Utils.Panic import GHC.Utils.Panic.Plain import GHC.Utils.Outputable as Outputable-import GHC.Utils.Misc as Utils hiding ( eqListBy )+import GHC.Utils.Misc as Utils import GHC.Utils.Binary import GHC.Utils.Fingerprint import GHC.Utils.Exception@@ -653,14 +653,14 @@ text "package " <> quotes (ppr old) <> text "no longer in dependencies" return $ needsRecompileBecause $ UnitDepRemoved old- check_packages (new:news) olds+ check_packages ((new_name, new_unit):news) olds | Just (old, olds') <- uncons olds- , snd new == old = check_packages (dropWhile ((== (snd new)) . snd) news) olds'+ , new_unit == old = check_packages (dropWhile ((== new_unit) . snd) news) olds' | otherwise = do trace_hi_diffs logger $- text "imported package " <> quotes (ppr new) <>- text " not among previous dependencies"- return $ needsRecompileBecause $ ModulePackageChanged $ fst new+ text "imported package" <+> text new_name <+> ppr new_unit <+>+ text "not among previous dependencies"+ return $ needsRecompileBecause $ ModulePackageChanged new_name needInterface :: Module -> (ModIface -> IO RecompileRequired)@@ -926,7 +926,7 @@ group_fingerprint. Since we included the sequence number in step (1) programs identical up to- transposition of recursive occurrences are distinguisable, avoiding the+ transposition of recursive occurrences are distinguishable, avoiding the second issue mentioned above. 3. Produce the final environment by extending hash_env, mapping each
compiler/GHC/Iface/Rename.hs view
@@ -600,12 +600,8 @@ = pure i rnIfaceUnfolding :: Rename IfaceUnfolding-rnIfaceUnfolding (IfCoreUnfold stable if_expr)- = IfCoreUnfold stable <$> rnIfaceExpr if_expr-rnIfaceUnfolding (IfCompulsory if_expr)- = IfCompulsory <$> rnIfaceExpr if_expr-rnIfaceUnfolding (IfInlineRule arity unsat_ok boring_ok if_expr)- = IfInlineRule arity unsat_ok boring_ok <$> rnIfaceExpr if_expr+rnIfaceUnfolding (IfCoreUnfold src guide if_expr)+ = IfCoreUnfold src guide <$> rnIfaceExpr if_expr rnIfaceUnfolding (IfDFunUnfold bs ops) = IfDFunUnfold <$> rnIfaceBndrs bs <*> mapM rnIfaceExpr ops
compiler/GHC/Iface/Tidy.hs view
@@ -875,9 +875,9 @@ dffvLetBndr :: Bool -> Id -> DFFV () -- Gather the free vars of the RULES and unfolding of a binder -- We always get the free vars of a *stable* unfolding, but--- for a *vanilla* one (InlineRhs), the flag controls what happens:+-- for a *vanilla* one (VanillaSrc), the flag controls what happens: -- True <=> get fvs of even a *vanilla* unfolding--- False <=> ignore an InlineRhs+-- False <=> ignore a VanillaSrc -- For nested bindings (call from dffvBind) we always say "False" because -- we are taking the fvs of the RHS anyway -- For top-level bindings (call from addExternal, via bndrFvsInOrder)@@ -889,10 +889,9 @@ idinfo = idInfo id go_unf (CoreUnfolding { uf_tmpl = rhs, uf_src = src })- = case src of- InlineRhs | vanilla_unfold -> dffvExpr rhs- | otherwise -> return ()- _ -> dffvExpr rhs+ | isStableSource src = dffvExpr rhs+ | vanilla_unfold = dffvExpr rhs+ | otherwise = return () go_unf (DFunUnfolding { df_bndrs = bndrs, df_args = args }) = extendScopeList bndrs $ mapM_ dffvExpr args@@ -1267,7 +1266,7 @@ | Just (_, bot_str_sig, _) <- mb_bot_str = bot_str_sig - -- No stricness info+ -- No strictness info | otherwise = nopSig cpr = cprSigInfo idinfo@@ -1292,7 +1291,6 @@ = tidyTopUnfolding rhs_tidy_env tidy_rhs unf_info | otherwise = minimal_unfold_info--- unf_from_rhs = mkFinalUnfolding uf_opts InlineRhs final_sig orig_rhs -- NB: use `orig_rhs` not `tidy_rhs` in this call to mkFinalUnfolding -- else you get a black hole (#22122). Reason: mkFinalUnfolding -- looks at IdInfo, and that is knot-tied in tidyTopBind (the Rec case)
compiler/GHC/IfaceToCore.hs view
@@ -57,6 +57,7 @@ import GHC.Core import GHC.Core.Unify( RoughMatchTc(..) ) import GHC.Core.Utils+import GHC.Core.Unfold( calcUnfoldingGuidance ) import GHC.Core.Unfold.Make import GHC.Core.Lint import GHC.Core.Make@@ -97,6 +98,7 @@ import GHC.Types.Unique.DSet ( mkUniqDSet ) import GHC.Types.Unique.Set ( nonDetEltsUniqSet ) import GHC.Types.Unique.Supply+import GHC.Types.Demand( isDeadEndSig ) import GHC.Types.Literal import GHC.Types.Var as Var import GHC.Types.Var.Set@@ -576,9 +578,9 @@ Nothing -> return NoSelfBoot -- error cases Just (GWIB { gwib_isBoot = is_boot }) -> case is_boot of- IsBoot -> failWithTc (TcRnUnknownMessage $ mkPlainError noHints (elaborate err))+ IsBoot -> failWithTc (mkTcRnUnknownMessage $ mkPlainError noHints (elaborate err)) -- The hi-boot file has mysteriously disappeared.- NotBoot -> failWithTc (TcRnUnknownMessage $ mkPlainError noHints moduleLoop)+ NotBoot -> failWithTc (mkTcRnUnknownMessage $ mkPlainError noHints moduleLoop) -- Someone below us imported us! -- This is a loop with no hi-boot in the way }}}}@@ -605,7 +607,7 @@ return $ SelfBoot { sb_mds = mds , sb_tcs = mkNameSet tcs } where- -- Retuerns @True@ if, when you call 'tcIfaceDecl' on+ -- Returns @True@ if, when you call 'tcIfaceDecl' on -- this 'IfaceDecl', an ATyCon would be returned. -- NB: This code assumes that a TyCon cannot be implicit. isIfaceTyCon IfaceId{} = False@@ -871,7 +873,7 @@ , ifFieldLabels = field_labels }) = do { traceIf (text "tc_iface_decl" <+> ppr name) ; matcher <- tc_pr if_matcher- ; builder <- fmapMaybeM tc_pr if_builder+ ; builder <- traverse tc_pr if_builder ; bindIfaceForAllBndrs univ_bndrs $ \univ_tvs -> do { bindIfaceForAllBndrs ex_bndrs $ \ex_tvs -> do { patsyn <- forkM (mk_doc name) $@@ -1655,8 +1657,8 @@ need_prag :: IfaceInfoItem -> Bool -- Always read in compulsory unfoldings -- See Note [Always expose compulsory unfoldings] in GHC.Iface.Tidy- need_prag (HsUnfold _ (IfCompulsory {})) = True- need_prag _ = False+ need_prag (HsUnfold _ (IfCoreUnfold src _ _)) = isCompulsorySource src+ need_prag _ = False tcPrag :: IdInfo -> IfaceInfoItem -> IfL IdInfo tcPrag info HsNoCafRefs = return (info `setCafInfo` NoCafRefs)@@ -1716,25 +1718,16 @@ tcUnfolding :: TopLevelFlag -> Name -> Type -> IdInfo -> IfaceUnfolding -> IfL Unfolding -- See Note [Lazily checking Unfoldings]-tcUnfolding toplvl name _ info (IfCoreUnfold stable if_expr)+tcUnfolding toplvl name _ info (IfCoreUnfold src if_guidance if_expr) = do { uf_opts <- unfoldingOpts <$> getDynFlags- ; expr <- tcUnfoldingRhs False toplvl name if_expr- ; let unf_src | stable = InlineStable- | otherwise = InlineRhs- ; return $ mkFinalUnfolding uf_opts unf_src strict_sig expr }+ ; expr <- tcUnfoldingRhs (isCompulsorySource src) toplvl name if_expr+ ; let guidance = case if_guidance of+ IfWhen arity unsat_ok boring_ok -> UnfWhen arity unsat_ok boring_ok+ IfNoGuidance -> calcUnfoldingGuidance uf_opts is_top_bottoming expr+ ; return $ mkCoreUnfolding src True expr guidance } where -- Strictness should occur before unfolding!- strict_sig = dmdSigInfo info--tcUnfolding toplvl name _ _ (IfCompulsory if_expr)- = do { expr <- tcUnfoldingRhs True toplvl name if_expr- ; return $ mkCompulsoryUnfolding' expr }--tcUnfolding toplvl name _ _ (IfInlineRule arity unsat_ok boring_ok if_expr)- = do { expr <- tcUnfoldingRhs False toplvl name if_expr- ; return $ mkCoreUnfolding InlineStable True expr guidance }- where- guidance = UnfWhen { ug_arity = arity, ug_unsat_ok = unsat_ok, ug_boring_ok = boring_ok }+ is_top_bottoming = isTopLevel toplvl && isDeadEndSig (dmdSigInfo info) tcUnfolding _toplvl name dfun_ty _ (IfDFunUnfold bs ops) = bindIfaceBndrs bs $ \ bs' ->@@ -1765,7 +1758,7 @@ Conclusion: `tcUnfolding` must return an `Unfolding` whose `uf_src` field is readable without forcing the `uf_tmpl` field. In particular, all the functions used at the end of-`tcUnfolding` (such as `mkFinalUnfolding`, `mkCompulsoryUnfolding'`, `mkCoreUnfolding`) must be+`tcUnfolding` (such as `mkFinalUnfolding`, `mkCoreUnfolding`) must be lazy in `expr`. Ticket #21139
compiler/GHC/Linker/Loader.hs view
@@ -1505,7 +1505,7 @@ else when (diag_wopt Opt_WarnMissedExtraSharedLib diag_opts) $ logMsg logger- (mkMCDiagnostic diag_opts $ WarningWithFlag Opt_WarnMissedExtraSharedLib)+ (mkMCDiagnostic diag_opts (WarningWithFlag Opt_WarnMissedExtraSharedLib) Nothing) noSrcSpan $ withPprStyle defaultUserStyle (note err) where diag_opts = initDiagOpts (hsc_dflags hsc_env)@@ -1693,7 +1693,7 @@ , not loading_dynamic_hs_libs , interpreterProfiled interp = do- let diag = mkMCDiagnostic diag_opts WarningWithoutFlag+ let diag = mkMCDiagnostic diag_opts WarningWithoutFlag Nothing logMsg logger diag noSrcSpan $ withPprStyle defaultErrStyle $ text "Interpreter failed to load profiled static library" <+> text lib <> char '.' $$ text " \tTrying dynamic library instead. If this fails try to rebuild" <+>@@ -1753,7 +1753,7 @@ -- fork/exec is expensive on Windows, for each time we ask GCC for a library we -- have to eat the cost of af least 3 of these: gcc -> real_gcc -> cc1. -- So instead get a list of location that GCC would search and use findDirs--- which hopefully is written in an optimized mannor to take advantage of+-- which hopefully is written in an optimized manner to take advantage of -- caching. At the very least we remove the overhead of the fork/exec and waits -- which dominate a large percentage of startup time on Windows. getGccSearchDirectory :: Logger -> DynFlags -> String -> IO [FilePath]@@ -1779,9 +1779,9 @@ find :: String -> String -> String find r x = let lst = lines x val = filter (r `isPrefixOf`) lst- in if null val- then []- else case break (=='=') (head val) of+ in case val of+ [] -> []+ x:_ -> case break (=='=') x of (_ , []) -> [] (_, (_:xs)) -> xs
compiler/GHC/Linker/MacOS.hs view
@@ -36,7 +36,7 @@ -- macOS Sierra (10.14). -- -- @-dead_strip_dylibs@ does not dead strip @-rpath@ entries, as such passing--- @-l@ and @-rpath@ to the linker will result in the unnecesasry libraries not+-- @-l@ and @-rpath@ to the linker will result in the unnecessary libraries not -- being included in the load commands, however the @-rpath@ entries are all -- forced to be included. This can lead to 100s of @-rpath@ entries being -- included when only a handful of libraries end up being truly linked.
compiler/GHC/Llvm/Types.hs view
@@ -181,7 +181,7 @@ getLitType (LMIntLit _ t) = t getLitType (LMFloatLit _ t) = t getLitType (LMVectorLit []) = panic "getLitType"-getLitType (LMVectorLit ls) = LMVector (length ls) (getLitType (head ls))+getLitType (LMVectorLit ls@(l:_)) = LMVector (length ls) (getLitType l) getLitType (LMNullLit t) = t getLitType (LMUndefLit t) = t
compiler/GHC/Plugins.hs view
@@ -197,7 +197,7 @@ -- For now, the easiest and recommended way to ensure a consistent -- 'NameCache' is used it to retrieve the preexisting one from an active -- 'HscEnv'. A single 'HscEnv' is created per GHC "session", and this--- ensures everything in that sesssion will getthe same name cache.+-- ensures everything in that session will get the same name cache. thNameToGhcNameIO :: NameCache -> TH.Name -> IO (Maybe Name) thNameToGhcNameIO cache th_name = do { names <- mapMaybeM lookup (thRdrNameGuesses th_name)
compiler/GHC/Rename/Bind.hs view
@@ -493,18 +493,10 @@ bind' = bind { pat_rhs = grhss' , pat_ext = fvs' } - ok_nobind_pat- = -- See Note [Pattern bindings that bind no variables]- case unLoc pat of- WildPat {} -> True- BangPat {} -> True -- #9127, #13646- SplicePat {} -> True- _ -> False- -- Warn if the pattern binds no variables -- See Note [Pattern bindings that bind no variables] ; whenWOptM Opt_WarnUnusedPatternBinds $- when (null bndrs && not ok_nobind_pat) $+ when (null bndrs && not (isOkNoBindPattern pat)) $ addTcRnDiagnostic (TcRnUnusedPatternBinds bind') ; fvs' `seq` -- See Note [Free-variable space leak]@@ -540,29 +532,66 @@ rnBind _ b = pprPanic "rnBind" (ppr b) + -- See Note [Pattern bindings that bind no variables]+isOkNoBindPattern :: LPat GhcRn -> Bool+isOkNoBindPattern (L _ pat) =+ case pat of+ WildPat{} -> True -- Exception (1)+ BangPat {} -> True -- Exception (2) #9127, #13646+ p -> patternContainsSplice p -- Exception (3)++ where+ lpatternContainsSplice :: LPat GhcRn -> Bool+ lpatternContainsSplice (L _ p) = patternContainsSplice p+ patternContainsSplice :: Pat GhcRn -> Bool+ patternContainsSplice p =+ case p of+ -- A top-level splice has been evaluated by this point, so we know the pattern it is evaluated to+ SplicePat (HsUntypedSpliceTop _ p) _ -> patternContainsSplice p+ -- A nested splice isn't evaluated so we can't guess what it will expand to+ SplicePat (HsUntypedSpliceNested {}) _ -> True+ -- The base cases+ VarPat {} -> False+ WildPat {} -> False+ LitPat {} -> False+ NPat {} -> False+ NPlusKPat {} -> False+ -- Recursive cases+ BangPat _ lp -> lpatternContainsSplice lp+ LazyPat _ lp -> lpatternContainsSplice lp+ AsPat _ _ _ lp -> lpatternContainsSplice lp+ ParPat _ _ lp _ -> lpatternContainsSplice lp+ ViewPat _ _ lp -> lpatternContainsSplice lp+ SigPat _ lp _ -> lpatternContainsSplice lp+ ListPat _ lps -> any lpatternContainsSplice lps+ TuplePat _ lps _ -> any lpatternContainsSplice lps+ SumPat _ lp _ _ -> lpatternContainsSplice lp+ ConPat _ _ cpd -> any lpatternContainsSplice (hsConPatArgs cpd)+ XPat (HsPatExpanded _orig new) -> patternContainsSplice new+ {- Note [Pattern bindings that bind no variables] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Generally, we want to warn about pattern bindings like Just _ = e because they don't do anything! But we have three exceptions: -* A wildcard pattern+(1) A wildcard pattern _ = rhs which (a) is not that different from _v = rhs (b) is sometimes used to give a type sig for, or an occurrence of, a variable on the RHS -* A strict pattern binding; that is, one with an outermost bang+(2) A strict pattern binding; that is, one with an outermost bang !Just _ = e This can fail, so unlike the lazy variant, it is not a no-op. Moreover, #13646 argues that even for single constructor types, you might want to write the constructor. See also #9127. -* A splice pattern+(3) A splice pattern $(th-lhs) = rhs It is impossible to determine whether or not th-lhs really- binds any variable. We should disable the warning for any pattern- which contain splices, but that is a more expensive check.+ binds any variable. You have to recurse all the way into the pattern to check+ it doesn't contain any splices like this. See #22057. Note [Free-variable space leak] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~@@ -668,7 +697,7 @@ dupFixityDecl :: SrcSpan -> RdrName -> TcRnMessage dupFixityDecl loc rdr_name- = TcRnUnknownMessage $ mkPlainError noHints $+ = mkTcRnUnknownMessage $ mkPlainError noHints $ vcat [text "Multiple fixity declarations for" <+> quotes (ppr rdr_name), text "also at " <+> ppr loc] @@ -759,7 +788,7 @@ patternSynonymErr :: TcRnMessage patternSynonymErr- = TcRnUnknownMessage $ mkPlainError noHints $+ = mkTcRnUnknownMessage $ mkPlainError noHints $ hang (text "Illegal pattern synonym declaration") 2 (text "Use -XPatternSynonyms to enable this extension") @@ -767,7 +796,7 @@ Note [Renaming pattern synonym variables] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We rename pattern synonym declaractions backwards to normal to reuse+We rename pattern synonym declarations backwards to normal to reuse the logic already implemented for renaming patterns. We first rename the RHS of a declaration which brings into@@ -915,7 +944,7 @@ -- Report error for all other forms of bindings -- This is why we use a fold rather than map rnMethodBindLHS is_cls_decl _ (L loc bind) rest- = do { addErrAt (locA loc) $ TcRnUnknownMessage $ mkPlainError noHints $+ = do { addErrAt (locA loc) $ mkTcRnUnknownMessage $ mkPlainError noHints $ vcat [ what <+> text "not allowed in" <+> decl_sort , nest 2 (ppr bind) ] ; return rest }@@ -1060,7 +1089,7 @@ return (CompleteMatchSig (noAnn, s) (L l new_bf) new_mty, emptyFVs) where orphanError :: TcRnMessage- orphanError = TcRnUnknownMessage $ mkPlainError noHints $+ orphanError = mkTcRnUnknownMessage $ mkPlainError noHints $ text "Orphan COMPLETE pragmas not supported" $$ text "A COMPLETE pragma must mention at least one data constructor" $$ text "or pattern synonym defined in the same module."@@ -1250,7 +1279,7 @@ , m_grhss = grhss'}, grhss_fvs ) } emptyCaseErr :: HsMatchContext GhcRn -> TcRnMessage-emptyCaseErr ctxt = TcRnUnknownMessage $ mkPlainError noHints $ message ctxt+emptyCaseErr ctxt = mkTcRnUnknownMessage $ mkPlainError noHints $ message ctxt where pp_ctxt :: HsMatchContext GhcRn -> SDoc pp_ctxt c = case c of@@ -1308,7 +1337,7 @@ rnBody rhs ; unless (pattern_guards_allowed || is_standard_guard guards') $- let diag = TcRnUnknownMessage $+ let diag = mkTcRnUnknownMessage $ mkPlainDiagnostic WarningWithoutFlag noHints (nonStdGuardErr guards') in addDiagnostic diag @@ -1363,7 +1392,7 @@ dupSigDeclErr :: NonEmpty (LocatedN RdrName, Sig GhcPs) -> RnM () dupSigDeclErr pairs@((L loc name, sig) :| _)- = addErrAt (locA loc) $ TcRnUnknownMessage $ mkPlainError noHints $+ = addErrAt (locA loc) $ mkTcRnUnknownMessage $ mkPlainError noHints $ vcat [ text "Duplicate" <+> what_it_is <> text "s for" <+> quotes (ppr name) , text "at" <+> vcat (map ppr $ sortBy SrcLoc.leftmost_smallest@@ -1375,18 +1404,18 @@ misplacedSigErr :: LSig GhcRn -> RnM () misplacedSigErr (L loc sig)- = addErrAt (locA loc) $ TcRnUnknownMessage $ mkPlainError noHints $+ = addErrAt (locA loc) $ mkTcRnUnknownMessage $ mkPlainError noHints $ sep [text "Misplaced" <+> hsSigDoc sig <> colon, ppr sig] defaultSigErr :: Sig GhcPs -> TcRnMessage-defaultSigErr sig = TcRnUnknownMessage $ mkPlainError noHints $+defaultSigErr sig = mkTcRnUnknownMessage $ mkPlainError noHints $ vcat [ hang (text "Unexpected default signature:") 2 (ppr sig) , text "Use DefaultSignatures to enable default signatures" ] bindInHsBootFileErr :: LHsBindLR GhcRn GhcPs -> RnM () bindInHsBootFileErr (L loc _)- = addErrAt (locA loc) $ TcRnUnknownMessage $ mkPlainError noHints $+ = addErrAt (locA loc) $ mkTcRnUnknownMessage $ mkPlainError noHints $ vcat [ text "Bindings in hs-boot files are not allowed" ] nonStdGuardErr :: (Outputable body,@@ -1398,7 +1427,7 @@ dupMinimalSigErr :: [LSig GhcPs] -> RnM () dupMinimalSigErr sigs@(L loc _ : _)- = addErrAt (locA loc) $ TcRnUnknownMessage $ mkPlainError noHints $+ = addErrAt (locA loc) $ mkTcRnUnknownMessage $ mkPlainError noHints $ vcat [ text "Multiple minimal complete definitions" , text "at" <+> vcat (map ppr $ sortBy SrcLoc.leftmost_smallest $ map getLocA sigs) , text "Combine alternative minimal complete definitions with `|'" ]
compiler/GHC/Rename/Env.hs view
@@ -762,7 +762,7 @@ -- monoid will combine them to this failing case. instance Outputable DisambigInfo where- ppr NoOccurrence = text "NoOccurence"+ ppr NoOccurrence = text "NoOccurrence" ppr (UniqueOccurrence gre) = text "UniqueOccurrence:" <+> ppr gre ppr (DisambiguatedOccurrence gre) = text "DiambiguatedOccurrence:" <+> ppr gre ppr (AmbiguousOccurrence gres) = text "Ambiguous:" <+> ppr gres@@ -866,7 +866,7 @@ one associated type called G. This is exactly what happens for methods, and it is only consistent to do the same thing for types. That's the role of the function lookupTcdName; the (Maybe Name) give the class of-the encloseing instance decl, if any.+the enclosing instance decl, if any. Note [Looking up Exact RdrNames] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
compiler/GHC/Rename/Expr.hs view
@@ -484,12 +484,12 @@ } Right flds -> -- 'OverloadedRecordUpdate' is in effect. Record dot update desugaring. do { ; unlessXOptM LangExt.RebindableSyntax $- addErr $ TcRnUnknownMessage $ mkPlainError noHints $+ addErr $ mkTcRnUnknownMessage $ mkPlainError noHints $ text "RebindableSyntax is required if OverloadedRecordUpdate is enabled." ; let punnedFields = [fld | (L _ fld) <- flds, hfbPun fld] ; punsEnabled <-xoptM LangExt.NamedFieldPuns ; unless (null punnedFields || punsEnabled) $- addErr $ TcRnUnknownMessage $ mkPlainError noHints $+ addErr $ mkTcRnUnknownMessage $ mkPlainError noHints $ text "For this to work enable NamedFieldPuns." ; (getField, fv_getField) <- lookupSyntaxName getFieldName ; (setField, fv_setField) <- lookupSyntaxName setFieldName@@ -565,16 +565,17 @@ -- absolutely prepared to cope with static forms, we check for -- -XStaticPointers here as well. unlessXOptM LangExt.StaticPointers $- addErr $ TcRnUnknownMessage $ mkPlainError noHints $+ addErr $ mkTcRnUnknownMessage $ mkPlainError noHints $ hang (text "Illegal static expression:" <+> ppr e) 2 (text "Use StaticPointers to enable this extension") (expr',fvExpr) <- rnLExpr expr stage <- getStage case stage of- Splice _ -> addErr $ TcRnUnknownMessage $ mkPlainError noHints $ sep- [ text "static forms cannot be used in splices:"- , nest 2 $ ppr e- ]+ Splice _ -> addErr $ mkTcRnUnknownMessage $+ mkPlainError noHints $ sep+ [ text "static forms cannot be used in splices:"+ , nest 2 $ ppr e+ ] _ -> return () mod <- getModule let fvExpr' = filterNameSet (nameIsLocalOrFrom mod) fvExpr@@ -1311,7 +1312,7 @@ ; return ((seg':segs', thing), fvs) } cmpByOcc n1 n2 = nameOccName n1 `compare` nameOccName n2- dupErr vs = addErr $ TcRnUnknownMessage $ mkPlainError noHints $+ dupErr vs = addErr $ mkTcRnUnknownMessage $ mkPlainError noHints $ (text "Duplicate binding in parallel list comprehension for:" <+> quotes (ppr (NE.head vs))) @@ -1381,7 +1382,7 @@ (c) The 'bs' in the second group must obviously not be captured by the binding in the first group -To satisfy (a) we nest the segements.+To satisfy (a) we nest the segments. To satisfy (b) we check for duplicates just before thing_inside. To satisfy (c) we reset the LocalRdrEnv each time. @@ -1808,7 +1809,7 @@ The algorithm works by first splitting the sequence of statements into independent "segments", and a separate "tail" (the final statement). In-our example above, the segements would be+our example above, the segments would be [ x <- A , y <- B x ]@@ -2463,13 +2464,13 @@ okEmpty _ = False emptyErr :: HsStmtContext GhcRn -> TcRnMessage-emptyErr (ParStmtCtxt {}) = TcRnUnknownMessage $ mkPlainError noHints $+emptyErr (ParStmtCtxt {}) = mkTcRnUnknownMessage $ mkPlainError noHints $ text "Empty statement group in parallel comprehension"-emptyErr (TransStmtCtxt {}) = TcRnUnknownMessage $ mkPlainError noHints $+emptyErr (TransStmtCtxt {}) = mkTcRnUnknownMessage $ mkPlainError noHints $ text "Empty statement group preceding 'group' or 'then'"-emptyErr ctxt@(HsDoStmt _) = TcRnUnknownMessage $ mkPlainError [suggestExtension LangExt.NondecreasingIndentation] $+emptyErr ctxt@(HsDoStmt _) = mkTcRnUnknownMessage $ mkPlainError [suggestExtension LangExt.NondecreasingIndentation] $ text "Empty" <+> pprStmtContext ctxt-emptyErr ctxt = TcRnUnknownMessage $ mkPlainError noHints $+emptyErr ctxt = mkTcRnUnknownMessage $ mkPlainError noHints $ text "Empty" <+> pprStmtContext ctxt ----------------------@@ -2490,7 +2491,8 @@ BodyStmt _ e _ _ -> return (L loc (mkLastStmt e)) LastStmt {} -> return lstmt -- "Deriving" clauses may generate a -- LastStmt directly (unlike the parser)- _ -> do { addErr $ TcRnUnknownMessage $ mkPlainError noHints $+ _ -> do { addErr $ mkTcRnUnknownMessage+ $ mkPlainError noHints $ (hang last_error 2 (ppr stmt)) ; return lstmt } last_error = (text "The last statement in" <+> pprAStmtContext ctxt@@ -2512,7 +2514,8 @@ = do { dflags <- getDynFlags ; case okStmt dflags ctxt stmt of IsValid -> return ()- NotValid extra -> addErr $ TcRnUnknownMessage $ mkPlainError noHints (msg $$ extra) }+ NotValid extra -> addErr $ mkTcRnUnknownMessage+ $ mkPlainError noHints (msg $$ extra) } where msg = sep [ text "Unexpected" <+> pprStmtCat stmt <+> text "statement" , text "in" <+> pprAStmtContext ctxt ]@@ -2605,19 +2608,19 @@ ; checkErr (all tupArgPresent args || tuple_section) msg } where msg :: TcRnMessage- msg = TcRnUnknownMessage $ mkPlainError noHints $+ msg = mkTcRnUnknownMessage $ mkPlainError noHints $ text "Illegal tuple section: use TupleSections" --------- sectionErr :: HsExpr GhcPs -> TcRnMessage sectionErr expr- = TcRnUnknownMessage $ mkPlainError noHints $+ = mkTcRnUnknownMessage $ mkPlainError noHints $ hang (text "A section must be enclosed in parentheses") 2 (text "thus:" <+> (parens (ppr expr))) badIpBinds :: Outputable a => SDoc -> a -> TcRnMessage badIpBinds what binds- = TcRnUnknownMessage $ mkPlainError noHints $+ = mkTcRnUnknownMessage $ mkPlainError noHints $ hang (text "Implicit-parameter bindings illegal in" <+> what) 2 (ppr binds) @@ -2724,7 +2727,7 @@ -- -- See Note [Overview of record dot syntax] in GHC.Hs.Expr. --- mkGetField arg field calcuates a get_field @field arg expression.+-- mkGetField arg field calculates a get_field @field arg expression. -- e.g. z.x = mkGetField z x = get_field @x z mkGetField :: Name -> LHsExpr GhcRn -> LocatedAn NoEpAnns FieldLabelString -> HsExpr GhcRn mkGetField get_field arg field = unLoc (head $ mkGet get_field [arg] field)
compiler/GHC/Rename/Fixity.hs view
@@ -127,7 +127,7 @@ lookupFixityRn_help' name occ | isUnboundName name = return (False, Fixity NoSourceText minPrecedence InfixL)- -- Minimise errors from ubound names; eg+ -- Minimise errors from unbound names; eg -- a>0 `foo` b>0 -- where 'foo' is not in scope, should not give an error (#7937)
compiler/GHC/Rename/HsType.hs view
@@ -80,7 +80,7 @@ import Language.Haskell.Syntax.Basic (FieldLabelString(..)) -import Data.List (sortBy, nubBy, partition)+import Data.List (nubBy, partition) import qualified Data.List.NonEmpty as NE import Data.List.NonEmpty (NonEmpty(..)) import Control.Monad@@ -215,7 +215,7 @@ -- Should the inner `a` refer to the outer one? shadow it? We are, as yet, undecided, -- so we currently reject. when (not (null varsInScope)) $- addErr $ TcRnUnknownMessage $ mkPlainError noHints $+ addErr $ mkTcRnUnknownMessage $ mkPlainError noHints $ vcat [ text "Type variable" <> plural varsInScope <+> hcat (punctuate (text ",") (map (quotes . ppr) varsInScope))@@ -443,10 +443,10 @@ -> ([Name] -> RnM (a, FreeVars)) -> RnM (a, FreeVars) rnImplicitTvBndrs ctx mb_assoc implicit_vs_with_dups thing_inside- = do { implicit_vs <- forM (NE.groupBy eqLocated $ sortBy cmpLocated $ implicit_vs_with_dups) $ \case+ = do { implicit_vs <- forM (NE.groupAllWith unLoc $ implicit_vs_with_dups) $ \case (x :| []) -> return x (x :| _) -> do- let msg = TcRnUnknownMessage $ mkPlainError noHints $+ let msg = mkTcRnUnknownMessage $ mkPlainError noHints $ text "Variable" <+> text "`" <> ppr x <> text "'" <+> text "would be bound multiple times by" <+> pprHsDocContext ctx <> text "." addErr msg return x@@ -622,7 +622,7 @@ rnHsTyKi env (HsTyVar _ ip (L loc rdr_name)) = do { when (isRnKindLevel env && isRdrTyVar rdr_name) $- unlessXOptM LangExt.PolyKinds $ addErr $ TcRnUnknownMessage $ mkPlainError noHints $+ unlessXOptM LangExt.PolyKinds $ addErr $ mkTcRnUnknownMessage $ mkPlainError noHints $ withHsDocContext (rtke_ctxt env) $ vcat [ text "Unexpected kind variable" <+> quotes (ppr rdr_name) , text "Perhaps you intended to use PolyKinds" ]@@ -663,7 +663,7 @@ get_fields (ConDeclCtx names) = concatMapM (lookupConstructorFields . unLoc) names get_fields _- = do { addErr $ TcRnUnknownMessage $ mkPlainError noHints $+ = do { addErr $ mkTcRnUnknownMessage $ mkPlainError noHints $ (hang (text "Record syntax is illegal here:") 2 (ppr ty)) ; return [] } @@ -716,7 +716,7 @@ negLit (HsNumTy _ i) = i < 0 negLit (HsCharTy _ _) = False negLitErr :: TcRnMessage- negLitErr = TcRnUnknownMessage $ mkPlainError noHints $+ negLitErr = mkTcRnUnknownMessage $ mkPlainError noHints $ text "Illegal literal in type (type literals must not be negative):" <+> ppr tyLit rnHsTyKi env (HsAppTy _ ty1 ty2)@@ -758,9 +758,9 @@ check_in_scope :: RdrName -> RnM () check_in_scope rdr_name = do mb_name <- lookupLocalOccRn_maybe rdr_name- -- TODO: refactor this to avoid TcRnUnknownMessage+ -- TODO: refactor this to avoid mkTcRnUnknownMessage when (isNothing mb_name) $- addErr $ TcRnUnknownMessage $ mkPlainError noHints $+ addErr $ mkTcRnUnknownMessage $ mkPlainError noHints $ withHsDocContext (rtke_ctxt env) $ pprScopeError rdr_name (notInScopeErr WL_LocalOnly rdr_name) @@ -924,7 +924,7 @@ | isRnKindLevel env = do { polykinds <- xoptM LangExt.PolyKinds ; unless polykinds $- addErr $ TcRnUnknownMessage $ mkPlainError noHints $+ addErr $ mkTcRnUnknownMessage $ mkPlainError noHints $ (text "Illegal kind:" <+> ppr ty $$ text "Did you mean to enable PolyKinds?") } checkPolyKinds _ _ = return ()@@ -935,7 +935,7 @@ -> RnM () notInKinds env ty | isRnKindLevel env- = addErr $ TcRnUnknownMessage $ mkPlainError noHints $+ = addErr $ mkTcRnUnknownMessage $ mkPlainError noHints $ text "Illegal kind:" <+> ppr ty notInKinds _ _ = return () @@ -1342,7 +1342,7 @@ = do { fix2 <- lookupTyFixityRn op2 ; mk_hs_op_ty prom1 op1 fix1 ty1 prom2 op2 fix2 ty2a ty2b loc2 } -mkHsOpTyRn prom1 op1 _ ty1 ty2 -- Default case, no rearrangment+mkHsOpTyRn prom1 op1 _ ty1 ty2 -- Default case, no rearrangement = return (HsOpTy noAnn prom1 ty1 op1 ty2) ---------------@@ -1410,7 +1410,7 @@ --------------------------- -- Default case-mkOpAppRn _ e1 op fix e2 -- Default case, no rearrangment+mkOpAppRn _ e1 op fix e2 -- Default case, no rearrangement = assertPpr (right_op_ok fix (unLoc e2)) (ppr e1 $$ text "---" $$ ppr op $$ text "---" $$ ppr fix $$ text "---" $$ ppr e2) $ return (OpApp fix e1 op e2)@@ -1422,7 +1422,7 @@ -- | Name of an operator in an operator application or section data OpName = NormalOp Name -- ^ A normal identifier | NegateOp -- ^ Prefix negation- | UnboundOp OccName -- ^ An unbound indentifier+ | UnboundOp OccName -- ^ An unbound identifier | RecFldOp (FieldOcc GhcRn) -- ^ A record field occurrence instance Outputable OpName where@@ -1486,7 +1486,7 @@ (nofix_error, associate_right) = compareFixity fix1 fix2 -- Default case-mkOpFormRn arg1 op fix arg2 -- Default case, no rearrangment+mkOpFormRn arg1 op fix arg2 -- Default case, no rearrangement = return (HsCmdArrForm noExtField op Infix (Just fix) [arg1, arg2]) @@ -1524,7 +1524,7 @@ } } -mkConOpPatRn op _ p1 p2 -- Default case, no rearrangment+mkConOpPatRn op _ p1 p2 -- Default case, no rearrangement = assert (not_op_pat (unLoc p2)) $ return $ ConPat { pat_con_ext = noExtField@@ -1615,7 +1615,7 @@ | is_unbound n1 || is_unbound n2 = return () -- Avoid error cascade | otherwise- = addErr $ TcRnUnknownMessage $ mkPlainError noHints $+ = addErr $ mkTcRnUnknownMessage $ mkPlainError noHints $ hang (text "Precedence parsing error") 4 (hsep [text "cannot mix", ppr_opfix op1, text "and", ppr_opfix op2,@@ -1626,7 +1626,7 @@ | is_unbound n1 || is_unbound n2 = return () -- Avoid error cascade | otherwise- = addErr $ TcRnUnknownMessage $ mkPlainError noHints $+ = addErr $ mkTcRnUnknownMessage $ mkPlainError noHints $ vcat [text "The operator" <+> ppr_opfix op <+> text "of a section", nest 4 (sep [text "must have lower precedence than that of the operand,", nest 2 (text "namely" <+> ppr_opfix arg_op)]),@@ -1652,20 +1652,20 @@ unexpectedPatSigTypeErr :: HsPatSigType GhcPs -> TcRnMessage unexpectedPatSigTypeErr ty- = TcRnUnknownMessage $ mkPlainError noHints $+ = mkTcRnUnknownMessage $ mkPlainError noHints $ hang (text "Illegal type signature:" <+> quotes (ppr ty)) 2 (text "Type signatures are only allowed in patterns with ScopedTypeVariables") badKindSigErr :: HsDocContext -> LHsType GhcPs -> TcM () badKindSigErr doc (L loc ty)- = setSrcSpanA loc $ addErr $ TcRnUnknownMessage $ mkPlainError noHints $+ = setSrcSpanA loc $ addErr $ mkTcRnUnknownMessage $ mkPlainError noHints $ withHsDocContext doc $ hang (text "Illegal kind signature:" <+> quotes (ppr ty)) 2 (text "Perhaps you intended to use KindSignatures") dataKindsErr :: RnTyKiEnv -> HsType GhcPs -> TcRnMessage dataKindsErr env thing- = TcRnUnknownMessage $ mkPlainError noHints $+ = mkTcRnUnknownMessage $ mkPlainError noHints $ hang (text "Illegal" <+> pp_what <> colon <+> quotes (ppr thing)) 2 (text "Perhaps you intended to use DataKinds") where@@ -1676,7 +1676,7 @@ => HsDocContext -> LHsTyVarBndr flag GhcRn -> FreeVars -> TcM () warnUnusedForAll doc (L loc tv) used_names = unless (hsTyVarName tv `elemNameSet` used_names) $ do- let msg = TcRnUnknownMessage $+ let msg = mkTcRnUnknownMessage $ mkPlainDiagnostic (WarningWithFlag Opt_WarnUnusedForalls) noHints $ vcat [ text "Unused quantified type variable" <+> quotes (ppr tv) , inHsDocContext doc ]
compiler/GHC/Rename/Module.hs view
@@ -16,7 +16,7 @@ rnSrcDecls, addTcgDUs, findSplice, rnWarningTxt ) where -import GHC.Prelude+import GHC.Prelude hiding ( head ) import {-# SOURCE #-} GHC.Rename.Expr( rnLExpr ) import {-# SOURCE #-} GHC.Rename.Splice ( rnSpliceDecl, rnTopSpliceDecls )@@ -69,12 +69,14 @@ import GHC.Types.Unique.Set import GHC.Data.OrdList import qualified GHC.LanguageExtensions as LangExt+import GHC.Core.DataCon ( isSrcStrict ) import Control.Monad import Control.Arrow ( first )+import Data.Foldable ( toList ) import Data.List ( mapAccumL ) import qualified Data.List.NonEmpty as NE-import Data.List.NonEmpty ( NonEmpty(..) )+import Data.List.NonEmpty ( NonEmpty(..), head ) import Data.Maybe ( isNothing, fromMaybe, mapMaybe ) import qualified Data.Set as Set ( difference, fromList, toList, null ) import Data.Function ( on )@@ -552,7 +554,7 @@ -- got "lhs = rhs" but expected something different addWarnNonCanonicalMethod1 refURL flag lhs rhs = do- let dia = TcRnUnknownMessage $+ let dia = mkTcRnUnknownMessage $ mkPlainDiagnostic (WarningWithFlag flag) noHints $ vcat [ text "Noncanonical" <+> quotes (text (lhs ++ " = " ++ rhs)) <+>@@ -568,7 +570,7 @@ -- expected "lhs = rhs" but got something else addWarnNonCanonicalMethod2 refURL flag lhs rhs = do- let dia = TcRnUnknownMessage $+ let dia = mkTcRnUnknownMessage $ mkPlainDiagnostic (WarningWithFlag flag) noHints $ vcat [ text "Noncanonical" <+> quotes (text lhs) <+>@@ -679,7 +681,7 @@ -- reach the typechecker, lest we encounter different errors that are -- hopelessly confusing (such as the one in #16114). bail_out (l, err_msg) = do- addErrAt l $ TcRnUnknownMessage $ mkPlainError noHints (withHsDocContext ctxt err_msg)+ addErrAt l $ mkTcRnUnknownMessage $ mkPlainError noHints (withHsDocContext ctxt err_msg) pure $ mkUnboundName (mkTcOccFS (fsLit "<class>")) rnFamEqn :: HsDocContext@@ -843,7 +845,7 @@ badAssocRhs :: [Name] -> RnM () badAssocRhs ns- = addErr $ TcRnUnknownMessage $ mkPlainError noHints $+ = addErr $ mkTcRnUnknownMessage $ mkPlainError noHints $ (hang (text "The RHS of an associated type declaration mentions" <+> text "out-of-scope variable" <> plural ns <+> pprWithCommas (quotes . ppr) ns)@@ -1206,7 +1208,7 @@ standaloneDerivErr :: TcRnMessage standaloneDerivErr- = TcRnUnknownMessage $ mkPlainError noHints $+ = mkTcRnUnknownMessage $ mkPlainError noHints $ hang (text "Illegal standalone deriving declaration") 2 (text "Use StandaloneDeriving to enable this extension") @@ -1299,7 +1301,7 @@ (e.g. a case expression is not allowed: too elaborate.) But there are legitimate non-trivial args ei, like sections and-lambdas. So it seems simmpler not to check at all, and that is why+lambdas. So it seems simpler not to check at all, and that is why check_e is commented out. -} @@ -1351,14 +1353,14 @@ badRuleVar :: FastString -> Name -> TcRnMessage badRuleVar name var- = TcRnUnknownMessage $ mkPlainError noHints $+ = mkTcRnUnknownMessage $ mkPlainError noHints $ sep [text "Rule" <+> doubleQuotes (ftext name) <> colon, text "Forall'd variable" <+> quotes (ppr var) <+> text "does not appear on left hand side"] badRuleLhsErr :: FastString -> LHsExpr GhcRn -> HsExpr GhcRn -> TcRnMessage badRuleLhsErr name lhs bad_e- = TcRnUnknownMessage $ mkPlainError noHints $+ = mkTcRnUnknownMessage $ mkPlainError noHints $ sep [text "Rule" <+> pprRuleName name <> colon, nest 2 (vcat [err, text "in left-hand side:" <+> ppr lhs])]@@ -1396,7 +1398,7 @@ A TyClGroup represents a strongly connected components of type/class/instance decls, together with the role annotations for the type/class declarations. The renamer uses strongly connected-comoponent analysis to build these groups. We do this for a number of+component analysis to build these groups. We do this for a number of reasons: * Improve kind error messages. Consider@@ -1516,7 +1518,7 @@ -> RnM ([TyClGroup GhcRn], FreeVars) -- Rename the declarations and do dependency analysis on them rnTyClDecls tycl_ds- = do { -- Rename the type/class, instance, and role declaraations+ = do { -- Rename the type/class, instance, and role declarations ; tycls_w_fvs <- mapM (wrapLocFstMA rnTyClDecl) (tyClGroupTyClDecls tycl_ds) ; let tc_names = mkNameSet (map (tcdName . unLoc . fst) tycls_w_fvs) ; kisigs_w_fvs <- rnStandaloneKindSignatures tc_names (tyClGroupKindSigs tycl_ds)@@ -1623,7 +1625,7 @@ } where standaloneKiSigErr :: TcRnMessage- standaloneKiSigErr = TcRnUnknownMessage $ mkPlainError noHints $+ standaloneKiSigErr = mkTcRnUnknownMessage $ mkPlainError noHints $ hang (text "Illegal standalone kind signature") 2 (text "Did you mean to enable StandaloneKindSignatures?") @@ -1696,7 +1698,7 @@ dupRoleAnnotErr :: NonEmpty (LRoleAnnotDecl GhcPs) -> RnM () dupRoleAnnotErr list- = addErrAt (locA loc) $ TcRnUnknownMessage $ mkPlainError noHints $+ = addErrAt (locA loc) $ mkTcRnUnknownMessage $ mkPlainError noHints $ hang (text "Duplicate role annotations for" <+> quotes (ppr $ roleAnnotDeclName first_decl) <> colon) 2 (vcat $ map pp_role_annot $ NE.toList sorted_list)@@ -1711,7 +1713,7 @@ dupKindSig_Err :: NonEmpty (LStandaloneKindSig GhcPs) -> RnM () dupKindSig_Err list- = addErrAt (locA loc) $ TcRnUnknownMessage $ mkPlainError noHints $+ = addErrAt (locA loc) $ mkTcRnUnknownMessage $ mkPlainError noHints $ hang (text "Duplicate standalone kind signatures for" <+> quotes (ppr $ standaloneKindSigName first_decl) <> colon) 2 (vcat $ map pp_kisig $ NE.toList sorted_list)@@ -1819,11 +1821,11 @@ rnTyClDecl (DataDecl { tcdLName = tycon, tcdTyVars = tyvars, tcdFixity = fixity,- tcdDataDefn = defn@HsDataDefn{ dd_ND = new_or_data- , dd_kindSig = kind_sig} })+ tcdDataDefn = defn@HsDataDefn{ dd_cons = cons, dd_kindSig = kind_sig} }) = do { tycon' <- lookupLocatedTopConstructorRnN tycon ; let kvs = extractDataDefnKindVars defn doc = TyDataCtx tycon+ new_or_data = dataDefnConsNewOrData cons ; traceRn "rntycl-data" (ppr tycon <+> ppr kvs) ; bindHsQTyVars doc Nothing kvs tyvars $ \ tyvars' no_rhs_kvs -> do { (defn', fvs) <- rnDataDefn doc defn@@ -1940,14 +1942,17 @@ rnDataDefn :: HsDocContext -> HsDataDefn GhcPs -> RnM (HsDataDefn GhcRn, FreeVars)-rnDataDefn doc (HsDataDefn { dd_ND = new_or_data, dd_cType = cType- , dd_ctxt = context, dd_cons = condecls+rnDataDefn doc (HsDataDefn { dd_cType = cType, dd_ctxt = context, dd_cons = condecls , dd_kindSig = m_sig, dd_derivs = derivs }) = do { -- DatatypeContexts (i.e., stupid contexts) can't be combined with -- GADT syntax. See Note [The stupid context] in GHC.Core.DataCon. checkTc (h98_style || null (fromMaybeContext context)) (badGadtStupidTheta doc) + -- Check restrictions on "type data" declarations.+ -- See Note [Type data declarations].+ ; when (isTypeDataDefnCons condecls) check_type_data+ ; (m_sig', sig_fvs) <- case m_sig of Just sig -> first Just <$> rnLHsKind doc sig Nothing -> return (Nothing, emptyFVs)@@ -1966,17 +1971,14 @@ ; let all_fvs = fvs1 `plusFV` fvs3 `plusFV` con_fvs `plusFV` sig_fvs- ; return ( HsDataDefn { dd_ext = noExtField- , dd_ND = new_or_data, dd_cType = cType+ ; return ( HsDataDefn { dd_ext = noExtField, dd_cType = cType , dd_ctxt = context', dd_kindSig = m_sig' , dd_cons = condecls' , dd_derivs = derivs' } , all_fvs ) } where- h98_style = case condecls of -- Note [Stupid theta]- (L _ (ConDeclGADT {})) : _ -> False- _ -> True+ h98_style = not $ anyLConIsGadt condecls -- Note [Stupid theta] rn_derivs ds = do { deriv_strats_ok <- xoptM LangExt.DerivingStrategies@@ -1985,6 +1987,121 @@ ; (ds', fvs) <- mapFvRn (rnLHsDerivingClause doc) ds ; return (ds', fvs) } + -- Given a "type data" declaration, check that the TypeData extension+ -- is enabled and check restrictions (R1), (R2), (R3) and (R5)+ -- on the declaration. See Note [Type data declarations].+ check_type_data+ = do { unlessXOptM LangExt.TypeData $ failWith TcRnIllegalTypeData+ ; unless (null (fromMaybeContext context)) $+ failWith $ TcRnTypeDataForbids TypeDataForbidsDatatypeContexts+ ; mapM_ (addLocMA check_type_data_condecl) condecls+ ; unless (null derivs) $+ failWith $ TcRnTypeDataForbids TypeDataForbidsDerivingClauses+ }++ -- Check restrictions (R2) and (R3) on a "type data" constructor.+ -- See Note [Type data declarations].+ check_type_data_condecl :: ConDecl GhcPs -> RnM ()+ check_type_data_condecl condecl+ = do {+ ; when (has_labelled_fields condecl) $+ failWith $ TcRnTypeDataForbids TypeDataForbidsLabelledFields+ ; when (has_strictness_flags condecl) $+ failWith $ TcRnTypeDataForbids TypeDataForbidsStrictnessAnnotations+ }++ has_labelled_fields (ConDeclGADT { con_g_args = RecConGADT _ _ }) = True+ has_labelled_fields (ConDeclH98 { con_args = RecCon rec })+ = not (null (unLoc rec))+ has_labelled_fields _ = False++ has_strictness_flags condecl+ = any (is_strict . getBangStrictness . hsScaledThing) (con_args condecl)++ is_strict (HsSrcBang _ _ s) = isSrcStrict s++ con_args (ConDeclGADT { con_g_args = PrefixConGADT args }) = args+ con_args (ConDeclH98 { con_args = PrefixCon _ args }) = args+ con_args (ConDeclH98 { con_args = InfixCon arg1 arg2 }) = [arg1, arg2]+ con_args _ = []++{-+Note [Type data declarations]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+With the TypeData extension (GHC proposal #106), one can write "type data"+declarations, like++ type data Nat = Zero | Succ Nat++or equivalently in GADT style:++ type data Nat where+ Zero :: Nat+ Succ :: Nat -> Nat++This defines the constructors Zero and Succ in the TcCls namespace+(type constructors and classes) instead of the Data namespace (data+constructors). This contrasts with the DataKinds extension, which allows+constructors defined in the Data namespace to be promoted to the TcCls+namespace at the point of use in a type.++Type data declarations have the syntax of data declarations, either+ordinary algebraic data types or GADTs, preceded by "type", with the+following restrictions:++(R1) There are data type contexts (even with the DatatypeContexts extension).++(R2) There are no labelled fields. Perhaps these could be supported+ using type families, but they are omitted for now.++(R3) There are no strictness flags, because they don't make sense at+ the type level.++(R4) The types of the constructors contain no constraints other than+ equality constraints. (This is the same restriction imposed+ on constructors to be promoted with the DataKinds extension in+ dc_theta_illegal_constraint called from GHC.Tc.Gen.HsType.tcTyVar,+ but in that case the restriction is imposed if and when a data+ constructor is used in a type, whereas here it is imposed at+ the point of definition. See also Note [Constraints in kinds]+ in GHC.Core.TyCo.Rep.)++(R5) There are no deriving clauses.++The main parts of the implementation are:++* The Bool argument to DataTypeCons (in Language.Haskell.Syntax.Decls)+ distinguishes "type data" declarations from ordinary "data" declarations.++* This flag is set, and the constructor names placed in the+ TcCls namespace, during the initial construction of the AST in+ GHC.Parser.PostProcess.checkNewOrData.++* GHC.Rename.Module.rnDataDefn calls check_type_data on these+ declarations, which checks that the TypeData extension is enabled and+ checks restrictions (R1), (R2), (R3) and (R5). They could equally+ well be checked in the typechecker, but we err on the side of catching+ imposters early.++* GHC.Tc.TyCl.checkValidDataCon checks restriction (R4) on these declarations.++* When beginning to type check a mutually recursive group of declarations,+ the "type data" constructors are added to the type-checker environment+ as APromotionErr TyConPE by GHC.Tc.TyCl.mkPromotionErrorEnv, so they+ cannot be used within the recursive group. This mirrors the DataKinds+ behaviour described at Note [Recursion and promoting data constructors]+ in GHC.Tc.TyCl. For example, this is rejected:++ type data T f = K (f (K Int))++* After a "type data" declaration has been type-checked, the type-checker+ environment entry for each constructor (which can be recognized+ by being in the TcCls namespace) is just the promoted type+ constructor, not the bundle required for a data constructor.+ (GHC.Types.TyThing.implicitTyConThings)++-}+ warnNoDerivStrat :: Maybe (LDerivStrategy GhcRn) -> SrcSpan -> RnM ()@@ -1992,7 +2109,7 @@ = do { dyn_flags <- getDynFlags ; case mds of Nothing ->- let dia = TcRnUnknownMessage $+ let dia = mkTcRnUnknownMessage $ mkPlainDiagnostic (WarningWithFlag Opt_WarnMissingDerivingStrategies) noHints $ (if xopt LangExt.DerivingStrategies dyn_flags then no_strat_warning@@ -2100,13 +2217,13 @@ badGadtStupidTheta :: HsDocContext -> TcRnMessage badGadtStupidTheta _- = TcRnUnknownMessage $ mkPlainError noHints $+ = mkTcRnUnknownMessage $ mkPlainError noHints $ vcat [text "No context is allowed on a GADT-style data declaration", text "(You can put a context on each constructor, though.)"] illegalDerivStrategyErr :: DerivStrategy GhcPs -> TcRnMessage illegalDerivStrategyErr ds- = TcRnUnknownMessage $ mkPlainError noHints $+ = mkTcRnUnknownMessage $ mkPlainError noHints $ vcat [ text "Illegal deriving strategy" <> colon <+> derivStrategyName ds , text enableStrategy ] @@ -2120,7 +2237,7 @@ multipleDerivClausesErr :: TcRnMessage multipleDerivClausesErr- = TcRnUnknownMessage $ mkPlainError noHints $+ = mkTcRnUnknownMessage $ mkPlainError noHints $ vcat [ text "Illegal use of multiple, consecutive deriving clauses" , text "Use DerivingStrategies to allow this" ] @@ -2186,7 +2303,7 @@ rdr_env <- getLocalRdrEnv ; let resName = hsLTyVarName tvbndr ; when (resName `elemLocalRdrEnv` rdr_env) $- addErrAt (getLocA tvbndr) $ TcRnUnknownMessage $ mkPlainError noHints $+ addErrAt (getLocA tvbndr) $ mkTcRnUnknownMessage $ mkPlainError noHints $ (hsep [ text "Type variable", quotes (ppr resName) <> comma , text "naming a type family result," ] $$@@ -2260,7 +2377,7 @@ -- not-in-scope variables) don't check the validity of injectivity -- annotation. This gives better error messages. ; when (noRnErrors && not lhsValid) $- addErrAt (getLocA injFrom) $ TcRnUnknownMessage $ mkPlainError noHints $+ addErrAt (getLocA injFrom) $ mkTcRnUnknownMessage $ mkPlainError noHints $ ( vcat [ text $ "Incorrect type variable on the LHS of " ++ "injectivity condition" , nest 5@@ -2269,7 +2386,7 @@ ; when (noRnErrors && not (Set.null rhsValid)) $ do { let errorVars = Set.toList rhsValid- ; addErrAt (locA srcSpan) $ TcRnUnknownMessage $ mkPlainError noHints $+ ; addErrAt (locA srcSpan) $ mkTcRnUnknownMessage $ mkPlainError noHints $ ( hsep [ text "Unknown type variable" <> plural errorVars , text "on the RHS of injectivity condition:"@@ -2312,7 +2429,7 @@ ***************************************************** -} ------------------rnConDecls :: [LConDecl GhcPs] -> RnM ([LConDecl GhcRn], FreeVars)+rnConDecls :: DataDefnCons (LConDecl GhcPs) -> RnM (DataDefnCons (LConDecl GhcRn), FreeVars) rnConDecls = mapFvRn (wrapLocFstMA rnConDecl) rnConDecl :: ConDecl GhcPs -> RnM (ConDecl GhcRn, FreeVars)@@ -2370,7 +2487,7 @@ extractConDeclGADTDetailsTyVars args $ extractHsTysRdrTyVars [res_ty] [] - ; let ctxt = ConDeclCtx new_names+ ; let ctxt = ConDeclCtx (toList new_names) ; bindHsOuterTyVarBndrs ctxt Nothing implicit_bndrs outer_bndrs $ \outer_bndrs' -> do { (new_cxt, fvs1) <- rnMbContext ctxt mcxt@@ -2553,7 +2670,7 @@ ; return (gp, Just (splice, ds)) } where badImplicitSplice :: TcRnMessage- badImplicitSplice = TcRnUnknownMessage $ mkPlainError noHints $+ badImplicitSplice = mkTcRnUnknownMessage $ mkPlainError noHints $ text "Parse error: module header, import declaration" $$ text "or top-level declaration expected." -- The compiler should suggest the above, and not using
compiler/GHC/Rename/Names.hs view
@@ -93,9 +93,12 @@ import Data.Map ( Map ) import qualified Data.Map as Map import Data.Ord ( comparing )-import Data.List ( partition, (\\), find, sortBy, groupBy, sortOn )+import Data.List ( partition, (\\), find, sortBy )+import Data.List.NonEmpty (NonEmpty(..))+import qualified Data.List.NonEmpty as NE import Data.Function ( on ) import qualified Data.Set as S+import Data.Foldable ( toList ) import System.FilePath ((</>)) import System.IO@@ -116,7 +119,7 @@ and packages. Doing this without caching any trust information would be very slow as we would need to touch all packages and interface files a module depends on. To avoid this we make use of the property that if a modules Safe Haskell-mode changes, this triggers a recompilation from that module in the dependecy+mode changes, this triggers a recompilation from that module in the dependency graph. So we can just worry mostly about direct imports. There is one trust property that can change for a package though without@@ -352,7 +355,7 @@ NoPkgQual -> True ThisPkg uid -> uid == homeUnitId_ (hsc_dflags hsc_env) OtherPkg _ -> False))- (addErr $ TcRnUnknownMessage $ mkPlainError noHints $+ (addErr $ mkTcRnUnknownMessage $ mkPlainError noHints $ (text "A module cannot import itself:" <+> ppr imp_mod_name)) -- Check for a missing import list (Opt_WarnMissingImportList also@@ -362,7 +365,7 @@ _ | implicit -> return () -- Do not bleat for implicit imports | qual_only -> return () | otherwise -> whenWOptM Opt_WarnMissingImportList $ do- let msg = TcRnUnknownMessage $+ let msg = mkTcRnUnknownMessage $ mkPlainDiagnostic (WarningWithFlag Opt_WarnMissingImportList) noHints (missingImportListWarn imp_mod_name)@@ -387,7 +390,7 @@ warnIf ((want_boot == IsBoot) && (mi_boot iface == NotBoot) && isOneShot (ghcMode dflags)) (warnRedundantSourceImport imp_mod_name) when (mod_safe && not (safeImportsOn dflags)) $- addErr $ TcRnUnknownMessage $ mkPlainError noHints $+ addErr $ mkTcRnUnknownMessage $ mkPlainError noHints $ (text "safe import can't be used as Safe Haskell isn't on!" $+$ text ("please enable Safe Haskell through either Safe, Trustworthy or Unsafe")) @@ -429,7 +432,7 @@ -- Complain if we import a deprecated module case mi_warns iface of WarnAll txt -> do- let msg = TcRnUnknownMessage $+ let msg = mkTcRnUnknownMessage $ mkPlainDiagnostic (WarningWithFlag Opt_WarnWarningsDeprecations) noHints (moduleWarn imp_mod_name txt)@@ -610,7 +613,7 @@ warnUnqualifiedImport :: ImportDecl GhcPs -> ModIface -> RnM () warnUnqualifiedImport decl iface = when bad_import $ do- let msg = TcRnUnknownMessage $+ let msg = mkTcRnUnknownMessage $ mkPlainDiagnostic (WarningWithFlag Opt_WarnCompatUnqualifiedImports) noHints warning@@ -643,7 +646,7 @@ warnRedundantSourceImport :: ModuleName -> TcRnMessage warnRedundantSourceImport mod_name- = TcRnUnknownMessage $ mkPlainDiagnostic WarningWithoutFlag noHints $+ = mkTcRnUnknownMessage $ mkPlainDiagnostic WarningWithoutFlag noHints $ text "Unnecessary {-# SOURCE #-} in the import of module" <+> quotes (ppr mod_name) {-@@ -982,7 +985,7 @@ , con_g_args = RecConGADT flds _ })) = [ ( find_con_name rdr , concatMap find_con_decl_flds (unLoc flds))- | L _ rdr <- rdrs ]+ | L _ rdr <- toList rdrs ] find_con_flds _ = [] @@ -1165,7 +1168,7 @@ data T = mkT { foo :: Int } module N where- import M (foo) -- this is an ambiguity error (A)+ import M (foo) -- this is allowed (A) import M (S(foo)) -- this is allowed (B) Here M exports the OccName 'foo' twice, so we get an imp_occ_env where 'foo'@@ -1176,8 +1179,8 @@ , $sel:foo:MKT -> (foo, T(foo), Nothing) ] -Then when we look up 'foo' in lookup_name for case (A) we get both entries and-hence report an ambiguity error. Whereas in case (B) we reach the lookup_ie+Then when we look up 'foo' in lookup_names for case (A) we get both entries and+hence two Avails. Whereas in case (B) we reach the lookup_ie case for IEThingWith, which looks up 'S' and then finds the unique 'foo' amongst its children. @@ -1252,13 +1255,21 @@ isAvailTC AvailTC{} = True isAvailTC _ = False + -- Look up a RdrName used in an import, failing if it is ambiguous+ -- (e.g. because it refers to multiple record fields) lookup_name :: IE GhcPs -> RdrName -> IELookupM (Name, AvailInfo, Maybe Name)- lookup_name ie rdr+ lookup_name ie rdr = do+ xs <- lookup_names ie rdr+ case xs of+ [cax] -> return cax+ _ -> failLookupWith (AmbiguousImport rdr (map sndOf3 xs))++ -- Look up a RdrName used in an import, returning multiple values if there+ -- are several fields with the same name exposed by the module+ lookup_names :: IE GhcPs -> RdrName -> IELookupM [(Name, AvailInfo, Maybe Name)]+ lookup_names ie rdr | isQual rdr = failLookupWith (QualImportError rdr)- | Just succ <- mb_success = case nonDetNameEnvElts succ of- -- See Note [Importing DuplicateRecordFields]- [(c,a,x)] -> return (greNameMangledName c, a, x)- xs -> failLookupWith (AmbiguousImport rdr (map sndOf3 xs))+ | Just succ <- mb_success = return $ map (\ (c,a,x) -> (greNameMangledName c, a, x)) (nonDetNameEnvElts succ) | otherwise = failLookupWith (BadImport ie) where mb_success = lookupOccEnv imp_occ_env (rdrNameOcc rdr)@@ -1277,7 +1288,7 @@ emit_warning MissingImportList = whenWOptM Opt_WarnMissingImportList $ addTcRnDiagnostic (TcRnMissingImportList ieRdr) emit_warning (BadImportW ie) = whenWOptM Opt_WarnDodgyImports $ do- let msg = TcRnUnknownMessage $+ let msg = mkTcRnUnknownMessage $ mkPlainDiagnostic (WarningWithFlag Opt_WarnDodgyImports) noHints (lookup_err_msg (BadImport ie))@@ -1286,7 +1297,7 @@ run_lookup :: IELookupM a -> TcRn (Maybe a) run_lookup m = case m of Failed err -> do- addErr $ TcRnUnknownMessage $ mkPlainError noHints (lookup_err_msg err)+ addErr $ mkTcRnUnknownMessage $ mkPlainError noHints (lookup_err_msg err) return Nothing Succeeded a -> return (Just a) @@ -1311,9 +1322,11 @@ lookup_ie ie = handle_bad_import $ case ie of IEVar _ (L l n) -> do- (name, avail, _) <- lookup_name ie $ ieWrappedName n+ -- See Note [Importing DuplicateRecordFields]+ xs <- lookup_names ie (ieWrappedName n) return ([(IEVar noExtField (L l (replaceWrappedName n name)),- trimAvail avail name)], [])+ trimAvail avail name)+ | (name, avail, _) <- xs ], []) IEThingAll _ (L l tc) -> do (name, avail, mb_parent) <- lookup_name ie $ ieWrappedName tc@@ -1834,7 +1847,7 @@ -- Nothing used; drop entire declaration | null used- = let dia = TcRnUnknownMessage $+ = let dia = mkTcRnUnknownMessage $ mkPlainDiagnostic (WarningWithFlag flag) noHints msg1 in addDiagnosticAt (locA loc) dia @@ -1847,12 +1860,12 @@ | Just (_, L _ imports) <- ideclImportList decl , length unused == 1 , Just (L loc _) <- find (\(L _ ie) -> ((ieName ie) :: Name) `elem` unused) imports- = let dia = TcRnUnknownMessage $ mkPlainDiagnostic (WarningWithFlag flag) noHints msg2+ = let dia = mkTcRnUnknownMessage $ mkPlainDiagnostic (WarningWithFlag flag) noHints msg2 in addDiagnosticAt (locA loc) dia -- Some imports are unused | otherwise- = let dia = TcRnUnknownMessage $ mkPlainDiagnostic (WarningWithFlag flag) noHints msg2+ = let dia = mkTcRnUnknownMessage $ mkPlainDiagnostic (WarningWithFlag flag) noHints msg2 in addDiagnosticAt (locA loc) dia where@@ -1957,7 +1970,7 @@ all_non_overloaded = all (not . flIsOverloaded) combine :: [LImportDecl GhcRn] -> [LImportDecl GhcRn]- combine = map merge . groupBy ((==) `on` getKey) . sortOn getKey+ combine = map merge . NE.groupAllWith getKey getKey :: LImportDecl GhcRn -> (Bool, Maybe ModuleName, ModuleName) getKey decl =@@ -1969,10 +1982,9 @@ idecl :: ImportDecl GhcRn idecl = unLoc decl - merge :: [LImportDecl GhcRn] -> LImportDecl GhcRn- merge [] = error "getMinimalImports: unexpected empty list"- merge decls@((L l decl) : _) = L l (decl { ideclImportList = Just (Exactly, L (noAnnSrcSpan (locA l)) lies) })- where lies = concatMap (unLoc . snd) $ mapMaybe (ideclImportList . unLoc) decls+ merge :: NonEmpty (LImportDecl GhcRn) -> LImportDecl GhcRn+ merge decls@((L l decl) :| _) = L l (decl { ideclImportList = Just (Exactly, L (noAnnSrcSpan (locA l)) lies) })+ where lies = concatMap (unLoc . snd) $ mapMaybe (ideclImportList . unLoc) $ NE.toList decls printMinimalImports :: HscSource -> [ImportDeclUsage] -> RnM ()@@ -2144,7 +2156,7 @@ addDupDeclErr :: [GlobalRdrElt] -> TcRn () addDupDeclErr [] = panic "addDupDeclErr: empty list" addDupDeclErr gres@(gre : _)- = addErrAt (getSrcSpan (last sorted_names)) $ TcRnUnknownMessage $ mkPlainError noHints $+ = addErrAt (getSrcSpan (last sorted_names)) $ mkTcRnUnknownMessage $ mkPlainError noHints $ -- Report the error at the later location vcat [text "Multiple declarations of" <+> quotes (ppr (greOccName gre)),@@ -2175,7 +2187,7 @@ packageImportErr :: TcRnMessage packageImportErr- = TcRnUnknownMessage $ mkPlainError noHints $+ = mkTcRnUnknownMessage $ mkPlainError noHints $ text "Package-qualified imports are not enabled; use PackageImports" -- This data decl will parse OK@@ -2187,11 +2199,15 @@ -- We can get an operator as the constructor, even in the prefix form: -- data T = :% Int Int -- from interface files, which always print in prefix form+--+-- We also allow type constructor names, which are defined by "type data"+-- declarations. See Note [Type data declarations] in GHC.Rename.Module. checkConName :: RdrName -> TcRn ()-checkConName name = checkErr (isRdrDataCon name) (badDataCon name)+checkConName name+ = checkErr (isRdrDataCon name || isRdrTc name) (badDataCon name) badDataCon :: RdrName -> TcRnMessage badDataCon name- = TcRnUnknownMessage $ mkPlainError noHints $+ = mkTcRnUnknownMessage $ mkPlainError noHints $ hsep [text "Illegal data constructor name", quotes (ppr name)]
compiler/GHC/Rename/Pat.hs view
@@ -469,7 +469,7 @@ -} -- ----------- Entry point 3: rnLPatAndThen ---------------------- General version: parametrized by how you make new names+-- General version: parameterized by how you make new names rnLPatsAndThen :: NameMaker -> [LPat GhcPs] -> CpsRn [LPat GhcRn] rnLPatsAndThen mk = mapM (rnLPatAndThen mk)@@ -643,7 +643,7 @@ unless (scoped_tyvars && type_app) $ case listToMaybe tyargs of Nothing -> pure ()- Just tyarg -> addErr $ TcRnUnknownMessage $ mkPlainError noHints $+ Just tyarg -> addErr $ mkTcRnUnknownMessage $ mkPlainError noHints $ hang (text "Illegal visible type application in a pattern:" <+> quotes (ppr tyarg)) 2 (text "Both ScopedTypeVariables and TypeApplications are"
compiler/GHC/Rename/Splice.hs view
@@ -84,7 +84,7 @@ checkForTemplateHaskellQuotes e = do { thQuotesEnabled <- xoptM LangExt.TemplateHaskellQuotes ; unless thQuotesEnabled $- failWith ( TcRnUnknownMessage $ mkPlainError noHints $ vcat+ failWith ( mkTcRnUnknownMessage $ mkPlainError noHints $ vcat [ text "Syntax error on" <+> ppr e , text ("Perhaps you intended to use TemplateHaskell" ++ " or TemplateHaskellQuotes") ] )@@ -235,21 +235,21 @@ 2 (ppr br_body) illegalBracket :: TcRnMessage-illegalBracket = TcRnUnknownMessage $ mkPlainError noHints $+illegalBracket = mkTcRnUnknownMessage $ mkPlainError noHints $ text "Template Haskell brackets cannot be nested" <+> text "(without intervening splices)" illegalTypedBracket :: TcRnMessage-illegalTypedBracket = TcRnUnknownMessage $ mkPlainError noHints $+illegalTypedBracket = mkTcRnUnknownMessage $ mkPlainError noHints $ text "Typed brackets may only appear in typed splices." illegalUntypedBracket :: TcRnMessage-illegalUntypedBracket = TcRnUnknownMessage $ mkPlainError noHints $+illegalUntypedBracket = mkTcRnUnknownMessage $ mkPlainError noHints $ text "Untyped brackets may only appear in untyped splices." quotedNameStageErr :: HsQuote GhcPs -> TcRnMessage quotedNameStageErr br- = TcRnUnknownMessage $ mkPlainError noHints $+ = mkTcRnUnknownMessage $ mkPlainError noHints $ sep [ text "Stage error: the non-top-level quoted name" <+> ppr br , text "must be used at the same stage at which it is bound" ] @@ -331,7 +331,7 @@ let (herald, ext) = spliceExtension splice extEnabled <- xoptM ext unless extEnabled- (failWith $ TcRnUnknownMessage $ mkPlainError noHints $+ (failWith $ mkTcRnUnknownMessage $ mkPlainError noHints $ text herald <+> text "are not permitted without" <+> ppr ext) where spliceExtension :: HsUntypedSplice GhcPs -> (String, LangExt.Extension)@@ -429,7 +429,7 @@ unqualSplice :: RdrName -- The RdrName for a SplicePointName. See GHC.Hs.Expr -- Note [Lifecycle of an untyped splice, and PendingRnSplice]--- We use "spn" (which is arbitrary) because it is brief but greppable-for.+-- We use "spn" (which is arbitrary) because it is brief but grepable-for. unqualSplice = mkRdrUnqual (mkVarOccFS (fsLit "spn")) rnUntypedSplice :: HsUntypedSplice GhcPs -> RnM (HsUntypedSplice GhcRn, FreeVars)@@ -462,7 +462,7 @@ _ -> do { extEnabled <- xoptM LangExt.TemplateHaskell ; unless extEnabled- (failWith $ TcRnUnknownMessage $ mkPlainError noHints $+ (failWith $ mkTcRnUnknownMessage $ mkPlainError noHints $ text "Top-level splices are not permitted without" <+> ppr LangExt.TemplateHaskell) @@ -886,11 +886,11 @@ , gen ] illegalTypedSplice :: TcRnMessage-illegalTypedSplice = TcRnUnknownMessage $ mkPlainError noHints $+illegalTypedSplice = mkTcRnUnknownMessage $ mkPlainError noHints $ text "Typed splices may not appear in untyped brackets" illegalUntypedSplice :: TcRnMessage-illegalUntypedSplice = TcRnUnknownMessage $ mkPlainError noHints $+illegalUntypedSplice = mkTcRnUnknownMessage $ mkPlainError noHints $ text "Untyped splices may not appear in typed brackets" checkThLocalName :: Name -> RnM ()
compiler/GHC/Rename/Unbound.hs view
@@ -57,6 +57,7 @@ import Data.List (sortBy, partition, nub) import Data.List.NonEmpty ( pattern (:|), NonEmpty ) import Data.Function ( on )+import qualified Data.Semigroup as S {- ************************************************************************@@ -303,10 +304,7 @@ pick = listToMaybe . sortBy cmp . filter select where select imv = case mod_name of Just name -> imv_name imv == name Nothing -> not (imv_qualified imv)- cmp a b =- (compare `on` imv_is_hiding) a b- `thenCmp`- (SrcLoc.leftmost_smallest `on` imv_span) a b+ cmp = on compare imv_is_hiding S.<> on SrcLoc.leftmost_smallest imv_span -- Which of these would export a 'foo' -- (all of these are restricted imports, because if they were not, we
compiler/GHC/Rename/Utils.hs view
@@ -37,7 +37,7 @@ where -import GHC.Prelude+import GHC.Prelude hiding (unzip) import GHC.Core.Type import GHC.Hs@@ -68,6 +68,7 @@ import qualified Data.List.NonEmpty as NE import qualified GHC.LanguageExtensions as LangExt import GHC.Data.Bag+import qualified Data.List as List {- *********************************************************@@ -203,7 +204,7 @@ let bndrs = sig_ty_bndrs ty in case find ((==) InferredSpec . hsTyVarBndrFlag) bndrs of Nothing -> return ()- Just _ -> addErr $ TcRnUnknownMessage $ mkPlainError noHints (withHsDocContext ctxt msg)+ Just _ -> addErr $ mkTcRnUnknownMessage $ mkPlainError noHints (withHsDocContext ctxt msg) where sig_ty_bndrs :: LHsSigType GhcPs -> [HsTyVarBndr Specificity GhcPs] sig_ty_bndrs (L _ (HsSig{sig_bndrs = outer_bndrs}))@@ -312,7 +313,7 @@ addNoNestedForallsContextsErr :: HsDocContext -> SDoc -> LHsType GhcRn -> RnM () addNoNestedForallsContextsErr ctxt what lty = whenIsJust (noNestedForallsContextsErr what lty) $ \(l, err_msg) ->- addErrAt l $ TcRnUnknownMessage $ mkPlainError noHints (withHsDocContext ctxt err_msg)+ addErrAt l $ mkTcRnUnknownMessage $ mkPlainError noHints (withHsDocContext ctxt err_msg) {- ************************************************************************@@ -327,11 +328,18 @@ addFvRn fvs1 thing_inside = do { (res, fvs2) <- thing_inside ; return (res, fvs1 `plusFV` fvs2) } -mapFvRn :: (a -> RnM (b, FreeVars)) -> [a] -> RnM ([b], FreeVars)-mapFvRn f xs = do stuff <- mapM f xs- case unzip stuff of- (ys, fvs_s) -> return (ys, plusFVs fvs_s)+mapFvRn :: Traversable f => (a -> RnM (b, FreeVars)) -> f a -> RnM (f b, FreeVars)+mapFvRn f xs = do+ stuff <- mapM f xs+ case unzip stuff of+ (ys, fvs_s) -> return (ys, foldl' (flip plusFV) emptyFVs fvs_s)+{-# SPECIALIZE mapFvRn :: (a -> RnM (b, FreeVars)) -> [a] -> RnM ([b], FreeVars) #-} +unzip :: Functor f => f (a, b) -> (f a, f b)+unzip = \ xs -> (fmap fst xs, fmap snd xs)+{-# NOINLINE [1] unzip #-}+{-# RULES "unzip/List" unzip = List.unzip #-}+ mapMaybeFvRn :: (a -> RnM (b, FreeVars)) -> Maybe a -> RnM (Maybe b, FreeVars) mapMaybeFvRn _ Nothing = return (Nothing, emptyFVs) mapMaybeFvRn f (Just x) = do { (y, fvs) <- f x; return (Just y, fvs) }@@ -390,7 +398,7 @@ warnRedundantRecordWildcard :: RnM () warnRedundantRecordWildcard = whenWOptM Opt_WarnRedundantRecordWildcards $- let msg = TcRnUnknownMessage $+ let msg = mkTcRnUnknownMessage $ mkPlainDiagnostic (WarningWithFlag Opt_WarnRedundantRecordWildcards) noHints redundantWildcardWarning@@ -489,7 +497,7 @@ addUnusedWarning :: WarningFlag -> OccName -> SrcSpan -> SDoc -> RnM () addUnusedWarning flag occ span msg = do- let diag = TcRnUnknownMessage $ mkPlainDiagnostic (WarningWithFlag flag) noHints $+ let diag = mkTcRnUnknownMessage $ mkPlainDiagnostic (WarningWithFlag flag) noHints $ sep [msg <> colon, nest 2 $ pprNonVarNameSpace (occNameSpace occ) <+> quotes (ppr occ)]@@ -497,7 +505,7 @@ unusedRecordWildcardWarning :: TcRnMessage unusedRecordWildcardWarning =- TcRnUnknownMessage $ mkPlainDiagnostic (WarningWithFlag Opt_WarnUnusedRecordWildcards) noHints $+ mkTcRnUnknownMessage $ mkPlainDiagnostic (WarningWithFlag Opt_WarnUnusedRecordWildcards) noHints $ wildcardDoc $ text "No variables bound in the record wildcard match are used" redundantWildcardWarning :: SDoc@@ -547,7 +555,7 @@ -- already, and we don't want an error cascade. = return () | otherwise- = addErr $ TcRnUnknownMessage $ mkPlainError noHints $+ = addErr $ mkTcRnUnknownMessage $ mkPlainError noHints $ (vcat [ text "Ambiguous occurrence" <+> quotes (ppr rdr_name) , text "It could refer to" , nest 3 (vcat (msg1 : msgs)) ])@@ -600,7 +608,7 @@ dupNamesErr :: Outputable n => (n -> SrcSpan) -> NE.NonEmpty n -> RnM () dupNamesErr get_loc names- = addErrAt big_loc $ TcRnUnknownMessage $ mkPlainError noHints $+ = addErrAt big_loc $ mkTcRnUnknownMessage $ mkPlainError noHints $ vcat [text "Conflicting definitions for" <+> quotes (ppr (NE.head names)), locations] where@@ -610,19 +618,19 @@ badQualBndrErr :: RdrName -> TcRnMessage badQualBndrErr rdr_name- = TcRnUnknownMessage $ mkPlainError noHints $+ = mkTcRnUnknownMessage $ mkPlainError noHints $ text "Qualified name in binding position:" <+> ppr rdr_name typeAppErr :: String -> LHsType GhcPs -> TcRnMessage typeAppErr what (L _ k)- = TcRnUnknownMessage $ mkPlainError noHints $+ = mkTcRnUnknownMessage $ mkPlainError noHints $ hang (text "Illegal visible" <+> text what <+> text "application" <+> quotes (char '@' <> ppr k)) 2 (text "Perhaps you intended to use TypeApplications") badFieldConErr :: Name -> FieldLabelString -> TcRnMessage badFieldConErr con field- = TcRnUnknownMessage $ mkPlainError noHints $+ = mkTcRnUnknownMessage $ mkPlainError noHints $ hsep [text "Constructor" <+> quotes (ppr con), text "does not have field", quotes (ppr field)] @@ -633,7 +641,7 @@ | tup_size <= mAX_TUPLE_SIZE = return () | otherwise- = addErr $ TcRnUnknownMessage $ mkPlainError noHints $+ = addErr $ mkTcRnUnknownMessage $ mkPlainError noHints $ sep [text "A" <+> int tup_size <> text "-tuple is too large for GHC", nest 2 (parens (text "max size is" <+> int mAX_TUPLE_SIZE)), nest 2 (text "Workaround: use nested tuples or define a data type")]@@ -644,7 +652,7 @@ | tup_size <= mAX_CTUPLE_SIZE = return () | otherwise- = addErr $ TcRnUnknownMessage $ mkPlainError noHints $+ = addErr $ mkTcRnUnknownMessage $ mkPlainError noHints $ hang (text "Constraint tuple arity too large:" <+> int tup_size <+> parens (text "max arity =" <+> int mAX_CTUPLE_SIZE)) 2 (text "Instead, use a nested tuple")
compiler/GHC/Runtime/Debugger.hs view
@@ -161,7 +161,7 @@ return t' where --- Processing suspensions. Give names and recopilate info+-- Processing suspensions. Give names and collect info nameSuspensionsAndGetInfos :: HscEnv -> IORef [String] -> TermFold (IO (Term, [(Name,Type,ForeignHValue)])) nameSuspensionsAndGetInfos hsc_env freeNames = TermFold
compiler/GHC/Runtime/Eval.hs view
@@ -705,7 +705,7 @@ There are 3 situations where items are removed from the Id list (or replaced with `Nothing`): 1.) If function `GHC.StgToByteCode.schemeER_wrk` (which creates- the Id list) doesn't find an Id in the ByteCode environement.+ the Id list) doesn't find an Id in the ByteCode environment. 2.) If function `GHC.Runtime.Eval.bindLocalsAtBreakpoint` filters out unboxed elements from the Id list, because GHCi cannot yet handle them.@@ -849,7 +849,7 @@ _not_a_home_module -> return False -- | Looks up an identifier in the current interactive context (for :info)--- Filter the instances by the ones whose tycons (or clases resp)+-- Filter the instances by the ones whose tycons (or classes resp) -- are in scope (qualified or otherwise). Otherwise we list a whole lot too many! -- The exact choice of which ones to show, and which to hide, is a judgement call. -- (see #1581)
compiler/GHC/Runtime/Heap/Inspect.hs view
@@ -781,7 +781,7 @@ EvalSuccess _ -> go (pred max_depth) my_ty old_ty a EvalException ex -> do -- Report the exception to the UI- traceTR $ text "Exception occured:" <+> text (show ex)+ traceTR $ text "Exception occurred:" <+> text (show ex) liftIO $ throwIO $ fromSerializableException ex -- Blackholes are indirections iff the payload is not TSO or BLOCKING_QUEUE. If -- the indirection is a TSO or BLOCKING_QUEUE, we return the BLACKHOLE itself as@@ -836,7 +836,7 @@ Nothing -> do -- This can happen for private constructors compiled -O0 -- where the .hi descriptor does not export them -- In such case, we return a best approximation:- -- ignore the unpointed args, and recover the pointeds+ -- ignore the unpointed args, and recover the pointed ones -- This preserves laziness, and should be safe. traceTR (text "Not constructor" <+> ppr dcname) let dflags = hsc_dflags hsc_env@@ -1219,7 +1219,7 @@ ~~~~~~~~~~~ Consider a function obtainType that takes a value and a type and produces the Term representation and a substitution (the improvement).-Assume an auxiliar rtti' function which does the actual job if recovering+Assume an auxiliary rtti' function which does the actual job if recovering the type, but which may produce a false type. In pseudocode:
compiler/GHC/Stg/Debug.hs view
@@ -252,7 +252,7 @@ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ In the old times, each usage of a data constructor used the same info table.-This made it impossible to distinguish which actual usuage of a data constructor was+This made it impossible to distinguish which actual usage of a data constructor was contributing primarily to the allocation in a program. Using the `-fdistinct-info-tables` flag you can cause code generation to generate a distinct info table for each usage of a constructor. Then, when inspecting the heap you can see precisely which usage of a constructor
compiler/GHC/Stg/InferTags.hs view
@@ -184,7 +184,7 @@ careful to make sure we still enter them when needed. As it makes little difference for runtime performance I've treated functions as TagDunno in a few places where it made the code simpler. But besides implementation complexity there isn't any reason-why we couldn't be more rigourous in dealing with functions.+why we couldn't be more rigorous in dealing with functions. NB: It turned in #21193 that PAPs get tag zero, so the tag check can't be omitted for functions. So option two isn't really an option without reworking this anyway.@@ -571,7 +571,7 @@ let f<?> z = case z of z'<TagProper> -> (# c, x #) Here we will infer for f the Signature <TagTuple[TagProper,TagDunno]>.-This information will be used if we scrutinze a saturated application of+This information will be used if we scrutinize a saturated application of `f` in order to determine the taggedness of the result. That is for `case f x of (# r1,r2 #) -> rhs` we can infer r1<TagProper> and r2<TagDunno> which allows us to skip all tag checks on `r1`
compiler/GHC/Stg/InferTags/Rewrite.hs view
@@ -21,15 +21,19 @@ import GHC.Prelude import GHC.Builtin.PrimOps ( PrimOp(..) )+import GHC.Types.Basic ( CbvMark (..), isMarkedCbv+ , TopLevelFlag(..), isTopLevel+ , Levity(..) ) import GHC.Types.Id import GHC.Types.Name import GHC.Types.Unique.Supply import GHC.Types.Unique.FM import GHC.Types.RepType-import GHC.Unit.Types (Module)+import GHC.Types.Var.Set+import GHC.Unit.Types ( Module ) import GHC.Core.DataCon-import GHC.Core (AltCon(..) )+import GHC.Core ( AltCon(..) ) import GHC.Core.Type import GHC.StgToCmm.Types@@ -47,8 +51,7 @@ import GHC.Stg.InferTags.Types import Control.Monad-import GHC.Types.Basic (CbvMark (NotMarkedCbv, MarkedCbv), isMarkedCbv, TopLevelFlag(..), isTopLevel)-import GHC.Types.Var.Set+ -- import GHC.Utils.Trace -- import GHC.Driver.Ppr @@ -88,12 +91,12 @@ $wf :: (a -> b -> d -> c) -> a -> b -> c -> d $wf m1 a b c = m1 a b c -It's notable that the worker is called *undersatured* in the wrapper.+It's notable that the worker is called *undersaturated* in the wrapper. At runtime what happens is that the wrapper will allocate a PAP which once fully applied will call the worker. And all is fine. But what about a call by value function! Well the function returned by `f` would-be a unknown call, so we lose the ability to enfore the invariant that+be a unknown call, so we lose the ability to enforce the invariant that cbv marked arguments from StictWorkerId's are actually properly tagged as the annotations would be unavailable at the (unknown) call site. @@ -128,7 +131,7 @@ getMap = RM $ ((\(fst,_,_,_) -> fst) <$> get) setMap :: (UniqFM Id TagSig) -> RM ()-setMap m = RM $ do+setMap !m = RM $ do (_,us,mod,lcls) <- get put (m, us,mod,lcls) @@ -139,7 +142,7 @@ getFVs = RM $ ((\(_,_,_,lcls) -> lcls) <$> get) setFVs :: IdSet -> RM ()-setFVs fvs = RM $ do+setFVs !fvs = RM $ do (tag_map,us,mod,_lcls) <- get put (tag_map, us,mod,fvs) @@ -195,9 +198,9 @@ withClosureLcls :: DIdSet -> RM a -> RM a withClosureLcls fvs act = do old_fvs <- getFVs- let fvs' = nonDetStrictFoldDVarSet (flip extendVarSet) old_fvs fvs+ let !fvs' = nonDetStrictFoldDVarSet (flip extendVarSet) old_fvs fvs setFVs fvs'- r <- act+ !r <- act setFVs old_fvs return r @@ -206,9 +209,9 @@ withLcl :: Id -> RM a -> RM a withLcl fv act = do old_fvs <- getFVs- let fvs' = extendVarSet old_fvs fv+ let !fvs' = extendVarSet old_fvs fv setFVs fvs'- r <- act+ !r <- act setFVs old_fvs return r @@ -217,12 +220,14 @@ this_mod <- getMod case nameIsLocalOrFrom this_mod (idName v) of True- | isUnliftedType (idType v)+ | Just Unlifted <- typeLevity_maybe (idType v)+ -- NB: v might be the Id of a representation-polymorphic join point,+ -- so we shouldn't use isUnliftedType here. See T22212. -> return True | otherwise -> do -- Local binding !s <- getMap let !sig = lookupWithDefaultUFM s (pprPanic "unknown Id:" (ppr v)) v- return $ case sig of+ return $! case sig of TagSig info -> case info of TagDunno -> False@@ -234,7 +239,7 @@ , isNullaryRepDataCon con -> return True | Just lf_info <- idLFInfo_maybe v- -> return $+ -> return $! -- Can we treat the thing as tagged based on it's LFInfo? case lf_info of -- Function, applied not entered.@@ -336,7 +341,7 @@ rewriteRhs _binding (StgRhsClosure fvs ccs flag args body) = do withBinders NotTopLevel args $ withClosureLcls fvs $- StgRhsClosure fvs ccs flag (map fst args) <$> rewriteExpr False body+ StgRhsClosure fvs ccs flag (map fst args) <$> rewriteExpr body -- return (closure) fvArgs :: [StgArg] -> RM DVarSet@@ -345,40 +350,36 @@ -- pprTraceM "fvArgs" (text "args:" <> ppr args $$ text "lcls:" <> pprVarSet (fv_lcls) (braces . fsep . map ppr) ) return $ mkDVarSet [ v | StgVarArg v <- args, elemVarSet v fv_lcls] -type IsScrut = Bool- rewriteArgs :: [StgArg] -> RM [StgArg] rewriteArgs = mapM rewriteArg rewriteArg :: StgArg -> RM StgArg rewriteArg (StgVarArg v) = StgVarArg <$!> rewriteId v rewriteArg (lit@StgLitArg{}) = return lit --- Attach a tagSig if it's tagged rewriteId :: Id -> RM Id rewriteId v = do- is_tagged <- isTagged v+ !is_tagged <- isTagged v if is_tagged then return $! setIdTagSig v (TagSig TagProper) else return v -rewriteExpr :: IsScrut -> InferStgExpr -> RM TgStgExpr-rewriteExpr _ (e@StgCase {}) = rewriteCase e-rewriteExpr _ (e@StgLet {}) = rewriteLet e-rewriteExpr _ (e@StgLetNoEscape {}) = rewriteLetNoEscape e-rewriteExpr isScrut (StgTick t e) = StgTick t <$!> rewriteExpr isScrut e-rewriteExpr _ e@(StgConApp {}) = rewriteConApp e--rewriteExpr isScrut e@(StgApp {}) = rewriteApp isScrut e-rewriteExpr _ (StgLit lit) = return $! (StgLit lit)-rewriteExpr _ (StgOpApp op@(StgPrimOp DataToTagOp) args res_ty) = do+rewriteExpr :: InferStgExpr -> RM TgStgExpr+rewriteExpr (e@StgCase {}) = rewriteCase e+rewriteExpr (e@StgLet {}) = rewriteLet e+rewriteExpr (e@StgLetNoEscape {}) = rewriteLetNoEscape e+rewriteExpr (StgTick t e) = StgTick t <$!> rewriteExpr e+rewriteExpr e@(StgConApp {}) = rewriteConApp e+rewriteExpr e@(StgApp {}) = rewriteApp e+rewriteExpr (StgLit lit) = return $! (StgLit lit)+rewriteExpr (StgOpApp op@(StgPrimOp DataToTagOp) args res_ty) = do (StgOpApp op) <$!> rewriteArgs args <*> pure res_ty-rewriteExpr _ (StgOpApp op args res_ty) = return $! (StgOpApp op args res_ty)+rewriteExpr (StgOpApp op args res_ty) = return $! (StgOpApp op args res_ty) rewriteCase :: InferStgExpr -> RM TgStgExpr rewriteCase (StgCase scrut bndr alt_type alts) = withBinder NotTopLevel bndr $ pure StgCase <*>- rewriteExpr True scrut <*>+ rewriteExpr scrut <*> pure (fst bndr) <*> pure alt_type <*> mapM rewriteAlt alts@@ -388,7 +389,7 @@ rewriteAlt :: InferStgAlt -> RM TgStgAlt rewriteAlt alt@GenStgAlt{alt_con=_, alt_bndrs=bndrs, alt_rhs=rhs} = withBinders NotTopLevel bndrs $ do- !rhs' <- rewriteExpr False rhs+ !rhs' <- rewriteExpr rhs return $! alt {alt_bndrs = map fst bndrs, alt_rhs = rhs'} rewriteLet :: InferStgExpr -> RM TgStgExpr@@ -396,7 +397,7 @@ (!bind') <- rewriteBinds NotTopLevel bind withBind NotTopLevel bind $ do -- pprTraceM "withBindLet" (ppr $ bindersOfX bind)- !expr' <- rewriteExpr False expr+ !expr' <- rewriteExpr expr return $! (StgLet xt bind' expr') rewriteLet _ = panic "Impossible" @@ -404,7 +405,7 @@ rewriteLetNoEscape (StgLetNoEscape xt bind expr) = do (!bind') <- rewriteBinds NotTopLevel bind withBind NotTopLevel bind $ do- !expr' <- rewriteExpr False expr+ !expr' <- rewriteExpr expr return $! (StgLetNoEscape xt bind' expr') rewriteLetNoEscape _ = panic "Impossible" @@ -424,19 +425,12 @@ rewriteConApp _ = panic "Impossible" --- Special case: Expressions like `case x of { ... }`-rewriteApp :: IsScrut -> InferStgExpr -> RM TgStgExpr-rewriteApp True (StgApp f []) = do- -- pprTraceM "rewriteAppScrut" (ppr f)- f_tagged <- isTagged f- -- isTagged looks at more than the result of our analysis.- -- So always update here if useful.- let f' = if f_tagged- -- TODO: We might consisder using a subst env instead of setting the sig only for select places.- then setIdTagSig f (TagSig TagProper)- else f+-- Special case: Atomic binders, usually in a case context like `case f of ...`.+rewriteApp :: InferStgExpr -> RM TgStgExpr+rewriteApp (StgApp f []) = do+ f' <- rewriteId f return $! StgApp f' []-rewriteApp _ (StgApp f args)+rewriteApp (StgApp f args) -- pprTrace "rewriteAppOther" (ppr f <+> ppr args) False -- = undefined | Just marks <- idCbvMarks_maybe f@@ -457,8 +451,8 @@ cbvArgIds = [x | StgVarArg x <- map fstOf3 cbvArgInfo] :: [Id] mkSeqs args cbvArgIds (\cbv_args -> StgApp f cbv_args) -rewriteApp _ (StgApp f args) = return $ StgApp f args-rewriteApp _ _ = panic "Impossible"+rewriteApp (StgApp f args) = return $ StgApp f args+rewriteApp _ = panic "Impossible" -- `mkSeq` x x' e generates `case x of x' -> e` -- We could also substitute x' for x in e but that's so rarely beneficial@@ -505,7 +499,7 @@ -- For proper data cons we have to check. | otherwise = assertPpr (length args == length (dataConRuntimeRepStrictness con))- (text "Missmatched con arg and con rep strictness lengths:" $$+ (text "Mismatched con arg and con rep strictness lengths:" $$ text "Con" <> ppr con <+> text "is applied to" <+> ppr args $$ text "But seems to have arity" <> ppr (length repStrictness)) $ [ arg | (arg,MarkedStrict)
compiler/GHC/Stg/Lint.hs view
@@ -68,8 +68,8 @@ More precisely, if f :: ty1 -> ty2, then in the application (f e) where e :: ty1', we must have kind(ty1) = kind(ty1'). -So the STG type system does not distinguish beteen Int and Bool,-but it /does/ distinguish beteen Int and Int#, because they have+So the STG type system does not distinguish between Int and Bool,+but it /does/ distinguish between Int and Int#, because they have different kinds. Actually, since all terms have kind (TYPE rep), we might say that the STG language is well-runtime-rep'd. @@ -134,7 +134,7 @@ -> [GenStgTopBinding a] -> IO () -lintStgTopBindings platform logger diag_opts opts extra_vars this_mod unarised whodunnit binds+lintStgTopBindings platform logger diag_opts opts extra_vars this_mod unarised whodunit binds = {-# SCC "StgLint" #-} case initL platform diag_opts this_mod unarised opts top_level_binds (lint_binds binds) of Nothing ->@@ -143,7 +143,7 @@ logMsg logger Err.MCDump noSrcSpan $ withPprStyle defaultDumpStyle (vcat [ text "*** Stg Lint ErrMsgs: in" <+>- text whodunnit <+> text "***",+ text whodunit <+> text "***", msg, text "*** Offending Program ***", pprGenStgTopBindings opts binds,@@ -356,7 +356,7 @@ | and $ zipWith (primRepCompatible platform) actual_rep expected_rep = match_args actual_reps_left expected_reps_left - | otherwise = addErrL $ hang (text "Function type reps and function argument reps missmatched") 2 $+ | otherwise = addErrL $ hang (text "Function type reps and function argument reps mismatched") 2 $ (text "In application " <> ppr fun <+> ppr args $$ text "argument rep:" <> ppr actual_rep $$ text "expected rep:" <> ppr expected_rep $$@@ -512,7 +512,7 @@ = errs_so_far `snocBag` mk_msg locs where mk_msg (loc:_) = let (l,hdr) = dumpLoc loc- in mkLocMessage (Err.mkMCDiagnostic diag_opts WarningWithoutFlag)+ in mkLocMessage (Err.mkMCDiagnostic diag_opts WarningWithoutFlag Nothing) l (hdr $$ msg) mk_msg [] = msg
compiler/GHC/Stg/Pipeline.hs view
@@ -96,7 +96,7 @@ diag_opts ppr_opts extra_vars this_mod unarised | otherwise- = \ _whodunnit _binds -> return ()+ = \ _whodunit _binds -> return () ------------------------------------------- do_stg_pass :: Module -> [StgTopBinding] -> StgToDo -> StgM [StgTopBinding]
compiler/GHC/Stg/Unarise.hs view
@@ -310,7 +310,7 @@ data UnariseVal = MultiVal [OutStgArg] -- MultiVal to tuple. Can be empty list (void).- | UnaryVal OutStgArg -- See NOTE [Renaming during unarisation].+ | UnaryVal OutStgArg -- See Note [Renaming during unarisation]. instance Outputable UnariseVal where ppr (MultiVal args) = text "MultiVal" <+> ppr args@@ -709,7 +709,7 @@ Here after unarise we should still get a function with arity 3. Similarly in the call site we shouldn't remove void arguments: - f (# (# #), (# #) #) voidId rw+ f (# (# #), (# #) #) void# rw When unarising <body>, we extend the environment with these binders:
compiler/GHC/StgToByteCode.hs view
@@ -1330,7 +1330,7 @@ Addr# address_of_C_fn <placeholder-for-result#> (must be an unboxed type) - The interpreter then calls the marshall code mentioned+ The interpreter then calls the marshal code mentioned in the CCALL insn, passing it (& <placeholder-for-result#>), that is, the addr of the topmost word in the stack. When this returns, the placeholder will have been@@ -1346,7 +1346,7 @@ copies the args to the C stack, calls the stacked addr, and parks the result back in the placeholder. The interpreter calls it as a normal C call, assuming it has a signature- void marshall_code ( StgWord* ptr_to_top_of_stack )+ void marshal_code ( StgWord* ptr_to_top_of_stack ) -} -- resolve static address maybe_static_target :: Maybe Literal
compiler/GHC/StgToCmm/Bind.hs view
@@ -783,5 +783,5 @@ -- Not called for StgRhsCon which have global info tables built in -- CgConTbls.hs with a description generated from the data constructor closureDescription mod_name name- = renderWithContext defaultSDocContext+ = showSDocOneLine defaultSDocContext (char '<' <> pprFullName mod_name name <> char '>')
compiler/GHC/StgToCmm/Env.hs view
@@ -119,7 +119,7 @@ setBinds new_binds -- Inside GHC the average module creates 385 external references--- with noteable cgIdInfo (so not generated by mkLFArgument).+-- with notable cgIdInfo (so not generated by mkLFArgument). -- On average 200 of these are covered by True/False/[] -- and nullary constructors make up ~80. -- One would think it would be worthwhile to cache these.
compiler/GHC/StgToCmm/Expr.hs view
@@ -393,7 +393,7 @@ * If f is recursive, and the hot loop wouldn't allocate, but the exit branch does then we do a redundant heap check.- * We use one more instruction to de-allocate the unused heap in the branch using less heap. (Neglible)+ * We use one more instruction to de-allocate the unused heap in the branch using less heap. (Negligible) * A small risk of running gc slightly more often than needed especially if one branch allocates a lot. The upsides are:@@ -912,7 +912,7 @@ -- tag from the info table, and switch on that. The only technically -- tricky part is that the default case needs (logical) duplication. -- To do this we emit an extra label for it and branch to that from--- the second switch. This avoids duplicated codegen. See Trac #14373.+-- the second switch. This avoids duplicated codegen. See #14373. -- See Note [Double switching for big families] for the mechanics -- involved. --
compiler/GHC/StgToCmm/Layout.hs view
@@ -208,7 +208,7 @@ r <- direct_call "slow_call" NativeNodeCall (mkRtsApFastLabel rts_fun) arity ((P,Just fun):argsreps) emitComment $ mkFastString ("slow_call for " ++- renderWithContext ctx (pdoc platform fun) +++ showSDocOneLine ctx (pdoc platform fun) ++ " with pat " ++ unpackFS rts_fun) return r
compiler/GHC/StgToCmm/Lit.hs view
@@ -52,7 +52,7 @@ -- not unpackFS; we want the UTF-8 byte stream. cgLit (LitRubbish rep) = case expectOnly "cgLit" prim_reps of -- Note [Post-unarisation invariants]- VoidRep -> panic "cgLit:VoidRep" -- dito+ VoidRep -> panic "cgLit:VoidRep" -- ditto LiftedRep -> idInfoToAmode <$> getCgIdInfo unitDataConId UnliftedRep -> idInfoToAmode <$> getCgIdInfo unitDataConId AddrRep -> cgLit LitNullAddr
compiler/GHC/StgToCmm/Monad.hs view
@@ -294,7 +294,7 @@ data FCodeState = MkFCodeState { fcs_upframeoffset :: UpdFrameOffset -- ^ Size of current update frame UpdFrameOffset must be kept lazy or -- else the RTS will deadlock _and_ also experience a severe- -- performance degredation+ -- performance degradation , fcs_sequel :: !Sequel -- ^ What to do at end of basic block , fcs_selfloop :: Maybe SelfLoopInfo -- ^ Which tail calls can be compiled as local jumps? -- See Note [Self-recursive tail calls] in GHC.StgToCmm.Expr
compiler/GHC/StgToCmm/Prim.hs view
@@ -1568,6 +1568,9 @@ MaskUninterruptibleOp -> alwaysExternal UnmaskAsyncExceptionsOp -> alwaysExternal MaskStatus -> alwaysExternal+ NewPromptTagOp -> alwaysExternal+ PromptOp -> alwaysExternal+ Control0Op -> alwaysExternal AtomicallyOp -> alwaysExternal RetryOp -> alwaysExternal CatchRetryOp -> alwaysExternal@@ -2237,7 +2240,8 @@ vecElemProjectCast _ _ _ = Nothing --- NOTE [SIMD Design for the future]+-- Note [SIMD Design for the future]+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -- Check to make sure that we can generate code for the specified vector type -- given the current set of dynamic flags. -- Currently these checks are specific to x86 and x86_64 architecture.
compiler/GHC/StgToCmm/TagCheck.hs view
@@ -73,7 +73,7 @@ when check_tags act -- | Call barf if we failed to predict a tag correctly.--- This is immensly useful when debugging issues in tag inference+-- This is immensely useful when debugging issues in tag inference -- as it will result in a program abort when we encounter an invalid -- call/heap object, rather than leaving it be and segfaulting arbitrary -- or producing invalid results.@@ -174,6 +174,6 @@ info <- getCgIdInfo v if taggedCgInfo info then return ()- else pprPanic "Arg not tagged as expectd" (ppr msg <+> ppr arg)+ else pprPanic "Arg not tagged as expected" (ppr msg <+> ppr arg)
compiler/GHC/StgToCmm/Utils.hs view
@@ -604,7 +604,7 @@ in InfoProvEnt cl cn "" this_mod Nothing -- | Convert source information collected about identifiers in 'GHC.STG.Debug'--- to entries suitable for placing into the info table provenenance table.+-- to entries suitable for placing into the info table provenance table. convertInfoProvMap :: [CmmInfoTable] -> Module -> InfoTableProvMap -> [InfoProvEnt] convertInfoProvMap defns this_mod (InfoTableProvMap (UniqMap dcenv) denv infoTableToSourceLocationMap) = map (\cmit ->
compiler/GHC/SysTools/Ar.hs view
@@ -6,7 +6,7 @@ such restricted to mach-o only. As libtool on macOS and gnu libtool are very different, there was no simple portable way to support this. -libtool for static archives does essentially: concatinate the input archives,+libtool for static archives does essentially: concatenate the input archives, add the input objects, and create a symbol index. Using `ar` for this task fails as even `ar` (bsd and gnu, llvm, ...) do not provide the same features across platforms (e.g. index prefixed retrieval of objects with@@ -144,7 +144,7 @@ if C.unpack (C.take 1 name) == "/" then case C.takeWhile (/= ' ') name of name@"/" -> name -- symbol table- name@"//" -> name -- extendedn file names table+ name@"//" -> name -- extended file names table name -> getExtName extInfo (read . C.unpack $ C.drop 1 name) else C.takeWhile (/= '/') name case name of@@ -158,7 +158,7 @@ getExtName (Just info) offset = C.takeWhile (/= '/') . C.drop offset $ filedata info -- | put an Archive Entry. This assumes that the entries--- have been preprocessed to account for the extenden file name+-- have been preprocessed to account for the extended file name -- table section "//" e.g. for GNU Archives. Or that the names -- have been move into the payload for BSD Archives. putArchEntry :: ArchiveEntry -> PutM ()
compiler/GHC/SysTools/Elf.hs view
@@ -70,7 +70,7 @@ same thing applies to the field containing the number of segments, but we don't care about it here). - ELF-next: to solve this, theses fields in the ELF header have an escape+ ELF-next: to solve this, these fields in the ELF header have an escape value (different for each case), and the actual section number is stashed into unused fields in the first section header.
compiler/GHC/Tc/Deriv.hs view
@@ -1632,7 +1632,7 @@ newtype T1 a = T1 (StateT S1 IO a ) deriving( Monad ) Remember, too, that type families are currently (conservatively) given a recursive flag, so this also allows newtype deriving to work-for type famillies.+for type families. We used to exclude recursive types, because we had a rather simple minded way of generating the instance decl:@@ -1926,7 +1926,7 @@ -- canDeriveAnyClass should ensure that this code can't be reached -- unless -XDeriveAnyClass is enabled. assertPpr (xopt LangExt.DeriveAnyClass dflags)- (ppr "genFamInsts: bad derived class" <+> ppr clas) $+ (text "genFamInsts: bad derived class" <+> ppr clas) $ mapM (tcATDefault loc mini_subst emptyNameSet) (classATItems clas) pure $ concat tyfam_insts
compiler/GHC/Tc/Deriv/Functor.hs view
@@ -538,8 +538,36 @@ go _ _ = (caseTrivial,False) --- Return all syntactic subterms of ty that contain var somewhere--- These are the things that should appear in instance constraints+-- | Return all syntactic subterms of a 'Type' that are applied to the 'TyVar'+-- argument. This determines what constraints should be inferred for derived+-- 'Functor', 'Foldable', and 'Traversable' instances in "GHC.Tc.Deriv.Infer".+-- For instance, if we have:+--+-- @+-- data Foo a = MkFoo Int a (Maybe a) (Either Int (Maybe a))+-- @+--+-- Then the following would hold:+--+-- * @'deepSubtypesContaining' a Int@ would return @[]@, since @Int@ does not+-- contain the type variable @a@ at all.+--+-- * @'deepSubtypesContaining' a a@ would return @[]@. Although the type @a@+-- contains the type variable @a@, it is not /applied/ to @a@, which is the+-- criterion that 'deepSubtypesContaining' checks for.+--+-- * @'deepSubtypesContaining' a (Maybe a)@ would return @[Maybe]@, as @Maybe@+-- is applied to @a@.+--+-- * @'deepSubtypesContaining' a (Either Int (Maybe a))@ would return+-- @[Either Int, Maybe]@. Both of these types are applied to @a@ through+-- composition.+--+-- As used in "GHC.Tc.Deriv.Infer", the 'Type' argument will always come from+-- 'derivDataConInstArgTys', so it is important that the 'TyVar' comes from+-- 'dataConUnivTyVars' to match. Make sure /not/ to take the 'TyVar' from+-- 'tyConTyVars', as these differ from the 'dataConUnivTyVars' when the data+-- type is a GADT. (See #22167 for what goes wrong if 'tyConTyVars' is used.) deepSubtypesContaining :: TyVar -> Type -> [TcType] deepSubtypesContaining tv = functorLikeTraverse tv
compiler/GHC/Tc/Deriv/Generate.hs view
@@ -452,7 +452,7 @@ = nlHsCase (nlHsVar a_RDR) $ map (mkOrdOpAlt op) tycon_data_cons -- i.e. case a of { C1 x y -> case b of C1 x y -> ....compare x,y...- -- C2 x -> case b of C2 x -> ....comopare x.... }+ -- C2 x -> case b of C2 x -> ....compare x.... } | null non_nullary_cons -- All nullary, so go straight to comparing tags = mkTagCmp op
compiler/GHC/Tc/Deriv/Generics.hs view
@@ -93,10 +93,25 @@ ************************************************************************ -} +-- | Called by 'GHC.Tc.Deriv.Infer.inferConstraints'; generates a list of+-- types, each of which must be a 'Functor' in order for the 'Generic1'+-- instance to work. For instance, if we have:+--+-- @+-- data Foo a = MkFoo Int a (Maybe a) (Either Int (Maybe a))+-- @+--+-- Then @'get_gen1_constrained_tys' a (f (g a))@ would return @[Either Int]@,+-- as a derived 'Generic1' instance would need to call 'fmap' at that type.+-- Invoking @'get_gen1_constrained_tys' a@ on any of the other fields would+-- return @[]@.+--+-- 'get_gen1_constrained_tys' is very similar in spirit to+-- 'deepSubtypesContaining' in "GHC.Tc.Deriv.Functor". Just like with+-- 'deepSubtypesContaining', it is important that the 'TyVar' argument come+-- from 'dataConUnivTyVars'. (See #22167 for what goes wrong if 'tyConTyVars'+-- is used.) get_gen1_constrained_tys :: TyVar -> Type -> [Type]--- called by GHC.Tc.Deriv.Infer.inferConstraints; generates a list of--- types, each of which must be a Functor in order for the Generic1 instance to--- work. get_gen1_constrained_tys argVar = argTyFold argVar $ ArgTyAlg { ata_rec0 = const [] , ata_par1 = [], ata_rec1 = const []@@ -1056,7 +1071,7 @@ The recommended approach thus far was to increase unfolding threshold, but this makes GHC inline more aggressively in general, whereas it should only be more-aggresive with generics-based code.+aggressive with generics-based code. The solution is to use a heuristic that'll annotate Generic class methods with INLINE[1] pragmas (the explicit phase is used to give users phase control as
compiler/GHC/Tc/Deriv/Infer.hs view
@@ -53,6 +53,8 @@ import Control.Monad import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Reader (ask)+import Data.Function (on)+import Data.Functor.Classes (liftEq) import Data.List (sortBy) import Data.Maybe @@ -176,9 +178,10 @@ -- Constraints arising from the arguments of each constructor con_arg_constraints- :: (CtOrigin -> TypeOrKind- -> Type- -> [(ThetaSpec, Maybe Subst)])+ :: ([TyVar] -> CtOrigin+ -> TypeOrKind+ -> Type+ -> [(ThetaSpec, Maybe Subst)]) -> (ThetaSpec, [TyVar], [TcType], DerivInstTys) con_arg_constraints get_arg_constraints = let -- Constraints from the fields of each data constructor.@@ -193,7 +196,8 @@ , not (isUnliftedType arg_ty) , let orig = DerivOriginDC data_con arg_n wildcard , preds_and_mbSubst- <- get_arg_constraints orig arg_t_or_k arg_ty+ <- get_arg_constraints (dataConUnivTyVars data_con)+ orig arg_t_or_k arg_ty ] -- Stupid constraints from DatatypeContexts. Note that we -- must gather these constraints from the data constructors,@@ -235,21 +239,39 @@ is_functor_like = tcTypeKind inst_ty `tcEqKind` typeToTypeKind || is_generic1 - get_gen1_constraints :: Class -> CtOrigin -> TypeOrKind -> Type- -> [(ThetaSpec, Maybe Subst)]- get_gen1_constraints functor_cls orig t_or_k ty+ get_gen1_constraints ::+ Class+ -> [TyVar] -- The universally quantified type variables for the+ -- data constructor+ -> CtOrigin -> TypeOrKind -> Type+ -> [(ThetaSpec, Maybe Subst)]+ get_gen1_constraints functor_cls dc_univs orig t_or_k ty = mk_functor_like_constraints orig t_or_k functor_cls $- get_gen1_constrained_tys last_tv ty+ get_gen1_constrained_tys last_dc_univ ty+ where+ -- If we are deriving an instance of 'Generic1' and have made+ -- it this far, then there should be at least one universal type+ -- variable, making this use of 'last' safe.+ last_dc_univ = assert (not (null dc_univs)) $+ last dc_univs - get_std_constrained_tys :: CtOrigin -> TypeOrKind -> Type- -> [(ThetaSpec, Maybe Subst)]- get_std_constrained_tys orig t_or_k ty+ get_std_constrained_tys ::+ [TyVar] -- The universally quantified type variables for the+ -- data constructor+ -> CtOrigin -> TypeOrKind -> Type+ -> [(ThetaSpec, Maybe Subst)]+ get_std_constrained_tys dc_univs orig t_or_k ty | is_functor_like = mk_functor_like_constraints orig t_or_k main_cls $- deepSubtypesContaining last_tv ty+ deepSubtypesContaining last_dc_univ ty | otherwise = [( [mk_cls_pred orig t_or_k main_cls ty] , Nothing )]+ where+ -- If 'is_functor_like' holds, then there should be at least one+ -- universal type variable, making this use of 'last' safe.+ last_dc_univ = assert (not (null dc_univs)) $+ last dc_univs mk_functor_like_constraints :: CtOrigin -> TypeOrKind -> Class -> [Type]@@ -277,9 +299,6 @@ , tcUnifyTy ki typeToTypeKind ) - rep_tc_tvs = tyConTyVars rep_tc- last_tv = last rep_tc_tvs- -- Extra Data constraints -- The Data class (only) requires that for -- instance (...) => Data (T t1 t2)@@ -318,7 +337,7 @@ -- Generic1 needs Functor -- See Note [Getting base classes] | is_generic1- -> assert (rep_tc_tvs `lengthExceeds` 0) $+ -> assert (tyConTyVars rep_tc `lengthExceeds` 0) $ -- Generic1 has a single kind variable assert (cls_tys `lengthIs` 1) $ do { functorClass <- lift $ tcLookupClass functorClassName@@ -685,7 +704,7 @@ else iterate_deriv (n+1) new_solns } - eqSolution a b = eqListBy (eqListBy eqType) (canSolution a) (canSolution b)+ eqSolution = (liftEq . liftEq) eqType `on` canSolution -- Canonicalise for comparison -- See Note [Deterministic simplifyInstanceContexts] canSolution = map (sortBy nonDetCmpType)
compiler/GHC/Tc/Errors.hs view
@@ -13,7 +13,6 @@ -- * GHC API helper functions solverReportMsg_ExpectedActuals,- solverReportInfo_ExpectedActuals ) where import GHC.Prelude@@ -79,13 +78,12 @@ import GHC.Data.Maybe import qualified GHC.Data.Strict as Strict -import Control.Monad ( unless, when, foldM, forM_ )-import Data.Foldable ( toList )-import Data.Function ( on )-import Data.List ( partition, sort, sortBy )-import Data.List.NonEmpty ( NonEmpty(..), (<|) )-import qualified Data.List.NonEmpty as NE ( map, reverse )-import Data.Ord ( comparing )+import Control.Monad ( unless, when, foldM, forM_ )+import Data.Foldable ( toList )+import Data.Function ( on )+import Data.List ( partition, sort, sortBy )+import Data.List.NonEmpty ( NonEmpty(..) )+import Data.Ord ( comparing ) import qualified Data.Semigroup as S {-@@ -263,13 +261,18 @@ -- | Make a report from a single 'TcSolverReportMsg'. important :: SolverReportErrCtxt -> TcSolverReportMsg -> SolverReport-important ctxt doc = mempty { sr_important_msgs = [SolverReportWithCtxt ctxt doc] }+important ctxt doc+ = SolverReport { sr_important_msg = SolverReportWithCtxt ctxt doc+ , sr_supplementary = []+ , sr_hints = [] } -mk_relevant_bindings :: RelevantBindings -> SolverReport-mk_relevant_bindings binds = mempty { sr_supplementary = [SupplementaryBindings binds] }+add_relevant_bindings :: RelevantBindings -> SolverReport -> SolverReport+add_relevant_bindings binds report@(SolverReport { sr_supplementary = supp })+ = report { sr_supplementary = SupplementaryBindings binds : supp } -mk_report_hints :: [GhcHint] -> SolverReport-mk_report_hints hints = mempty { sr_hints = hints }+add_report_hints :: [GhcHint] -> SolverReport -> SolverReport+add_report_hints hints report@(SolverReport { sr_hints = prev_hints })+ = report { sr_hints = prev_hints ++ hints } -- | Returns True <=> the SolverReportErrCtxt indicates that something is deferred deferringAnyBindings :: SolverReportErrCtxt -> Bool@@ -436,7 +439,7 @@ reportBadTelescope ctxt env (ForAllSkol telescope) skols = do { msg <- mkErrorReport env- (TcRnSolverReport [report] ErrorWithoutFlag noHints)+ (TcRnSolverReport report ErrorWithoutFlag noHints) (Just ctxt) [] ; reportDiagnostic msg }@@ -905,7 +908,7 @@ frr_origins = acc_errors errs diag = TcRnSolverReport- [SolverReportWithCtxt ctxt (FixedRuntimeRepError frr_origins)]+ (SolverReportWithCtxt ctxt (FixedRuntimeRepError frr_origins)) ErrorWithoutFlag noHints -- Accumulate the different kind of errors arising from syntactic equality.@@ -961,10 +964,10 @@ -- with one from the immediately-enclosing implication. -- See Note [Inaccessible code] - ; (eq_err_msgs, _hints) <- mkEqErr_help ctxt item' ty1 ty2+ ; (eq_err_msg, _hints) <- mkEqErr_help ctxt item' ty1 ty2 -- The hints wouldn't help in this situation, so we discard them. ; let supplementary = [ SupplementaryBindings relevant_binds ]- msg = TcRnInaccessibleCode implic (NE.reverse . NE.map (SolverReportWithCtxt ctxt) $ eq_err_msgs)+ msg = TcRnInaccessibleCode implic (SolverReportWithCtxt ctxt eq_err_msg) ; msg <- mkErrorReport (ctLocEnv loc') msg (Just ctxt) supplementary ; reportDiagnostic msg } where@@ -1061,7 +1064,7 @@ maybeReportError :: SolverReportErrCtxt -> [ErrorItem] -- items covered by the Report -> SolverReport -> TcM ()-maybeReportError ctxt items@(item1:_) (SolverReport { sr_important_msgs = important+maybeReportError ctxt items@(item1:_) (SolverReport { sr_important_msg = important , sr_supplementary = supp , sr_hints = hints }) = unless (cec_suppress ctxt -- Some worse error has occurred, so suppress this diagnostic@@ -1099,7 +1102,7 @@ mkErrorTerm :: SolverReportErrCtxt -> CtLoc -> Type -- of the error term -> SolverReport -> TcM EvTerm-mkErrorTerm ctxt ct_loc ty (SolverReport { sr_important_msgs = important, sr_supplementary = supp })+mkErrorTerm ctxt ct_loc ty (SolverReport { sr_important_msg = important, sr_supplementary = supp }) = do { msg <- mkErrorReport (ctLocEnv ct_loc) (TcRnSolverReport important ErrorWithoutFlag noHints) (Just ctxt) supp@@ -1278,10 +1281,10 @@ mkIrredErr :: SolverReportErrCtxt -> [ErrorItem] -> TcM SolverReport mkIrredErr ctxt items- = do { (ctxt, binds_msg, item1) <- relevantBindings True ctxt item1- ; let msg = important ctxt $+ = do { (ctxt, binds, item1) <- relevantBindings True ctxt item1+ ; let msg = important ctxt $ mkPlainMismatchMsg $ CouldNotDeduce (getUserGivens ctxt) (item1 :| others) Nothing- ; return $ msg `mappend` mk_relevant_bindings binds_msg }+ ; return $ add_relevant_bindings binds msg } where (item1:others) = final_items @@ -1342,11 +1345,11 @@ = unknownNameSuggestions WL_Anything dflags hpt curr_mod rdr_env (tcl_rdr lcl_env) imp_info (mkRdrUnqual occ)- errs = [SolverReportWithCtxt ctxt (ReportHoleError hole $ OutOfScopeHole imp_errs)]- report = SolverReport errs [] hints+ err = SolverReportWithCtxt ctxt (ReportHoleError hole $ OutOfScopeHole imp_errs)+ report = SolverReport err [] hints ; maybeAddDeferredBindings ctxt hole report- ; mkErrorReport lcl_env (TcRnSolverReport errs (cec_out_of_scope_holes ctxt) hints) Nothing []+ ; mkErrorReport lcl_env (TcRnSolverReport err (cec_out_of_scope_holes ctxt) hints) Nothing [] -- Pass the value 'Nothing' for the context, as it's generally not helpful -- to include the context here. }@@ -1360,7 +1363,7 @@ , hole_loc = ct_loc }) = do { rel_binds <- relevant_bindings False lcl_env lcl_name_cache (tyCoVarsOfType hole_ty)- -- The 'False' means "don't filter the bindings"; see Trac #8191+ -- The 'False' means "don't filter the bindings"; see #8191 ; show_hole_constraints <- goptM Opt_ShowHoleConstraints ; let relevant_cts@@ -1376,14 +1379,14 @@ ; (grouped_skvs, other_tvs) <- zonkAndGroupSkolTvs hole_ty ; let reason | ExprHole _ <- sort = cec_expr_holes ctxt | otherwise = cec_type_holes ctxt- errs = [SolverReportWithCtxt ctxt $ ReportHoleError hole $ HoleError sort other_tvs grouped_skvs]+ err = SolverReportWithCtxt ctxt $ ReportHoleError hole $ HoleError sort other_tvs grouped_skvs supp = [ SupplementaryBindings rel_binds , SupplementaryCts relevant_cts , SupplementaryHoleFits hole_fits ] - ; maybeAddDeferredBindings ctxt hole (SolverReport errs supp [])+ ; maybeAddDeferredBindings ctxt hole (SolverReport err supp []) - ; mkErrorReport lcl_env (TcRnSolverReport errs reason noHints) (Just ctxt) supp+ ; mkErrorReport lcl_env (TcRnSolverReport err reason noHints) (Just ctxt) supp } where@@ -1472,16 +1475,16 @@ -- Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint? Very unclear -- what's best. Let's not worry about this. mkIPErr ctxt items- = do { (ctxt, binds_msg, item1) <- relevantBindings True ctxt item1+ = do { (ctxt, binds, item1) <- relevantBindings True ctxt item1 ; let msg = important ctxt $ UnboundImplicitParams (item1 :| others)- ; return $ msg `mappend` mk_relevant_bindings binds_msg }+ ; return $ add_relevant_bindings binds msg } where item1:others = items ---------------- -- | Report a representation-polymorphism error to the user:--- a type is required to havehave a fixed runtime representation,+-- a type is required to have a fixed runtime representation, -- but doesn't. -- -- See Note [Reporting representation-polymorphism errors] in GHC.Tc.Types.Origin.@@ -1584,19 +1587,13 @@ mkEqErr1 :: SolverReportErrCtxt -> ErrorItem -> TcM SolverReport mkEqErr1 ctxt item -- Wanted only -- givens handled in mkGivenErrorReporter- = do { (ctxt, binds_msg, item) <- relevantBindings True ctxt item- ; rdr_env <- getGlobalRdrEnv- ; fam_envs <- tcGetFamInstEnvs- ; let mb_coercible_msg = case errorItemEqRel item of- NomEq -> Nothing- ReprEq -> ReportCoercibleMsg <$> mkCoercibleExplanation rdr_env fam_envs ty1 ty2+ = do { (ctxt, binds, item) <- relevantBindings True ctxt item ; traceTc "mkEqErr1" (ppr item $$ pprCtOrigin (errorItemOrigin item))- ; (last_msg :| prev_msgs, hints) <- mkEqErr_help ctxt item ty1 ty2+ ; (err_msg, hints) <- mkEqErr_help ctxt item ty1 ty2 ; let- report = foldMap (important ctxt) (reverse prev_msgs)- `mappend` (important ctxt $ mkTcReportWithInfo last_msg $ maybeToList mb_coercible_msg)- `mappend` (mk_relevant_bindings binds_msg)- `mappend` (mk_report_hints hints)+ report = add_relevant_bindings binds+ $ add_report_hints hints+ $ important ctxt err_msg ; return report } where (ty1, ty2) = getEqPredTys (errorItemPred item)@@ -1642,38 +1639,55 @@ | otherwise = False --- | Accumulated messages in reverse order.-type AccReportMsgs = NonEmpty TcSolverReportMsg- mkEqErr_help :: SolverReportErrCtxt -> ErrorItem- -> TcType -> TcType -> TcM (AccReportMsgs, [GhcHint])+ -> TcType -> TcType -> TcM (TcSolverReportMsg, [GhcHint]) mkEqErr_help ctxt item ty1 ty2 | Just casted_tv1 <- tcGetCastedTyVar_maybe ty1 = mkTyVarEqErr ctxt item casted_tv1 ty2 | Just casted_tv2 <- tcGetCastedTyVar_maybe ty2 = mkTyVarEqErr ctxt item casted_tv2 ty1 | otherwise- = return (reportEqErr ctxt item ty1 ty2 :| [], [])+ = do+ err <- reportEqErr ctxt item ty1 ty2+ return (err, noHints) reportEqErr :: SolverReportErrCtxt -> ErrorItem- -> TcType -> TcType -> TcSolverReportMsg+ -> TcType -> TcType+ -> TcM TcSolverReportMsg reportEqErr ctxt item ty1 ty2- = mkTcReportWithInfo mismatch eqInfos+ = do+ mb_coercible_info <-+ if errorItemEqRel item == ReprEq+ then coercible_msg ty1 ty2+ else return Nothing+ return $+ Mismatch+ { mismatchMsg = mismatch+ , mismatchTyVarInfo = Nothing+ , mismatchAmbiguityInfo = eqInfos+ , mismatchCoercibleInfo = mb_coercible_info } where mismatch = misMatchOrCND False ctxt item ty1 ty2 eqInfos = eqInfoMsgs ty1 ty2 +coercible_msg :: TcType -> TcType -> TcM (Maybe CoercibleMsg)+coercible_msg ty1 ty2+ = do+ rdr_env <- getGlobalRdrEnv+ fam_envs <- tcGetFamInstEnvs+ return $ mkCoercibleExplanation rdr_env fam_envs ty1 ty2+ mkTyVarEqErr :: SolverReportErrCtxt -> ErrorItem- -> (TcTyVar, TcCoercionN) -> TcType -> TcM (AccReportMsgs, [GhcHint])+ -> (TcTyVar, TcCoercionN) -> TcType -> TcM (TcSolverReportMsg, [GhcHint]) -- tv1 and ty2 are already tidied mkTyVarEqErr ctxt item casted_tv1 ty2 = do { traceTc "mkTyVarEqErr" (ppr item $$ ppr casted_tv1 $$ ppr ty2) ; mkTyVarEqErr' ctxt item casted_tv1 ty2 } mkTyVarEqErr' :: SolverReportErrCtxt -> ErrorItem- -> (TcTyVar, TcCoercionN) -> TcType -> TcM (AccReportMsgs, [GhcHint])+ -> (TcTyVar, TcCoercionN) -> TcType -> TcM (TcSolverReportMsg, [GhcHint]) mkTyVarEqErr' ctxt item (tv1, co1) ty2 -- Is this a representation-polymorphism error, e.g.@@ -1681,24 +1695,28 @@ | Just frr_info <- mb_concrete_reason = do (_, infos) <- zonkTidyFRRInfos (cec_tidy ctxt) [frr_info]- return (FixedRuntimeRepError infos :| [], [])+ return (FixedRuntimeRepError infos, []) -- Impredicativity is a simple error to understand; try it before -- anything more complicated. | check_eq_result `cterHasProblem` cteImpredicative = do- tyvar_eq_info <- extraTyVarEqInfo tv1 ty2+ tyvar_eq_info <- extraTyVarEqInfo (tv1, Nothing) ty2 let- poly_msg = CannotUnifyWithPolytype item tv1 ty2- poly_msg_with_info+ poly_msg = CannotUnifyWithPolytype item tv1 ty2 mb_tv_info+ mb_tv_info | isSkolemTyVar tv1- = mkTcReportWithInfo poly_msg tyvar_eq_info+ = Just tyvar_eq_info | otherwise- = poly_msg+ = Nothing+ main_msg =+ CannotUnifyVariable+ { mismatchMsg = headline_msg+ , cannotUnifyReason = poly_msg } -- Unlike the other reports, this discards the old 'report_important' -- instead of augmenting it. This is because the details are not likely -- to be helpful since this is just an unimplemented feature.- return (poly_msg_with_info <| headline_msg :| [], [])+ return (main_msg, []) | isSkolemTyVar tv1 -- ty2 won't be a meta-tyvar; we would have -- swapped in Solver.Canonical.canEqTyVarHomo@@ -1706,30 +1724,43 @@ || errorItemEqRel item == ReprEq -- The cases below don't really apply to ReprEq (except occurs check) = do- tv_extra <- extraTyVarEqInfo tv1 ty2- return (mkTcReportWithInfo headline_msg tv_extra :| [], add_sig)+ tv_extra <- extraTyVarEqInfo (tv1, Nothing) ty2+ reason <-+ if errorItemEqRel item == ReprEq+ then RepresentationalEq tv_extra <$> coercible_msg ty1 ty2+ else return $ DifferentTyVars tv_extra+ let main_msg =+ CannotUnifyVariable+ { mismatchMsg = headline_msg+ , cannotUnifyReason = reason }+ return (main_msg, add_sig) | cterHasOccursCheck check_eq_result -- We report an "occurs check" even for a ~ F t a, where F is a type -- function; it's not insoluble (because in principle F could reduce) -- but we have certainly been unable to solve it- = let extras2 = eqInfoMsgs ty1 ty2+ = let ambiguity_infos = eqInfoMsgs ty1 ty2 interesting_tyvars = filter (not . noFreeVarsOfType . tyVarKind) $ filter isTyVar $ fvVarList $ tyCoFVsOfType ty1 `unionFV` tyCoFVsOfType ty2 - extras3 = case interesting_tyvars of- [] -> []- (tv : tvs) -> [OccursCheckInterestingTyVars (tv :| tvs)]+ occurs_err =+ OccursCheck+ { occursCheckInterestingTyVars = interesting_tyvars+ , occursCheckAmbiguityInfos = ambiguity_infos }+ main_msg =+ CannotUnifyVariable+ { mismatchMsg = headline_msg+ , cannotUnifyReason = occurs_err } - in return (mkTcReportWithInfo headline_msg (extras2 ++ extras3) :| [], [])+ in return (main_msg, []) -- This is wrinkle (4) in Note [Equalities with incompatible kinds] in -- GHC.Tc.Solver.Canonical | hasCoercionHoleCo co1 || hasCoercionHoleTy ty2- = return (mkBlockedEqErr item :| [], [])+ = return (mkBlockedEqErr item, []) -- If the immediately-enclosing implication has 'tv' a skolem, and -- we know by now its an InferSkol kind of skolem, then presumably@@ -1739,16 +1770,26 @@ , Implic { ic_skols = skols } <- implic , tv1 `elem` skols = do- tv_extra <- extraTyVarEqInfo tv1 ty2- return (mkTcReportWithInfo mismatch_msg tv_extra :| [], [])+ tv_extra <- extraTyVarEqInfo (tv1, Nothing) ty2+ let msg = Mismatch+ { mismatchMsg = mismatch_msg+ , mismatchTyVarInfo = Just tv_extra+ , mismatchAmbiguityInfo = []+ , mismatchCoercibleInfo = Nothing }+ return (msg, []) -- Check for skolem escape | (implic:_) <- cec_encl ctxt -- Get the innermost context , Implic { ic_skols = skols } <- implic , let esc_skols = filter (`elemVarSet` (tyCoVarsOfType ty2)) skols , not (null esc_skols)- = return (SkolemEscape item implic esc_skols :| [mismatch_msg], [])+ = let main_msg =+ CannotUnifyVariable+ { mismatchMsg = mismatch_msg+ , cannotUnifyReason = SkolemEscape item implic esc_skols } + in return (main_msg, [])+ -- Nastiest case: attempt to unify an untouchable variable -- So tv is a meta tyvar (or started that way before we -- generalised it). So presumably it is an *untouchable*@@ -1758,12 +1799,19 @@ , Implic { ic_tclvl = lvl } <- implic = assertPpr (not (isTouchableMetaTyVar lvl tv1)) (ppr tv1 $$ ppr lvl) $ do -- See Note [Error messages for untouchables]- let tclvl_extra = UntouchableVariable tv1 implic- tv_extra <- extraTyVarEqInfo tv1 ty2- return (mkTcReportWithInfo tclvl_extra tv_extra :| [mismatch_msg], add_sig)+ tv_extra <- extraTyVarEqInfo (tv1, Just implic) ty2+ let tv_extra' = tv_extra { thisTyVarIsUntouchable = Just implic }+ msg = Mismatch+ { mismatchMsg = mismatch_msg+ , mismatchTyVarInfo = Just tv_extra'+ , mismatchAmbiguityInfo = []+ , mismatchCoercibleInfo = Nothing }+ return (msg, add_sig) | otherwise- = return (reportEqErr ctxt item (mkTyVarTy tv1) ty2 :| [], [])+ = do+ err <- reportEqErr ctxt item (mkTyVarTy tv1) ty2+ return (err, []) -- This *can* happen (#6123) -- Consider an ambiguous top-level constraint (a ~ F a) -- Not an occurs check, because F is a type function.@@ -1802,7 +1850,7 @@ insoluble_occurs_check = check_eq_result `cterHasProblem` cteInsolubleOccurs -eqInfoMsgs :: TcType -> TcType -> [TcSolverReportInfo]+eqInfoMsgs :: TcType -> TcType -> [AmbiguityInfo] -- Report (a) ambiguity if either side is a type function application -- e.g. F a0 ~ Int -- (b) warning about injectivity if both sides are the same@@ -1836,7 +1884,7 @@ = Nothing misMatchOrCND :: Bool -> SolverReportErrCtxt -> ErrorItem- -> TcType -> TcType -> TcSolverReportMsg+ -> TcType -> TcType -> MismatchMsg -- If oriented then ty1 is actual, ty2 is expected misMatchOrCND insoluble_occurs_check ctxt item ty1 ty2 | insoluble_occurs_check -- See Note [Insoluble occurs check]@@ -1904,23 +1952,30 @@ in GHC.Tc.TyCl.PatSyn). -} -extraTyVarEqInfo :: TcTyVar -> TcType -> TcM [TcSolverReportInfo]+extraTyVarEqInfo :: (TcTyVar, Maybe Implication) -> TcType -> TcM TyVarInfo -- Add on extra info about skolem constants -- NB: The types themselves are already tidied-extraTyVarEqInfo tv1 ty2- = (:) <$> extraTyVarInfo tv1 <*> ty_extra ty2+extraTyVarEqInfo (tv1, mb_implic) ty2+ = do+ tv1_info <- extraTyVarInfo tv1+ ty2_info <- ty_extra ty2+ return $+ TyVarInfo+ { thisTyVar = tv1_info+ , thisTyVarIsUntouchable = mb_implic+ , otherTy = ty2_info } where ty_extra ty = case tcGetCastedTyVar_maybe ty of- Just (tv, _) -> (:[]) <$> extraTyVarInfo tv- Nothing -> return []+ Just (tv, _) -> Just <$> extraTyVarInfo tv+ Nothing -> return Nothing -extraTyVarInfo :: TcTyVar -> TcM TcSolverReportInfo+extraTyVarInfo :: TcTyVar -> TcM TyVar extraTyVarInfo tv = assertPpr (isTyVar tv) (ppr tv) $ case tcTyVarDetails tv of SkolemTv skol_info lvl overlaps -> do new_skol_info <- zonkSkolemInfo skol_info- return $ TyVarInfo (mkTcTyVar (tyVarName tv) (tyVarKind tv) (SkolemTv new_skol_info lvl overlaps))- _ -> return $ TyVarInfo tv+ return $ mkTcTyVar (tyVarName tv) (tyVarKind tv) (SkolemTv new_skol_info lvl overlaps)+ _ -> return tv suggestAddSig :: SolverReportErrCtxt -> TcType -> TcType -> Maybe GhcHint@@ -1949,30 +2004,30 @@ = find implics (seen_eqs || ic_given_eqs implic /= NoGivenEqs) tv ---------------------mkMismatchMsg :: ErrorItem -> Type -> Type -> TcSolverReportMsg+mkMismatchMsg :: ErrorItem -> Type -> Type -> MismatchMsg mkMismatchMsg item ty1 ty2 = case orig of TypeEqOrigin { uo_actual, uo_expected, uo_thing = mb_thing } ->- mkTcReportWithInfo- (TypeEqMismatch- { teq_mismatch_ppr_explicit_kinds = ppr_explicit_kinds- , teq_mismatch_item = item- , teq_mismatch_ty1 = ty1- , teq_mismatch_ty2 = ty2- , teq_mismatch_actual = uo_actual- , teq_mismatch_expected = uo_expected- , teq_mismatch_what = mb_thing})- extras+ (TypeEqMismatch+ { teq_mismatch_ppr_explicit_kinds = ppr_explicit_kinds+ , teq_mismatch_item = item+ , teq_mismatch_ty1 = ty1+ , teq_mismatch_ty2 = ty2+ , teq_mismatch_actual = uo_actual+ , teq_mismatch_expected = uo_expected+ , teq_mismatch_what = mb_thing+ , teq_mb_same_occ = sameOccExtras ty2 ty1 }) KindEqOrigin cty1 cty2 sub_o mb_sub_t_or_k ->- mkTcReportWithInfo (Mismatch False item ty1 ty2)- (WhenMatching cty1 cty2 sub_o mb_sub_t_or_k : extras)+ (mkBasicMismatchMsg NoEA item ty1 ty2)+ { mismatch_whenMatching = Just $ WhenMatching cty1 cty2 sub_o mb_sub_t_or_k+ , mismatch_mb_same_occ = mb_same_occ+ } _ ->- mkTcReportWithInfo- (Mismatch False item ty1 ty2)- extras+ (mkBasicMismatchMsg NoEA item ty1 ty2)+ { mismatch_mb_same_occ = mb_same_occ } where orig = errorItemOrigin item- extras = sameOccExtras ty2 ty1+ mb_same_occ = sameOccExtras ty2 ty1 ppr_explicit_kinds = shouldPprWithExplicitKinds ty1 ty2 orig -- | Whether to print explicit kinds (with @-fprint-explicit-kinds@)@@ -2011,7 +2066,7 @@ want to be as draconian with them.) -} -sameOccExtras :: TcType -> TcType -> [TcSolverReportInfo]+sameOccExtras :: TcType -> TcType -> Maybe SameOccInfo -- See Note [Disambiguating (X ~ X) errors] sameOccExtras ty1 ty2 | Just (tc1, _) <- tcSplitTyConApp_maybe ty1@@ -2022,9 +2077,9 @@ same_pkg = moduleUnit (nameModule n1) == moduleUnit (nameModule n2) , n1 /= n2 -- Different Names , same_occ -- but same OccName- = [SameOcc same_pkg n1 n2]+ = Just $ SameOcc same_pkg n1 n2 | otherwise- = []+ = Nothing {- Note [Suggest adding a type signature] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~@@ -2468,28 +2523,14 @@ solverReportMsg_ExpectedActuals :: TcSolverReportMsg -> [(Type, Type)] solverReportMsg_ExpectedActuals = \case- TcReportWithInfo msg infos ->- solverReportMsg_ExpectedActuals msg- ++ (solverReportInfo_ExpectedActuals =<< toList infos)- Mismatch { mismatch_ty1 = exp, mismatch_ty2 = act } ->- [(exp, act)]- KindMismatch { kmismatch_expected = exp, kmismatch_actual = act } ->- [(exp, act)]- TypeEqMismatch { teq_mismatch_expected = exp, teq_mismatch_actual = act } ->- [(exp,act)]- _ -> []---- | Retrieves all @"expected"/"actual"@ messages from a 'TcSolverReportInfo'.------ Prefer using this over inspecting the 'TcSolverReportInfo' datatype if--- you just need this information, as the datatype itself is subject to change--- across GHC versions.-solverReportInfo_ExpectedActuals :: TcSolverReportInfo -> [(Type, Type)]-solverReportInfo_ExpectedActuals- = \case- ExpectedActual { ea_expected = exp, ea_actual = act } ->- [(exp, act)]- ExpectedActualAfterTySynExpansion- { ea_expanded_expected = exp, ea_expanded_actual = act } ->- [(exp, act)]+ Mismatch { mismatchMsg = mismatch_msg } ->+ case mismatch_msg of+ BasicMismatch { mismatch_ty1 = exp, mismatch_ty2 = act } ->+ [(exp, act)]+ KindMismatch { kmismatch_expected = exp, kmismatch_actual = act } ->+ [(exp, act)]+ TypeEqMismatch { teq_mismatch_expected = exp, teq_mismatch_actual = act } ->+ [(exp,act)]+ CouldNotDeduce {} ->+ [] _ -> []
compiler/GHC/Tc/Errors/Hole.hs view
@@ -400,7 +400,7 @@ Note [Speeding up valid hole-fits] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-To fix #16875 we noted that a lot of time was being spent on uneccessary work.+To fix #16875 we noted that a lot of time was being spent on unecessary work. When we'd call `tcCheckHoleFit hole hole_ty ty`, we would end up by generating a constraint to show that `hole_ty ~ ty`, including any constraints in `ty`. For@@ -462,7 +462,7 @@ ; if showDocs then do { dflags <- getDynFlags ; mb_local_docs <- extractDocs dflags =<< getGblEnv- ; (mods_without_docs, fits') <- mapAccumM (upd mb_local_docs) Set.empty fits+ ; (mods_without_docs, fits') <- mapAccumLM (upd mb_local_docs) Set.empty fits ; report mods_without_docs ; return fits' } else return fits }@@ -489,8 +489,7 @@ { let warning = text "WARNING: Couldn't find any documentation for the following modules:" $+$ nest 2- (fsep (punctuate comma- (either text ppr <$> Set.toList mods)) $+$+ (pprWithCommas (either text ppr) (Set.toList mods) $+$ text "Make sure the modules are compiled with '-haddock'.") ; warnPprTrace (not $ Set.null mods)"addHoleFitDocs" warning (pure ()) }
compiler/GHC/Tc/Gen/App.hs view
@@ -86,7 +86,7 @@ * When QL is done, we don't need to turn the un-filled-in instantiation variables into unification variables -- they- already /are/ unification varibles! See also+ already /are/ unification variables! See also Note [Instantiation variables are short lived]. * We cleverly avoid the quadratic cost of QL, alluded to in the paper.@@ -216,7 +216,7 @@ It treats application chains (f e1 @ty e2) specially: -* So we can report errors like "in the third arument of a call of f"+* So we can report errors like "in the third argument of a call of f" * So we can do Visible Type Application (VTA), for which we must not eagerly instantiate the function part of the application.@@ -230,7 +230,7 @@ returning the function in the corner and the arguments splitHsApps can deal with infix as well as prefix application,- and returns a Rebuilder to re-assemble the the application after+ and returns a Rebuilder to re-assemble the application after typechecking. The "list of arguments" is [HsExprArg], described in Note [HsExprArg].@@ -369,7 +369,7 @@ -- Even though both app_res_rho and exp_res_ty are rho-types, -- they may have nested polymorphism, so if deep subsumption -- is on we must call tcSubType.- -- Zonk app_res_rho first, becuase QL may have instantiated some+ -- Zonk app_res_rho first, because QL may have instantiated some -- delta variables to polytypes, and tcSubType doesn't expect that do { app_res_rho <- zonkQuickLook do_ql app_res_rho ; tcSubTypeDS rn_expr app_res_rho exp_res_ty }@@ -509,7 +509,7 @@ tcInstFun :: Bool -- True <=> Do quick-look -> Bool -- False <=> Instantiate only /inferred/ variables at the end- -- so may return a sigma-typex+ -- so may return a sigma-type -- True <=> Instantiate all type variables at the end: -- return a rho-type -- The /only/ call site that passes in False is the one@@ -1060,7 +1060,7 @@ ; writeMetaTyVar kappa (mkCastTy ty2 co) } | otherwise- = return () -- Occurs-check or forall-bound varialbe+ = return () -- Occurs-check or forall-bound variable {- Note [Actual unification in qlUnify]@@ -1085,7 +1085,7 @@ * What if kappa and ty have different kinds? We solve that problem by calling unifyKind, producing a coercion perhaps emitting some deferred equality constraints. That is /different/ from the approach we use in- the main constraint solver for herterogeneous equalities; see Note+ the main constraint solver for heterogeneous equalities; see Note [Equalities with incompatible kinds] in Solver.Canonical Why different? Because:
compiler/GHC/Tc/Gen/Bind.hs view
@@ -271,7 +271,7 @@ ; let p = mkStrLitTy $ hsIPNameFS ip ; ip_id <- newDict ipClass [ p, ty ] ; expr' <- tcCheckMonoExpr expr ty- ; let d = mapLoc (toDict ipClass p ty) expr'+ ; let d = fmap (toDict ipClass p ty) expr' ; return (ip_id, (IPBind ip_id l_name d)) } -- Coerces a `t` into a dictionary for `IP "x" t`.@@ -1153,7 +1153,7 @@ We get [W] Foo (), [W] Applicative f. When we do pickCapturedPreds in choose_psig_context, we'll discard Foo ()! Usually would not quantify over such (closed) predicates. So my_theta will be (Applicative f). But we really-do want to quantify over (Foo ()) -- it was speicfied by the programmer.+do want to quantify over (Foo ()) -- it was specified by the programmer. Solution: always return annotated_theta (user-specified) plus the extra piece diff_theta. @@ -1354,7 +1354,7 @@ (combine head ids), and use that to tell us the polymorphic types of x and y. -We don't need to check -XImpredicativeTypes beucase without it+We don't need to check -XImpredicativeTypes because without it these types like [forall a. a->a] are illegal anyway, so this special case code only really has an effect if -XImpredicativeTypes is on. Small exception:
compiler/GHC/Tc/Gen/Export.hs view
@@ -125,7 +125,7 @@ , T defined at A.hs:4:23 ] Then, we get @[C{C;}, C{T;}, T{T;}, T{D;}]@, which eventually gets merged-into @[C{C, T;}, T{T, D;}]@ (which satsifies the AvailTC invariant).+into @[C{C, T;}, T{T, D;}]@ (which satisfies the AvailTC invariant). -} data ExportAccum -- The type of the accumulating parameter of@@ -758,4 +758,4 @@ case SrcLoc.leftmost_smallest (greSrcSpan gre1) (greSrcSpan gre2) of LT -> (child1, gre1, ie1, child2, gre2, ie2) GT -> (child2, gre2, ie2, child1, gre1, ie1)- EQ -> panic "exportClashErr: clashing exports have idential location"+ EQ -> panic "exportClashErr: clashing exports have identical location"
compiler/GHC/Tc/Gen/Expr.hs view
@@ -88,7 +88,8 @@ import Language.Haskell.Syntax.Basic (FieldLabelString(..)) import Data.Function-import Data.List (partition, sortBy, groupBy, intersect)+import Data.List (partition, sortBy, intersect)+import qualified Data.List.NonEmpty as NE import GHC.Data.Bag ( unitBag ) @@ -185,7 +186,7 @@ tcExpr :: HsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc) --- Use tcApp to typecheck appplications, which are treated specially+-- Use tcApp to typecheck applications, which are treated specially -- by Quick Look. Specifically: -- - HsVar lone variables, to ensure that they can get an -- impredicative instantiation (via Quick Look@@ -287,7 +288,7 @@ ************************************************************************ -} --- Explict lists [e1,e2,e3] have been expanded already in the renamer+-- Explicit lists [e1,e2,e3] have been expanded already in the renamer -- The expansion includes an ExplicitList, but it is always the built-in -- list type, so that's all we need concern ourselves with here. See -- GHC.Rename.Expr. Note [Handling overloaded and rebindable constructs]@@ -1306,7 +1307,7 @@ ; nm <- newNameAt nm_occ generatedSrcSpan ; let id = mkLocalId nm m actual_arg_ty -- NB: create fresh names to avoid any accidental shadowing- -- occuring in the RHS expressions when creating the let bindings:+ -- occurring in the RHS expressions when creating the let bindings: -- -- let x1 = e1; x2 = e2; ... ; return (fld_nm, (id, rhs))@@ -1699,7 +1700,7 @@ in -- Fields that don't change the membership status of the set -- are redundant and can be dropped.- map (fst . head) $ groupBy ((==) `on` snd) growingSets+ map (fst . NE.head) $ NE.groupWith snd growingSets aMember = assert (not (null members) ) fst (head members) (members, nonMembers) = partition (or . snd) membership
compiler/GHC/Tc/Gen/Foreign.hs view
@@ -96,7 +96,7 @@ newtype Age = MkAge Int we want to see that Age -> IO () is the same as Int -> IO (). But, we don't-need to recur on any type parameters, because no paramaterized types (with+need to recur on any type parameters, because no parameterized types (with interesting parameters) are marshalable! The full list of marshalable types is in the body of boxedMarshalableTyCon in GHC.Tc.Utils.TcType. The only members of that list not at kind * are Ptr, FunPtr, and StablePtr, all of which get marshaled@@ -198,7 +198,7 @@ want to report it as "defined but not used" or "imported but not used". eg newtype D = MkD Int foreign import foo :: D -> IO ()-Here 'MkD' us used. See #7408.+Here 'MkD' is used. See #7408. GHC also expands type functions during this process, so it's not enough just to look at the free variables of the declaration.@@ -340,14 +340,14 @@ -- This makes a convenient place to check -- that the C identifier is valid for C-checkCTarget :: ForeignImport p -> CCallTarget -> TcM ()+checkCTarget :: ForeignImport GhcRn -> CCallTarget -> TcM () checkCTarget idecl (StaticTarget _ str _ _) = do checkCg (Right idecl) backendValidityOfCImport checkTc (isCLabelString str) (TcRnInvalidCIdentifier str) checkCTarget _ DynamicTarget = panic "checkCTarget DynamicTarget" -checkMissingAmpersand :: ForeignImport p -> [Type] -> Type -> TcM ()+checkMissingAmpersand :: ForeignImport GhcRn -> [Type] -> Type -> TcM () checkMissingAmpersand idecl arg_tys res_ty | null arg_tys && isFunPtrTy res_ty = addDiagnosticTc $ TcRnFunPtrImportWithoutAmpersand idecl@@ -497,7 +497,8 @@ checkSafe = True noCheckSafe = False -checkCg :: Either (ForeignExport p) (ForeignImport p) -> (Backend -> Validity' ExpectedBackends) -> TcM ()+checkCg :: Either (ForeignExport GhcRn) (ForeignImport GhcRn)+ -> (Backend -> Validity' ExpectedBackends) -> TcM () checkCg decl check = do dflags <- getDynFlags let bcknd = backend dflags@@ -508,7 +509,8 @@ -- Calling conventions -checkCConv :: Either (ForeignExport p) (ForeignImport p) -> CCallConv -> TcM CCallConv+checkCConv :: Either (ForeignExport GhcRn) (ForeignImport GhcRn)+ -> CCallConv -> TcM CCallConv checkCConv _ CCallConv = return CCallConv checkCConv _ CApiConv = return CApiConv checkCConv decl StdCallConv = do
compiler/GHC/Tc/Gen/Head.hs view
@@ -956,7 +956,7 @@ {- Note [Partial expression signatures] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Partial type signatures on expressions are easy to get wrong. But-here is a guiding principile+here is a guiding principle e :: ty should behave like let x :: ty@@ -1334,7 +1334,7 @@ [getRuntimeRep id_ty, id_ty] -- Warning for implicit lift (#17804)- ; addDetailedDiagnostic (TcRnImplicitLift id)+ ; addDetailedDiagnostic (TcRnImplicitLift $ idName id) -- Update the pending splices ; ps <- readMutVar ps_var
compiler/GHC/Tc/Gen/HsType.hs view
@@ -336,7 +336,7 @@ the pattern signature (which is not kind-generalized). When we are checking the *body* of foo, though, we need to unify the type of x with the argument type of bar. At this point, the ambient TcLevel is 1, and spotting a-matavariable with level 2 would violate the (WantedInv) invariant of+metavariable with level 2 would violate the (WantedInv) invariant of Note [TcLevel invariants]. So, instead of kind-generalizing, we promote the metavariable to level 1. This is all done in kindGeneralizeNone. @@ -1058,7 +1058,7 @@ | ATyVar nm tv <- nonDetNameEnvElts (tcl_env env) ] subst = mkTvSubst (mkInScopeSetList $ map snd subst_prs)- (listToUFM_Directly $ map (liftSnd mkTyVarTy) subst_prs)+ (listToUFM_Directly $ map (fmap mkTyVarTy) subst_prs) ty' = substTy subst ty return (ty', tcTypeKind ty') @@ -1320,7 +1320,7 @@ | f :: forall {a}. type HsForAllInvis InferredSpec Inferred | f :: forall a -> type HsForAllVis SpecifiedSpec Required | f :: forall {a} -> type HsForAllVis InferredSpec /-| This last form is non-sensical and is thus rejected.+| This last form is nonsensical and is thus rejected. ---------------------------------------------------------------------------- For more information regarding the interpretation of the resulting ArgFlag, see@@ -2447,7 +2447,7 @@ kcInferDeclHeader name flav (HsQTvs { hsq_ext = kv_ns , hsq_explicit = hs_tvs }) kc_res_ki- -- No standalane kind signature and no CUSK.+ -- No standalone kind signature and no CUSK. -- See Note [Required, Specified, and Inferred for types] in GHC.Tc.TyCl = addTyConFlavCtxt name flav $ do { (scoped_kvs, (tc_tvs, res_kind))@@ -2616,7 +2616,7 @@ -- Argument is excess TyConBinders and tail kind -> TcM ( [TcTyConBinder] -- Skolemised binders, with TcTyVars , a )--- See Note [Matching a kind sigature with a declaration]+-- See Note [Matching a kind signature with a declaration] -- Invariant: Length of returned TyConBinders + length of excess TyConBinders -- = length of incoming TyConBinders matchUpSigWithDecl sig_tcbs sig_res_kind hs_bndrs thing_inside@@ -3226,14 +3226,14 @@ -> TcM ([TcTyVar], a) -- These do not clone: see Note [Cloning for type variable binders] bindExplicitTKBndrs_Q_Skol skol_info ctxt_kind hs_bndrs thing_inside- = liftFstM binderVars $+ = mapFst binderVars $ bindExplicitTKBndrsX (smVanilla { sm_clone = False, sm_parent = True , sm_kind = ctxt_kind, sm_tvtv = SMDSkolemTv skol_info }) hs_bndrs thing_inside -- sm_clone=False: see Note [Cloning for type variable binders] bindExplicitTKBndrs_Q_Tv ctxt_kind hs_bndrs thing_inside- = liftFstM binderVars $+ = mapFst binderVars $ bindExplicitTKBndrsX (smVanilla { sm_clone = False, sm_parent = True , sm_tvtv = SMDTyVarTv, sm_kind = ctxt_kind }) hs_bndrs thing_inside@@ -3505,7 +3505,7 @@ zonkAndScopedSort :: [TcTyVar] -> TcM [TcTyVar] zonkAndScopedSort spec_tkvs = do { spec_tkvs <- zonkTcTyVarsToTcTyVars spec_tkvs- -- Zonk the kinds, to we can do the dependency analayis+ -- Zonk the kinds, to we can do the dependency analysis -- Do a stable topological sort, following -- Note [Ordering of implicit variables] in GHC.Rename.HsType@@ -3603,7 +3603,7 @@ * Find the free variables with level > i, in this case gamma[i] * Skolemise those free variables and quantify over them, giving f :: forall g. beta[i-1] -> g- * Emit the residiual constraint wrapped in an implication for g,+ * Emit the residual constraint wrapped in an implication for g, thus forall g. WC All of this happens for types too. Consider@@ -4063,7 +4063,7 @@ * Just as for ordinary signatures, we must solve local equalities and zonk the type after kind-checking it, to ensure that all the nested- forall binders can "see" their occurrenceds+ forall binders can "see" their occurrences Just as for ordinary signatures, this zonk also gets any Refl casts out of the way of instantiation. Example: #18008 had
compiler/GHC/Tc/Gen/Match.hs view
@@ -1159,7 +1159,8 @@ = return () check_match_pats matchContext (MG { mg_alts = L _ (match1:matches) }) | Just bad_matches <- mb_bad_matches- = failWithTc $ TcRnMatchesHaveDiffNumArgs matchContext match1 bad_matches+ = failWithTc $ TcRnMatchesHaveDiffNumArgs matchContext+ $ MatchArgMatches match1 bad_matches | otherwise = return () where
compiler/GHC/Tc/Gen/Pat.hs view
@@ -20,7 +20,6 @@ , tcCheckPat, tcCheckPat_O, tcInferPat , tcPats , addDataConStupidTheta- , polyPatSig ) where @@ -36,7 +35,6 @@ import GHC.Tc.Gen.Sig( TcPragEnv, lookupPragEnv, addInlinePrags ) import GHC.Tc.Utils.Monad import GHC.Tc.Utils.Instantiate-import GHC.Types.Error import GHC.Types.FieldLabel import GHC.Types.Id import GHC.Types.Var@@ -1503,8 +1501,3 @@ where has_existentials :: Bool has_existentials = any (`elemVarSet` tyCoVarsOfTypes arg_tys) ex_tvs--polyPatSig :: TcType -> SDoc-polyPatSig sig_ty- = hang (text "Illegal polymorphic type signature in pattern:")- 2 (ppr sig_ty)
compiler/GHC/Tc/Gen/Sig.hs view
@@ -112,7 +112,7 @@ but for /partial/ signatures it starts from the HsSyn, so it has to kind-check it etc: tcHsPartialSigType. It's convenient to do this at the same time as instantiation, because we can- make the wildcards into unification variables right away, raather+ make the wildcards into unification variables right away, rather than somehow quantifying over them. And the "TcLevel" of those unification variables is correct because we are in tcMonoBinds. @@ -455,7 +455,7 @@ -- Neither argument types nor the return type may be representation polymorphic. -- This is because, when creating a matcher:- -- - the argument types become the the binder types (see test RepPolyPatySynArg),+ -- - the argument types become the binder types (see test RepPolyPatySynArg), -- - the return type becomes the scrutinee type (see test RepPolyPatSynRes). ; let (arg_tys, res_ty) = tcSplitFunTys body_ty ; mapM_
compiler/GHC/Tc/Gen/Splice.hs view
@@ -449,7 +449,7 @@ SplicePointName, 'spn' * The SplicePointName connects the `PendingRnSplice` with the particular point- in the syntax tree where that expresion should be spliced in. That point+ in the syntax tree where that expression should be spliced in. That point in the tree is identified by `(HsUntypedSpliceNested spn)`. It is used by the desugarer, so that we ultimately generate something like let spn = g x@@ -800,7 +800,7 @@ ; return (mkTyConApp codeCon [rep, m_ty, exp_ty]) } where err_msg ty- = TcRnUnknownMessage $ mkPlainError noHints $+ = mkTcRnUnknownMessage $ mkPlainError noHints $ vcat [ text "Illegal polytype:" <+> ppr ty , text "The type of a Typed Template Haskell expression must" <+> text "not have any quantification." ]@@ -1256,7 +1256,7 @@ -- see where this splice is do { mb_result <- run_and_convert expr_span hval ; case mb_result of- Left err -> failWithTc (TcRnUnknownMessage $ mkPlainError noHints err)+ Left err -> failWithTc (mkTcRnUnknownMessage $ mkPlainError noHints err) Right result -> do { traceTc "Got HsSyn result:" (ppr_hs result) ; return $! result } } @@ -1274,7 +1274,7 @@ let msg = vcat [text "Exception when trying to" <+> text phase <+> text "compile-time code:", nest 2 (text exn_msg), if show_code then text "Code:" <+> ppr expr else empty]- failWithTc (TcRnUnknownMessage $ mkPlainError noHints msg)+ failWithTc (mkTcRnUnknownMessage $ mkPlainError noHints msg) {- Note [Running typed splices in the zonker]@@ -1390,10 +1390,11 @@ -- 'msg' is forced to ensure exceptions don't escape, -- see Note [Exceptions in TH]- qReport True msg = seqList msg $ addErr $ TcRnUnknownMessage $ mkPlainError noHints (text msg)- qReport False msg = seqList msg $ addDiagnostic $ TcRnUnknownMessage $+ qReport True msg = seqList msg $ addErr $ mkTcRnUnknownMessage $ mkPlainError noHints (text msg)+ qReport False msg = seqList msg $ addDiagnostic $ mkTcRnUnknownMessage $ mkPlainDiagnostic WarningWithoutFlag noHints (text msg) + qLocation :: TcM TH.Loc qLocation = do { m <- getModule ; l <- getSrcSpanM ; r <- case l of@@ -1444,7 +1445,7 @@ th_origin <- getThSpliceOrigin let either_hval = convertToHsDecls th_origin l thds ds <- case either_hval of- Left exn -> failWithTc $ TcRnUnknownMessage $ mkPlainError noHints $+ Left exn -> failWithTc $ mkTcRnUnknownMessage $ mkPlainError noHints $ hang (text "Error in a declaration passed to addTopDecls:") 2 exn Right ds -> return ds@@ -1462,7 +1463,7 @@ checkTopDecl (ForD _ (ForeignImport { fd_name = L _ name })) = bindName name checkTopDecl _- = addErr $ TcRnUnknownMessage $ mkPlainError noHints $+ = addErr $ mkTcRnUnknownMessage $ mkPlainError noHints $ text "Only function, value, annotation, and foreign import declarations may be added with addTopDecl" bindName :: RdrName -> TcM ()@@ -1472,7 +1473,7 @@ } bindName name =- addErr $ TcRnUnknownMessage $ mkPlainError noHints $+ addErr $ mkTcRnUnknownMessage $ mkPlainError noHints $ hang (text "The binder" <+> quotes (ppr name) <+> text "is not a NameU.") 2 (text "Probable cause: you used mkName instead of newName to generate a binding.") @@ -1499,8 +1500,8 @@ 2 (text "Plugins in the current package can't be specified.") case r of- Found {} -> addErr $ TcRnUnknownMessage $ mkPlainError noHints err- FoundMultiple {} -> addErr $ TcRnUnknownMessage $ mkPlainError noHints err+ Found {} -> addErr $ mkTcRnUnknownMessage $ mkPlainError noHints err+ FoundMultiple {} -> addErr $ mkTcRnUnknownMessage $ mkPlainError noHints err _ -> return () th_coreplugins_var <- tcg_th_coreplugins <$> getGblEnv updTcRef th_coreplugins_var (plugin:)@@ -1525,7 +1526,7 @@ th_doc_var <- tcg_th_docs <$> getGblEnv resolved_doc_loc <- resolve_loc doc_loc is_local <- checkLocalName resolved_doc_loc- unless is_local $ failWithTc $ TcRnUnknownMessage $ mkPlainError noHints $ text+ unless is_local $ failWithTc $ mkTcRnUnknownMessage $ mkPlainError noHints $ text "Can't add documentation to" <+> ppr_loc doc_loc <+> text "as it isn't inside the current module" let ds = mkGeneratedHsDocString s@@ -1615,7 +1616,7 @@ Right (_, (inst:_)) -> return $ getName inst Right (_, []) -> noMatches where- noMatches = failWithTc $ TcRnUnknownMessage $ mkPlainError noHints $+ noMatches = failWithTc $ mkTcRnUnknownMessage $ mkPlainError noHints $ text "Couldn't find any instances of" <+> ppr_th th_type <+> text "to add documentation to"@@ -1654,7 +1655,7 @@ inst_cls_name TH.WildCardT = inst_cls_name_err inst_cls_name (TH.ImplicitParamT _ _) = inst_cls_name_err - inst_cls_name_err = failWithTc $ TcRnUnknownMessage $ mkPlainError noHints $+ inst_cls_name_err = failWithTc $ mkTcRnUnknownMessage $ mkPlainError noHints $ text "Couldn't work out what instance" <+> ppr_th th_type <+> text "is supposed to be"@@ -1945,7 +1946,7 @@ ; let matches = lookupFamInstEnv inst_envs tc tys ; traceTc "reifyInstances'2" (ppr matches) ; return $ Right (tc, map fim_instance matches) }- _ -> bale_out $ TcRnUnknownMessage $ mkPlainError noHints $+ _ -> bale_out $ mkTcRnUnknownMessage $ mkPlainError noHints $ (hang (text "reifyInstances:" <+> quotes (ppr ty)) 2 (text "is not a class constraint or type family application")) } where@@ -1954,7 +1955,7 @@ cvt :: Origin -> SrcSpan -> TH.Type -> TcM (LHsType GhcPs) cvt origin loc th_ty = case convertToHsType origin loc th_ty of- Left msg -> failWithTc (TcRnUnknownMessage $ mkPlainError noHints msg)+ Left msg -> failWithTc (mkTcRnUnknownMessage $ mkPlainError noHints msg) Right ty -> return ty {-@@ -2055,17 +2056,17 @@ do { mb_thing <- tcLookupImported_maybe name ; case mb_thing of Succeeded thing -> return (AGlobal thing)- Failed msg -> failWithTc (TcRnUnknownMessage $ mkPlainError noHints msg)+ Failed msg -> failWithTc (mkTcRnUnknownMessage $ mkPlainError noHints msg) }}}} notInScope :: TH.Name -> TcRnMessage-notInScope th_name = TcRnUnknownMessage $ mkPlainError noHints $+notInScope th_name = mkTcRnUnknownMessage $ mkPlainError noHints $ quotes (text (TH.pprint th_name)) <+> text "is not in scope at a reify" -- Ugh! Rather an indirect way to display the name notInEnv :: Name -> TcRnMessage-notInEnv name = TcRnUnknownMessage $ mkPlainError noHints $+notInEnv name = mkTcRnUnknownMessage $ mkPlainError noHints $ quotes (ppr name) <+> text "is not in the type environment at a reify" ------------------------------@@ -2074,7 +2075,7 @@ = do { thing <- getThing th_name ; case thing of AGlobal (ATyCon tc) -> return (map reify_role (tyConRoles tc))- _ -> failWithTc (TcRnUnknownMessage $ mkPlainError noHints $ text "No roles associated with" <+> (ppr thing))+ _ -> failWithTc (mkTcRnUnknownMessage $ mkPlainError noHints $ text "No roles associated with" <+> (ppr thing)) } where reify_role Nominal = TH.NominalR@@ -2640,8 +2641,8 @@ reifyPatSynType :: ([InvisTVBinder], ThetaType, [InvisTVBinder], ThetaType, [Scaled Type], Type) -> TcM TH.Type -- reifies a pattern synonym's type and returns its *complete* type--- signature; see NOTE [Pattern synonym signatures and Template--- Haskell]+-- signature; see Note [Pattern synonym type signatures and Template+-- Haskell] in GHC.ThToHs reifyPatSynType (univTyVars, req, exTyVars, prov, argTys, resTy) = do { univTyVars' <- reifyTyVarBndrs univTyVars ; req' <- reifyCxt req@@ -2868,7 +2869,7 @@ mkThAppTs fun_ty arg_tys = foldl' TH.AppT fun_ty arg_tys noTH :: SDoc -> SDoc -> TcM a-noTH s d = failWithTc $ TcRnUnknownMessage $ mkPlainError noHints $+noTH s d = failWithTc $ mkTcRnUnknownMessage $ mkPlainError noHints $ (hsep [text "Can't represent" <+> s <+> text "in Template Haskell:", nest 2 d])
compiler/GHC/Tc/Instance/Family.hs view
@@ -364,7 +364,7 @@ -- We could, but doing so means one of two things: -- -- 1. When looping over the cartesian product we convert- -- a set into a non-deterministicly ordered list. Which+ -- a set into a non-deterministically ordered list. Which -- happens to be fine for interface file determinism -- in this case, today, because the order only -- determines the order of deferred checks. But such@@ -558,8 +558,7 @@ -- which would lead to terrible error messages unwrap_newtype_instance rec_nts tc tys | Just (tc', tys', co) <- tcLookupDataFamInst_maybe faminsts tc tys- = mapStepResult (\(gres, co1) -> (gres, co `mkTransCo` co1)) $- unwrap_newtype rec_nts tc' tys'+ = fmap (mkTransCo co) <$> unwrap_newtype rec_nts tc' tys' | otherwise = NS_Done unwrap_newtype rec_nts tc tys@@ -567,8 +566,7 @@ , Just gre <- lookupGRE_Name rdr_env (dataConName con) -- This is where we check that the -- data constructor is in scope- = mapStepResult (\co -> (unitBag gre, co)) $- unwrapNewTypeStepper rec_nts tc tys+ = (,) (unitBag gre) <$> unwrapNewTypeStepper rec_nts tc tys | otherwise = NS_Done
compiler/GHC/Tc/Instance/FunDeps.hs view
@@ -633,7 +633,7 @@ ClsInsts in the environment. The bogus aspect is discussed in #10675. Currently it if the two-types are *contradicatory*, using (isNothing . tcUnifyTys). But all+types are *contradictory*, using (isNothing . tcUnifyTys). But all the papers say we should check if the two types are *equal* thus not (substTys subst rtys1 `eqTypes` substTys subst rtys2) For now I'm leaving the bogus form because that's the way it has
compiler/GHC/Tc/Instance/Typeable.hs view
@@ -106,7 +106,7 @@ * GHC.Prim doesn't have any associated object code, so we need to put the representations for types defined in this module elsewhere. We chose this place to be GHC.Types. GHC.Tc.Instance.Typeable.mkPrimTypeableBinds is responsible for- injecting the bindings for the GHC.Prim representions when compiling+ injecting the bindings for the GHC.Prim representations when compiling GHC.Types. * TyCon.tyConRepModOcc is responsible for determining where to find
compiler/GHC/Tc/Module.hs view
@@ -176,7 +176,10 @@ import GHC.Data.Bag import qualified GHC.Data.BooleanFormula as BF +import Data.Functor.Classes ( liftEq ) import Data.List ( sortBy, sort )+import Data.List.NonEmpty ( NonEmpty (..) )+import qualified Data.List.NonEmpty as NE import Data.Ord import Data.Data ( Data ) import qualified Data.Set as S@@ -264,7 +267,7 @@ implicit_prelude import_decls } ; when (notNull prel_imports) $ do- let msg = TcRnUnknownMessage $+ let msg = mkTcRnUnknownMessage $ mkPlainDiagnostic (WarningWithFlag Opt_WarnImplicitPrelude) noHints (implicitPreludeWarn) addDiagnostic msg @@ -627,7 +630,7 @@ { Nothing -> return () ; Just (SpliceDecl _ (L loc _) _, _) -> setSrcSpanA loc- $ addErr (TcRnUnknownMessage $ mkPlainError noHints $ text+ $ addErr (mkTcRnUnknownMessage $ mkPlainError noHints $ text ("Declaration splices are not " ++ "permitted inside top-level " ++ "declarations added with addTopDecls"))@@ -749,7 +752,7 @@ badBootDecl :: HscSource -> String -> LocatedA decl -> TcM () badBootDecl hsc_src what (L loc _)- = addErrAt (locA loc) $ TcRnUnknownMessage $ mkPlainError noHints $+ = addErrAt (locA loc) $ mkTcRnUnknownMessage $ mkPlainError noHints $ (char 'A' <+> text what <+> text "declaration is not (currently) allowed in a" <+> (case hsc_src of@@ -1065,7 +1068,7 @@ (text "The types of" <+> pname1 <+> text "are different") `andThenCheck` if is_boot- then check (eqMaybeBy eqDM def_meth1 def_meth2)+ then check (liftEq eqDM def_meth1 def_meth2) (text "The default methods associated with" <+> pname1 <+> text "are different") else check (subDM op_ty1 def_meth1 def_meth2)@@ -1114,15 +1117,15 @@ eqATDef _ _ = False eqFD (as1,bs1) (as2,bs2) =- eqListBy (eqTypeX env) (mkTyVarTys as1) (mkTyVarTys as2) &&- eqListBy (eqTypeX env) (mkTyVarTys bs1) (mkTyVarTys bs2)+ liftEq (eqTypeX env) (mkTyVarTys as1) (mkTyVarTys as2) &&+ liftEq (eqTypeX env) (mkTyVarTys bs1) (mkTyVarTys bs2) in checkRoles roles1 roles2 `andThenCheck` -- Checks kind of class- check (eqListBy eqFD clas_fds1 clas_fds2)+ check (liftEq eqFD clas_fds1 clas_fds2) (text "The functional dependencies do not match") `andThenCheck` checkUnless (isAbstractTyCon tc1) $- check (eqListBy (eqTypeX env) sc_theta1 sc_theta2)+ check (liftEq (eqTypeX env) sc_theta1 sc_theta2) (text "The class constraints do not match") `andThenCheck` checkListBy eqSig op_stuff1 op_stuff2 (text "methods") `andThenCheck` checkListBy eqAT ats1 ats2 (text "associated types") `andThenCheck`@@ -1190,7 +1193,7 @@ , Just env <- eqVarBndrs emptyRnEnv2 (tyConTyVars tc1) (tyConTyVars tc2) = assert (tc1 == tc2) $ checkRoles roles1 roles2 `andThenCheck`- check (eqListBy (eqTypeX env)+ check (liftEq (eqTypeX env) (tyConStupidTheta tc1) (tyConStupidTheta tc2)) (text "The datatype contexts do not match") `andThenCheck` eqAlgRhs tc1 (algTyConRhs tc1) (algTyConRhs tc2)@@ -1275,7 +1278,7 @@ -- but ONLY if the type synonym is nullary and has no type family -- applications. This arises from two properties of skolem abstract data: --- -- For any T (with some number of paramaters),+ -- For any T (with some number of parameters), -- -- 1. T is a valid type (it is "curryable"), and --@@ -1336,7 +1339,7 @@ check (dataConIsInfix c1 == dataConIsInfix c2) (text "The fixities of" <+> pname1 <+> text "differ") `andThenCheck`- check (eqListBy eqHsBang (dataConImplBangs c1) (dataConImplBangs c2))+ check (liftEq eqHsBang (dataConImplBangs c1) (dataConImplBangs c2)) (text "The strictness annotations for" <+> pname1 <+> text "differ") `andThenCheck` check (map flSelector (dataConFieldLabels c1) == map flSelector (dataConFieldLabels c2))@@ -1367,7 +1370,7 @@ , cab_lhs = lhs2, cab_rhs = rhs2 }) | Just env1 <- eqVarBndrs emptyRnEnv2 tvs1 tvs2 , Just env <- eqVarBndrs env1 cvs1 cvs2- = eqListBy (eqTypeX env) lhs1 lhs2 &&+ = liftEq (eqTypeX env) lhs1 lhs2 && eqTypeX env rhs1 rhs2 | otherwise = False@@ -1378,7 +1381,7 @@ ---------------- missingBootThing :: Bool -> Name -> String -> TcRnMessage missingBootThing is_boot name what- = TcRnUnknownMessage $ mkPlainError noHints $+ = mkTcRnUnknownMessage $ mkPlainError noHints $ quotes (ppr name) <+> text "is exported by the" <+> (if is_boot then text "hs-boot" else text "hsig") <+> text "file, but not"@@ -1386,7 +1389,7 @@ badReexportedBootThing :: Bool -> Name -> Name -> TcRnMessage badReexportedBootThing is_boot name name'- = TcRnUnknownMessage $ mkPlainError noHints $+ = mkTcRnUnknownMessage $ mkPlainError noHints $ withUserStyle alwaysQualify AllTheWay $ vcat [ text "The" <+> (if is_boot then text "hs-boot" else text "hsig") <+> text "file (re)exports" <+> quotes (ppr name)@@ -1395,7 +1398,7 @@ bootMisMatch :: Bool -> SDoc -> TyThing -> TyThing -> TcRnMessage bootMisMatch is_boot extra_info real_thing boot_thing- = TcRnUnknownMessage $ mkPlainError noHints $+ = mkTcRnUnknownMessage $ mkPlainError noHints $ pprBootMisMatch is_boot extra_info real_thing real_doc boot_doc where to_doc@@ -1426,7 +1429,7 @@ instMisMatch :: DFunId -> TcRnMessage instMisMatch dfun- = TcRnUnknownMessage $ mkPlainError noHints $+ = mkTcRnUnknownMessage $ mkPlainError noHints $ hang (text "instance" <+> ppr (idType dfun)) 2 (text "is defined in the hs-boot file, but not in the module itself") @@ -1619,7 +1622,7 @@ (hang (ppr name) 4 (sep [ppr clashingElts])) ; let warn_msg x = addDiagnosticAt (nameSrcSpan (greMangledName x)) $- TcRnUnknownMessage $+ mkTcRnUnknownMessage $ mkPlainDiagnostic (WarningWithFlag warnFlag) noHints $ (hsep [ text "Local definition of" , (quotes . ppr . nameOccName . greMangledName) x@@ -1732,7 +1735,7 @@ ; let instLoc = srcLocSpan . nameSrcLoc $ getName isInst warnMsg (RM_KnownTc name:_) = addDiagnosticAt instLoc $- TcRnUnknownMessage $ mkPlainDiagnostic (WarningWithFlag warnFlag) noHints $+ mkTcRnUnknownMessage $ mkPlainDiagnostic (WarningWithFlag warnFlag) noHints $ hsep [ (quotes . ppr . nameOccName) name , text "is an instance of" , (ppr . nameOccName . className) isClass@@ -1870,7 +1873,7 @@ -- in other modes, add error message and go on with typechecking. noMainMsg main_mod main_occ- = TcRnUnknownMessage $ mkPlainError noHints $+ = mkTcRnUnknownMessage $ mkPlainError noHints $ text "The" <+> ppMainFn main_occ <+> text "is not" <+> text defOrExp <+> text "module" <+> quotes (ppr main_mod)@@ -2188,7 +2191,7 @@ return (global_ids, zonked_expr, fix_env) } where- bad_unboxed id = addErr $ TcRnUnknownMessage $ mkPlainError noHints $+ bad_unboxed id = addErr $ mkTcRnUnknownMessage $ mkPlainError noHints $ (sep [text "GHCi can't bind a variable of unlifted type:", nest 2 (pprPrefixOcc id <+> dcolon <+> ppr (idType id))]) @@ -2222,10 +2225,8 @@ -- | Try the plans in order. If one fails (by raising an exn), try the next. -- If one succeeds, take it.-runPlans :: [Plan] -> TcM PlanResult-runPlans [] = panic "runPlans"-runPlans [p] = p-runPlans (p:ps) = tryTcDiscardingErrs (runPlans ps) p+runPlans :: NonEmpty Plan -> Plan+runPlans = foldr1 (flip tryTcDiscardingErrs) -- | Typecheck (and 'lift') a stmt entered by the user in GHCi into the -- GHCi 'environment'.@@ -2297,30 +2298,31 @@ -- See Note [GHCi Plans] - it_plans = [+ it_plans = -- Plan A do { stuff@([it_id], _) <- tcGhciStmts [bind_stmt, print_it] ; it_ty <- zonkTcType (idType it_id)- ; when (isUnitTy $ it_ty) failM- ; return stuff },+ ; when (isUnitTy it_ty) failM+ ; return stuff } :| -- Plan B; a naked bind statement- tcGhciStmts [bind_stmt],+ [ tcGhciStmts [bind_stmt] -- Plan C; check that the let-binding is typeable all by itself. -- If not, fail; if so, try to print it. -- The two-step process avoids getting two errors: one from -- the expression itself, and one from the 'print it' part -- This two-step story is very clunky, alas- do { _ <- checkNoErrs (tcGhciStmts [let_stmt])+ , do { _ <- checkNoErrs (tcGhciStmts [let_stmt]) --- checkNoErrs defeats the error recovery of let-bindings ; tcGhciStmts [let_stmt, print_it] } ] -- Plans where we don't bind "it"- no_it_plans = [- tcGhciStmts [no_it_a] ,- tcGhciStmts [no_it_b] ,- tcGhciStmts [no_it_c] ]+ no_it_plans =+ tcGhciStmts [no_it_a] :|+ tcGhciStmts [no_it_b] :+ tcGhciStmts [no_it_c] :+ [] ; generate_it <- goptM Opt_NoIt @@ -2412,13 +2414,13 @@ ; let print_result_plan | opt_pr_flag -- The flag says "print result" , [v] <- collectLStmtBinders CollNoDictBinders gi_stmt -- One binder- = [mk_print_result_plan gi_stmt v]- | otherwise = []+ = Just $ mk_print_result_plan gi_stmt v+ | otherwise = Nothing -- The plans are: -- [stmt; print v] if one binder and not v::() -- [stmt] otherwise- ; plan <- runPlans (print_result_plan ++ [tcGhciStmts [gi_stmt]])+ ; plan <- runPlans $ maybe id (NE.<|) print_result_plan $ NE.singleton $ tcGhciStmts [gi_stmt] ; return (plan, fix_env) } where mk_print_result_plan stmt v@@ -2543,8 +2545,8 @@ _ <- tcLookupInstance ghciClass [userTy] return name - Just _ -> failWithTc $ TcRnUnknownMessage $ mkPlainError noHints $ text "Ambiguous type!"- Nothing -> failWithTc $ TcRnUnknownMessage $ mkPlainError noHints $ text ("Can't find type:" ++ ty)+ Just _ -> failWithTc $ mkTcRnUnknownMessage $ mkPlainError noHints $ text "Ambiguous type!"+ Nothing -> failWithTc $ mkTcRnUnknownMessage $ mkPlainError noHints $ text ("Can't find type:" ++ ty) -- | How should we infer a type? See Note [TcRnExprMode] data TcRnExprMode = TM_Inst -- ^ Instantiate inferred quantifiers only (:type)@@ -2727,7 +2729,7 @@ :type / TM_Inst - In this mode, we report the type obained by instantiating only the+ In this mode, we report the type obtained by instantiating only the /inferred/ quantifiers of e's type, solving constraints, and re-generalising, as discussed in #11376. @@ -2847,7 +2849,7 @@ let rdr_names = dataTcOccs rdr_name ; names_s <- mapM lookupInfoOccRn rdr_names ; let names = concat names_s- ; when (null names) (addErrTc $ TcRnUnknownMessage $ mkPlainError noHints $+ ; when (null names) (addErrTc $ mkTcRnUnknownMessage $ mkPlainError noHints $ (text "Not in scope:" <+> quotes (ppr rdr_name))) ; return names }
compiler/GHC/Tc/Solver.hs view
@@ -438,7 +438,7 @@ We re-emit the implication rather than reporting the errors right now,-so that the error mesages are improved by other solving and defaulting.+so that the error messages are improved by other solving and defaulting. e.g. we prefer Cannot match 'Type->Type' with 'Type' to Cannot match 'Type->Type' with 'TYPE r0'@@ -1013,7 +1013,7 @@ the recursive case, we would go on forever in the common case where the constraints /are/ satisfiable (#10592 comment:12!). -For stratightforard situations without type functions the try_harder+For straightforward situations without type functions the try_harder step does nothing. Note [tcNormalise]@@ -1668,13 +1668,13 @@ At least for single functions we would like to quantify f over precisely the same theta as <quant-theta>, so that we get to take the short-cut path in GHC.Tc.Gen.Bind.mkExport, and avoid calling-tcSubTypeSigma for impedence matching. Why avoid? Because it falls+tcSubTypeSigma for impedance matching. Why avoid? Because it falls over for ambiguous types (#20921). We can get precisely the same theta by using the same algorithm, findInferredDiff. -All of this goes wrong if we have (a) mutual recursion, (b) mutiple+All of this goes wrong if we have (a) mutual recursion, (b) multiple partial type signatures, (c) with different constraints, and (d) ambiguous types. Something like f :: forall a. Eq a => F a -> _@@ -1848,7 +1848,7 @@ -- NB: only pass 'DefaultKindVars' when we know we're dealing with a kind variable. tv - -- this common case (no inferred contraints) should be fast+ -- this common case (no inferred constraints) should be fast simplify_cand [] = return [] -- see Note [Unconditionally resimplify constraints when quantifying] simplify_cand candidates@@ -2689,7 +2689,7 @@ Moreover, if we simplify this implication more than once (e.g. because we can't solve it completely on the first iteration- of simpl_looop), we'll generate all the same bindings AGAIN!+ of simpl_loop), we'll generate all the same bindings AGAIN! Easy solution: take advantage of the work we are doing to track dead (unused) Givens, and use it to prune the Given bindings too. This is
compiler/GHC/Tc/Solver/Canonical.hs view
@@ -321,7 +321,7 @@ * To avoid repeated work, by repeatedly expanding the superclasses of same constraint, -* To terminate the above loop, at least in the -XNoRecursiveSuperClasses+* To terminate the above loop, at least in the -XNoUndecidableSuperClasses case. If there are recursive superclasses we could, in principle, expand forever, always encountering new constraints. @@ -412,7 +412,7 @@ instance L (Maybe a) a When solving the superclasses of the (C (Maybe a) a) instance, we get- [G] C a b, and hance by superclasses, [G] G a, [G] L a b+ [G] C a b, and hence by superclasses, [G] G a, [G] L a b [W] G (Maybe a) Use the instance decl to get [W] C a beta@@ -590,7 +590,7 @@ -- GHC.Tc.TyCl.Instance. Skip for a tiny performance win. -- See Note [Solving superclass constraints] in GHC.Tc.TyCl.Instance- -- for explantation of InstSCOrigin and Note [Replacement vs keeping] in+ -- for explanation of InstSCOrigin and Note [Replacement vs keeping] in -- GHC.Tc.Solver.Interact for why we need OtherSCOrigin and depths | otherwise = loc { ctl_origin = new_orig }@@ -1179,7 +1179,7 @@ variable binders into the same equivalence class. Note that we do /not/ use sameVis in GHC.Core.Type.eqType, which implements-/definitional/ equality, a slighty more coarse-grained notion of equality+/definitional/ equality, a slightly more coarse-grained notion of equality (see Note [Non-trivial definitional equality] in GHC.Core.TyCo.Rep) that does not consider the ArgFlag of ForAllTys at all. That is, eqType would equate all of forall k. <...>, forall {k}. <...>, and forall k -> <...>.@@ -1972,7 +1972,7 @@ (s1 ~ s2, t1 ~ t2) and push those back into the work list. But if s1 = K k1 s2 = K k2-then we will just decomopose s1~s2, and it might be better to+then we will just decompose s1~s2, and it might be better to do so on the spot. An important special case is where s1=s2, and we get just Refl. @@ -2827,7 +2827,7 @@ (5) The approach here is inefficient because it replaces every (outermost) type family application with a type variable, regardless of whether that particular appplication is implicated in the occurs check. An alternative- would be to replce only type-family applications that meantion the offending LHS.+ would be to replce only type-family applications that mention the offending LHS. For instance, we could choose to affect only type family applications that mention the offending LHS: e.g. in a ~ (F b, G a), we need to replace only G a, not F b. Furthermore,
compiler/GHC/Tc/Solver/Interact.hs view
@@ -50,6 +50,7 @@ import qualified Data.Semigroup as S import Control.Monad+import Data.Maybe ( listToMaybe, mapMaybe ) import GHC.Data.Pair (Pair(..)) import GHC.Types.Unique( hasKey ) import GHC.Driver.Session@@ -76,7 +77,7 @@ - inert reactions - spontaneous reactions - top-level interactions- Each stage returns a StopOrContinue and may have sideffected+ Each stage returns a StopOrContinue and may have sideeffected the inerts or worklist. The threading of the stages is as follows:@@ -912,7 +913,7 @@ cannot be solved from instances. * The (EvBindMap, DictMap CtEvidence) is an accumulating purely-functional- state that allows try_solve_from_instance to augmennt the evidence+ state that allows try_solve_from_instance to augment the evidence bindings and inert_solved_dicts as it goes. If it succeeds, we commit all these bindings and solved dicts to the@@ -985,7 +986,7 @@ [W] iss ~ is2 : beta Again we can't prove that equality; and worse we'll rewrite iss to- (is2:beta) in deeply nested contraints inside this implication,+ (is2:beta) in deeply nested constraints inside this implication, where beta is untouchable (under other equality constraints), leading to other insoluble constraints. @@ -1460,7 +1461,7 @@ That first argument is invisible in the source program (aside from visible type application), so we'd much prefer to get the error from- the second. We track visiblity in the uo_visible field of a TypeEqOrigin.+ the second. We track visibility in the uo_visible field of a TypeEqOrigin. We use this to prioritise visible errors (see GHC.Tc.Errors.tryReporters, the partition on isVisibleOrigin). @@ -1810,7 +1811,7 @@ -} doTopFundepImprovement :: Ct -> TcS (StopOrContinue Ct)--- Try to functional-dependency improvement betweeen the constraint+-- Try to functional-dependency improvement between the constraint -- and the top-level instance declarations -- See Note [Fundeps with instances] -- See also Note [Weird fundeps]@@ -2432,7 +2433,7 @@ instance (c1, c2) => (% c1, c2 %) Example in #14218 -Exammples: T5853, T10432, T5315, T9222, T2627b, T3028b+Examples: T5853, T10432, T5315, T9222, T2627b, T3028b PS: the term "naturally coherent" doesn't really seem helpful. Perhaps "invertible" or something? I left it for now though.@@ -2457,7 +2458,7 @@ that unify with it here. It is not like an incoherent user-written instance which might have utterly different behaviour. -Consdider f :: Eq a => blah. If we have [W] Eq a, we certainly+Consider f :: Eq a => blah. If we have [W] Eq a, we certainly get it from the Eq a context, without worrying that there are lots of top-level instances that unify with [W] Eq a! We'll use those instances to build evidence to pass to f. That's just the@@ -2470,109 +2471,236 @@ matchLocalInst pred loc = do { inerts@(IS { inert_cans = ics }) <- getTcSInerts ; case match_local_inst inerts (inert_insts ics) of- ([], Nothing) -> do { traceTcS "No local instance for" (ppr pred)- ; return NoInstance }-- -- See Note [Use only the best local instance] about- -- superclass depths- (matches, unifs)- | [(dfun_ev, inst_tys)] <- best_matches- , maybe True (> min_sc_depth) unifs- -> do { let dfun_id = ctEvEvId dfun_ev- ; (tys, theta) <- instDFunType dfun_id inst_tys- ; let result = OneInst { cir_new_theta = theta- , cir_mk_ev = evDFunApp dfun_id tys- , cir_what = LocalInstance }- ; traceTcS "Best local inst found:" (ppr result)- ; traceTcS "All local insts:" (ppr matches)- ; return result }-- | otherwise- -> do { traceTcS "Multiple local instances for" (ppr pred)- ; return NotSure }+ { ([], []) -> do { traceTcS "No local instance for" (ppr pred)+ ; return NoInstance }+ ; (matches, unifs) ->+ do { matches <- mapM mk_instDFun matches+ ; unifs <- mapM mk_instDFun unifs+ -- See Note [Use only the best matching quantified constraint]+ ; case dominatingMatch matches of+ { Just (dfun_id, tys, theta)+ | all ((theta `impliedBySCs`) . thdOf3) unifs+ ->+ do { let result = OneInst { cir_new_theta = theta+ , cir_mk_ev = evDFunApp dfun_id tys+ , cir_what = LocalInstance }+ ; traceTcS "Best local instance found:" $+ vcat [ text "pred:" <+> ppr pred+ , text "result:" <+> ppr result+ , text "matches:" <+> ppr matches+ , text "unifs:" <+> ppr unifs ]+ ; return result } - where- extract_depth = sc_depth . ctEvLoc . fst- min_sc_depth = minimum (map extract_depth matches)- best_matches = filter ((== min_sc_depth) . extract_depth) matches }+ ; mb_best ->+ do { traceTcS "Multiple local instances; not committing to any"+ $ vcat [ text "pred:" <+> ppr pred+ , text "matches:" <+> ppr matches+ , text "unifs:" <+> ppr unifs+ , text "best_match:" <+> ppr mb_best ]+ ; return NotSure }}}}} where pred_tv_set = tyCoVarsOfType pred - sc_depth :: CtLoc -> Int- sc_depth ctloc = case ctLocOrigin ctloc of- InstSCOrigin depth _ -> depth- OtherSCOrigin depth _ -> depth- _ -> 0+ mk_instDFun :: (CtEvidence, [DFunInstType]) -> TcS InstDFun+ mk_instDFun (ev, tys) =+ let dfun_id = ctEvEvId ev+ in do { (tys, theta) <- instDFunType (ctEvEvId ev) tys+ ; return (dfun_id, tys, theta) } - -- See Note [Use only the best local instance] about superclass depths+ -- Compute matching and unifying local instances match_local_inst :: InertSet -> [QCInst] -> ( [(CtEvidence, [DFunInstType])]- , Maybe Int ) -- Nothing ==> no unifying local insts- -- Just n ==> unifying local insts, with- -- minimum superclass depth- -- of n+ , [(CtEvidence, [DFunInstType])] ) match_local_inst _inerts []- = ([], Nothing)- match_local_inst inerts (qci@(QCI { qci_tvs = qtvs, qci_pred = qpred- , qci_ev = qev })- : qcis)+ = ([], [])+ match_local_inst inerts (qci@(QCI { qci_tvs = qtvs+ , qci_pred = qpred+ , qci_ev = qev })+ :qcis) | let in_scope = mkInScopeSet (qtv_set `unionVarSet` pred_tv_set) , Just tv_subst <- ruleMatchTyKiX qtv_set (mkRnEnv2 in_scope) emptyTvSubstEnv qpred pred , let match = (qev, map (lookupVarEnv tv_subst) qtvs)- = (match:matches, unif)+ = (match:matches, unifs) | otherwise = assertPpr (disjointVarSet qtv_set (tyCoVarsOfType pred)) (ppr qci $$ ppr pred) -- ASSERT: unification relies on the -- quantified variables being fresh- (matches, unif `combine` this_unif)+ (matches, this_unif `combine` unifs) where qloc = ctEvLoc qev qtv_set = mkVarSet qtvs+ (matches, unifs) = match_local_inst inerts qcis this_unif- | mightEqualLater inerts qpred qloc pred loc = Just (sc_depth qloc)- | otherwise = Nothing- (matches, unif) = match_local_inst inerts qcis+ | Just subst <- mightEqualLater inerts qpred qloc pred loc+ = Just (qev, map (lookupTyVar subst) qtvs)+ | otherwise+ = Nothing - combine Nothing Nothing = Nothing- combine (Just n) Nothing = Just n- combine Nothing (Just n) = Just n- combine (Just n1) (Just n2) = Just (n1 `min` n2)+ combine Nothing us = us+ combine (Just u) us = u : us -{- Note [Use only the best local instance]-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+-- | Instance dictionary function and type.+type InstDFun = (DFunId, [TcType], TcThetaType)++-- | Try to find a local quantified instance that dominates all others,+-- i.e. which has a weaker instance context than all the others.+--+-- See Note [Use only the best matching quantified constraint].+dominatingMatch :: [InstDFun] -> Maybe InstDFun+dominatingMatch matches =+ listToMaybe $ mapMaybe (uncurry go) (holes matches)+ -- listToMaybe: arbitrarily pick any one context that is weaker than+ -- all others, e.g. so that we can handle [Eq a, Num a] vs [Num a, Eq a]+ -- (see test case T22223).++ where+ go :: InstDFun -> [InstDFun] -> Maybe InstDFun+ go this [] = Just this+ go this@(_,_,this_theta) ((_,_,other_theta):others)+ | this_theta `impliedBySCs` other_theta+ = go this others+ | otherwise+ = Nothing++-- | Whether a collection of constraints is implied by another collection,+-- according to a simple superclass check.+--+-- See Note [When does a quantified instance dominate another?].+impliedBySCs :: TcThetaType -> TcThetaType -> Bool+impliedBySCs c1 c2 = all in_c2 c1+ where+ in_c2 :: TcPredType -> Bool+ in_c2 pred = any (pred `eqType`) c2_expanded++ c2_expanded :: [TcPredType] -- Includes all superclasses+ c2_expanded = [ q | p <- c2, q <- p : transSuperClasses p ]+++{- Note [When does a quantified instance dominate another?]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~+When matching local quantified instances, it's useful to be able to pick+the one with the weakest precondition, e.g. if one has both++ [G] d1: forall a b. ( Eq a, Num b, C a b ) => D a b+ [G] d2: forall a . C a Int => D a Int+ [W] {w}: D a Int++Then it makes sense to use d2 to solve w, as doing so we end up with a strictly+weaker proof obligation of `C a Int`, compared to `(Eq a, Num Int, C a Int)`+were we to use d1.++In theory, to compute whether one context implies another, we would need to+recursively invoke the constraint solver. This is expensive, so we instead do+a simple check using superclasses, implemented in impliedBySCs.++Examples:++ - [Eq a] is implied by [Ord a]+ - [Ord a] is not implied by [Eq a],+ - any context is implied by itself,+ - the empty context is implied by any context.++Note [Use only the best matching quantified constraint]+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider (#20582) the ambiguity check for (forall a. Ord (m a), forall a. Semigroup a => Eq (m a)) => m Int Because of eager expansion of given superclasses, we get- [G] forall a. Ord (m a)- [G] forall a. Eq (m a)- [G] forall a. Semigroup a => Eq (m a)+ [G] d1: forall a. Ord (m a)+ [G] d2: forall a. Eq (m a)+ [G] d3: forall a. Semigroup a => Eq (m a) - [W] forall a. Ord (m a)- [W] forall a. Semigroup a => Eq (m a)+ [W] {w1}: forall a. Ord (m a)+ [W] {w2}: forall a. Semigroup a => Eq (m a) The first wanted is solved straightforwardly. But the second wanted-matches *two* local instances. Our general rule around multiple local+matches *two* local instances: d2 and d3. Our general rule around multiple local instances is that we refuse to commit to any of them. However, that means that our type fails the ambiguity check. That's bad: the type is perfectly fine. (This actually came up in the wild, in the streamly library.) -The solution is to prefer local instances with fewer superclass selections.-So, matchLocalInst is careful to whittle down the matches only to the-ones with the shallowest superclass depth, and also to worry about unifying-local instances that are at that depth (or less).+The solution is to prefer local instances which are easier to prove, meaning+that they have a weaker precondition. In this case, the empty context+of d2 is a weaker constraint than the "Semigroup a" context of d3, so we prefer+using it when proving w2. This allows us to pass the ambiguity check here. -By preferring these shallower local instances, we can use the last given-listed above and pass the ambiguity check.+Our criterion for solving a Wanted by matching local quantified instances is+thus as follows: -The instance-depth mechanism uses the same superclass depth-information as described in Note [Replacement vs keeping], 2a.+ - There is a matching local quantified instance that dominates all others+ matches, in the sense of [When does a quantified instance dominate another?].+ Any such match do, we pick it arbitrarily (the T22223 example below says why).+ - This local quantified instance also dominates all the unifiers, as we+ wouldn't want to commit to a single match when we might have multiple,+ genuinely different matches after further unification takes place. -Test case: typecheck/should_compile/T20582.+Some other examples: ++ #15244:++ f :: (C g, D g) => ....+ class S g => C g where ...+ class S g => D g where ...+ class (forall a. Eq a => Eq (g a)) => S g where ...++ Here, in f's RHS, there are two identical quantified constraints+ available, one via the superclasses of C and one via the superclasses+ of D. Given that each implies the other, we pick one arbitrarily.+++ #22216:++ class Eq a+ class Eq a => Ord a+ class (forall b. Eq b => Eq (f b)) => Eq1 f+ class (Eq1 f, forall b. Ord b => Ord (f b)) => Ord1 f++ Suppose we have++ [G] d1: Ord1 f+ [G] d2: Eq a+ [W] {w}: Eq (f a)++ Superclass expansion of d1 gives us:++ [G] d3 : Eq1 f+ [G] d4 : forall b. Ord b => Ord (f b)++ expanding d4 and d5 gives us, respectively:++ [G] d5 : forall b. Eq b => Eq (f b)+ [G] d6 : forall b. Ord b => Eq (f b)++ Now we have two matching local instances that we could use when solving the+ Wanted. However, it's obviously silly to use d6, given that d5 provides us with+ as much information, with a strictly weaker precondition. So we pick d5 to solve+ w. If we chose d6, we would get [W] Ord a, which in this case we can't solve.+++ #22223:++ [G] forall a b. (Eq a, Ord b) => C a b+ [G] forall a b. (Ord b, Eq a) => C a b+ [W] C x y++ Here we should be free to pick either quantified constraint, as they are+ equivalent up to re-ordering of the constraints in the context.+ See also Note [Do not add duplicate quantified instances]+ in GHC.Tc.Solver.Monad.++Test cases:+ typecheck/should_compile/T20582+ quantified-constraints/T15244+ quantified-constraints/T22216{a,b,c,d,e}+ quantified-constraints/T22223++Historical note: a previous solution was to instead pick the local instance+with the least superclass depth (see Note [Replacement vs keeping]),+but that doesn't work for the example from #22216. -}
compiler/GHC/Tc/Solver/Monad.hs view
@@ -220,21 +220,17 @@ {- Note [Do not add duplicate quantified instances] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~-Consider this (#15244):-- f :: (C g, D g) => ....- class S g => C g where ...- class S g => D g where ...- class (forall a. Eq a => Eq (g a)) => S g where ...+As an optimisation, we avoid adding duplicate quantified instances to the+inert set; we use a simple duplicate check using tcEqType for simplicity,+even though it doesn't account for superficial differences, e.g. it will count+the following two constraints as different (#22223): -Then in f's RHS there are two identical quantified constraints-available, one via the superclasses of C and one via the superclasses-of D. The two are identical, and it seems wrong to reject the program-because of that. But without doing duplicate-elimination we will have-two matching QCInsts when we try to solve constraints arising from f's-RHS.+ - forall a b. C a b+ - forall b a. C a b -The simplest thing is simply to eliminate duplicates, which we do here.+The main logic that allows us to pick local instances, even in the presence of+duplicates, is explained in Note [Use only the best matching quantified constraint]+in GHC.Tc.Solver.Interact. -} {- *********************************************************************@@ -902,7 +898,7 @@ ; ev_binds <- TcM.getTcEvBindsMap ev_binds_var ; return (res, ev_binds) } --- | This variant of 'runTcS' will immediatley fail upon encountering an+-- | This variant of 'runTcS' will immediately fail upon encountering an -- insoluble ct. See Note [Speeding up valid hole-fits]. Its one usage -- site does not need the ev_binds, so we do not return them. runTcSEarlyAbort :: TcS a -> TcM a@@ -1872,7 +1868,7 @@ ; env0 <- TcM.tcInitTidyEnv ; let tidy_env = tidyFreeTyCoVars env0 (tyCoVarsOfTypeList ty) tidy_ty = tidyType tidy_env ty- msg = TcRnUnknownMessage $ mkPlainError noHints $+ msg = mkTcRnUnknownMessage $ mkPlainError noHints $ vcat [ text "Reduction stack overflow; size =" <+> ppr depth , hang (text "When simplifying the following type:") 2 (ppr tidy_ty)
compiler/GHC/Tc/TyCl.hs view
@@ -34,7 +34,8 @@ import GHC.Hs -import GHC.Tc.Errors.Types ( TcRnMessage(..), FixedRuntimeRepProvenance(..) )+import GHC.Tc.Errors.Types ( TcRnMessage(..), FixedRuntimeRepProvenance(..)+ , mkTcRnUnknownMessage ) import GHC.Tc.TyCl.Build import GHC.Tc.Solver( pushLevelAndSolveEqualities, pushLevelAndSolveEqualitiesX , reportUnsolvedEqualities )@@ -101,9 +102,11 @@ import Language.Haskell.Syntax.Basic (FieldLabelString(..)) import Control.Monad+import Data.Foldable ( toList, traverse_ ) import Data.Functor.Identity import Data.List ( partition) import Data.List.NonEmpty ( NonEmpty(..) )+import qualified Data.List.NonEmpty as NE import qualified Data.Set as Set import Data.Tuple( swap ) @@ -387,7 +390,7 @@ This treatment of type synonyms only applies to Haskell 98-style synonyms. General type functions can be recursive, and hence, appear in `alg_decls'. -The kind of an open type family is solely determinded by its kind signature;+The kind of an open type family is solely determined by its kind signature; hence, only kind signatures participate in the construction of the initial kind environment (as constructed by `inferInitialKind'). In fact, we ignore instances of families altogether in the following. However, we need to include@@ -644,7 +647,7 @@ Note [Don't process associated types in getInitialKind] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Previously, we processed associated types in the thing_inside in getInitialKind,-but this was wrong -- we want to do ATs sepearately.+but this was wrong -- we want to do ATs separately. The consequence for not doing it this way is #15142: class ListTuple (tuple :: Type) (as :: [(k, Type)]) where@@ -984,7 +987,7 @@ 1. Inferred variables 2. Specified variables; in the left-to-right order in which the user wrote them, modified by scopedSort (see below)- to put them in depdendency order.+ to put them in dependency order. 3. Required variables before a top-level :: 4. All variables after a top-level :: @@ -1053,7 +1056,7 @@ ~~~~~~~~~~~~~~~~~~~ * For associated types we considered putting the class variables before the local variables, in a nod to the treatment for class- methods. But it got too compilicated; see #15592, comment:21ff.+ methods. But it got too complicated; see #15592, comment:21ff. * We rigidly require the ordering above, even though we could be much more permissive. Relevant musings are at@@ -1284,9 +1287,15 @@ , tcdDataDefn = HsDataDefn { dd_cons = cons } }) = unitNameEnv name (APromotionErr TyConPE) `plusNameEnv`- mkNameEnv [ (con, APromotionErr RecDataConPE)- | L _ con' <- cons+ mkNameEnv [ (con, APromotionErr conPE)+ | L _ con' <- toList cons , L _ con <- getConNames con' ]+ where+ -- In a "type data" declaration, the constructors are at the type level.+ -- See Note [Type data declarations] in GHC.Rename.Module.+ conPE+ | isTypeDataDefnCons cons = TyConPE+ | otherwise = RecDataConPE mk_prom_err_env decl = unitNameEnv (tcdName decl) (APromotionErr TyConPE)@@ -1354,14 +1363,13 @@ getInitialKind strategy (DataDecl { tcdLName = L _ name , tcdTyVars = ktvs- , tcdDataDefn = HsDataDefn { dd_kindSig = m_sig- , dd_ND = new_or_data } })- = do { let flav = newOrDataToFlavour new_or_data+ , tcdDataDefn = HsDataDefn { dd_kindSig = m_sig, dd_cons = cons } })+ = do { let flav = newOrDataToFlavour (dataDefnConsNewOrData cons) ctxt = DataKindCtxt name ; tc <- kcDeclHeader strategy name flav ktvs $ case m_sig of Just ksig -> TheKind <$> tcLHsKindSig ctxt ksig- Nothing -> return $ dataDeclDefaultResultKind strategy new_or_data+ Nothing -> return $ dataDeclDefaultResultKind strategy (dataDefnConsNewOrData cons) ; return [tc] } getInitialKind InitialKindInfer (FamDecl { tcdFam = decl })@@ -1569,8 +1577,7 @@ -- - In this function, those TcTyVars are unified with other kind variables during -- kind inference (see [How TcTyCons work]) -kcTyClDecl (DataDecl { tcdLName = (L _ _name), tcdDataDefn = defn }) tycon- | HsDataDefn { dd_ctxt = ctxt, dd_cons = cons, dd_ND = new_or_data } <- defn+kcTyClDecl (DataDecl { tcdLName = (L _ _name), tcdDataDefn = HsDataDefn { dd_ctxt = ctxt, dd_cons = cons } }) tycon = tcExtendNameTyVarEnv (tcTyConScopedTyVars tycon) $ -- NB: binding these tyvars isn't necessary for GADTs, but it does no -- harm. For GADTs, each data con brings its own tyvars into scope,@@ -1578,7 +1585,7 @@ -- (conceivably) shadowed. do { traceTc "kcTyClDecl" (ppr tycon $$ ppr (tyConTyVars tycon) $$ ppr (tyConResKind tycon)) ; _ <- tcHsContext ctxt- ; kcConDecls new_or_data (tyConResKind tycon) cons+ ; kcConDecls (dataDefnConsNewOrData cons) (tyConResKind tycon) cons } kcTyClDecl (SynDecl { tcdLName = L _ _name, tcdRhs = rhs }) tycon@@ -1633,14 +1640,14 @@ RecConGADT (L _ flds) _ -> kcConArgTys new_or_data res_kind $ map (hsLinear . cd_fld_type . unLoc) flds -kcConDecls :: NewOrData+kcConDecls :: Foldable f+ => NewOrData -> TcKind -- The result kind signature -- Used only in H98 case- -> [LConDecl GhcRn] -- The data constructors+ -> f (LConDecl GhcRn) -- The data constructors -> TcM () -- See Note [kcConDecls: kind-checking data type decls]-kcConDecls new_or_data tc_res_kind cons- = mapM_ (wrapLocMA_ (kcConDecl new_or_data tc_res_kind)) cons+kcConDecls new_or_data tc_res_kind = traverse_ (wrapLocMA_ (kcConDecl new_or_data tc_res_kind)) -- Kind check a data constructor. In additional to the data constructor, -- we also need to know about whether or not its corresponding type was@@ -1657,7 +1664,7 @@ kcConDecl new_or_data tc_res_kind (ConDeclH98 { con_name = name, con_ex_tvs = ex_tvs , con_mb_cxt = ex_ctxt, con_args = args })- = addErrCtxt (dataConCtxt [name]) $+ = addErrCtxt (dataConCtxt (NE.singleton name)) $ discardResult $ bindExplicitTKBndrs_Tv ex_tvs $ do { _ <- tcHsContext ex_ctxt@@ -1787,7 +1794,10 @@ APromotionErr is only used for DataCons, and only used during type checking in tcTyClGroup. +The same restriction applies constructors in to "type data" declarations.+See Note [Type data declarations] in GHC.Rename.Module. + ************************************************************************ * * \subsection{Type checking}@@ -1819,7 +1829,7 @@ "knot". So we aren't allowed to look at the TyCon T itself; we are only allowed to put it (lazily) in the returned structures. But when kind-checking the RHS of T's decl, we *do* need to know T's kind (so-that we can correctly elaboarate (T k f a). How can we get T's kind+that we can correctly elaborate (T k f a). How can we get T's kind without looking at T? Delicate answer: during tcTyClDecl, we extend *Global* env with T -> ATyCon (the (not yet built) final TyCon for T)@@ -2313,7 +2323,7 @@ data family F a :: UnliftedType data instance F Int = TInt - The ommission of a kind signature for `F` should not mean a result kind+ The omission of a kind signature for `F` should not mean a result kind of `Type` (and thus a kind error) here. * STEP 2: No change to kcTyClDecl.@@ -2541,7 +2551,7 @@ = return Nothing -- No default declaration tcDefaultAssocDecl _ (d1:_:_)- = failWithTc (TcRnUnknownMessage $ mkPlainError noHints $+ = failWithTc (mkTcRnUnknownMessage $ mkPlainError noHints $ text "More than one default declaration for" <+> ppr (tyFamInstDeclName (unLoc d1))) @@ -2828,7 +2838,7 @@ do { let tvs = binderVars tcbs ; dflags <- getDynFlags ; checkTc (xopt LangExt.TypeFamilyDependencies dflags)- (TcRnUnknownMessage $ mkPlainError noHints $+ (mkTcRnUnknownMessage $ mkPlainError noHints $ text "Illegal injectivity annotation" $$ text "Use TypeFamilyDependencies to allow this") ; inj_tvs <- mapM (tcLookupTyVar . unLoc) lInjNames@@ -2872,7 +2882,7 @@ -> HsDataDefn GhcRn -> TcM (TyCon, [DerivInfo]) -- NB: not used for newtype/data instances (whether associated or not) tcDataDefn err_ctxt roles_info tc_name- (HsDataDefn { dd_ND = new_or_data, dd_cType = cType+ (HsDataDefn { dd_cType = cType , dd_ctxt = ctxt , dd_kindSig = mb_ksig -- Already in tc's kind -- via inferInitialKinds@@ -2884,12 +2894,12 @@ -- - for H98 constructors only, the ConDecl -- But it does no harm to bring them into scope -- over GADT ConDecls as well; and it's awkward not to- do { gadt_syntax <- dataDeclChecks tc_name new_or_data ctxt cons+ do { gadt_syntax <- dataDeclChecks tc_name ctxt cons ; tcg_env <- getGblEnv ; let hsc_src = tcg_src tcg_env ; unless (mk_permissive_kind hsc_src cons) $- checkDataKindSig (DataDeclSort new_or_data) res_kind+ checkDataKindSig (DataDeclSort (dataDefnConsNewOrData cons)) res_kind ; stupid_tc_theta <- pushLevelAndSolveEqualities skol_info tc_bndrs $ tcHsContext ctxt@@ -2917,8 +2927,7 @@ ; res_kind <- zonkTcTypeToTypeX ze res_kind ; tycon <- fixM $ \ rec_tycon -> do- { data_cons <- tcConDecls new_or_data DDataType rec_tycon- tc_bndrs res_kind cons+ { data_cons <- tcConDecls DDataType rec_tycon tc_bndrs res_kind cons ; tc_rhs <- mk_tc_rhs hsc_src rec_tycon data_cons ; tc_rep_nm <- newTyConRepName tc_name @@ -2942,7 +2951,7 @@ ; return (tycon, [deriv_info]) } where skol_info = TyConSkol flav tc_name- flav = newOrDataToFlavour new_or_data+ flav = newOrDataToFlavour (dataDefnConsNewOrData cons) -- Abstract data types in hsig files can have arbitrary kinds, -- because they may be implemented by type synonyms@@ -2952,23 +2961,21 @@ -- so one could not have, say, a data family instance in an hsig file that -- has kind `Bool`. Therefore, this check need only occur in the code that -- typechecks data type declarations.- mk_permissive_kind HsigFile [] = True+ mk_permissive_kind HsigFile (DataTypeCons _ []) = True mk_permissive_kind _ _ = False -- In an hs-boot or a signature file, -- a 'data' declaration with no constructors -- indicates a nominally distinct abstract data type.- mk_tc_rhs (isHsBootOrSig -> True) _ []+ mk_tc_rhs (isHsBootOrSig -> True) _ (DataTypeCons _ []) = return AbstractTyCon - mk_tc_rhs _ tycon data_cons- = case new_or_data of- DataType -> return $+ mk_tc_rhs _ tycon data_cons = case data_cons of+ DataTypeCons _ data_cons -> return $ mkLevPolyDataTyConRhs (isFixedRuntimeRepKind (tyConResKind tycon)) data_cons- NewType -> assert (not (null data_cons)) $- mkNewTyConRhs tc_name tycon (head data_cons)+ NewTypeCon data_con -> mkNewTyConRhs tc_name tycon data_con ------------------------- kcTyFamInstEqn :: TcTyCon -> LTyFamInstEqn GhcRn -> TcM ()@@ -3084,7 +3091,7 @@ So, we use bindOuterFamEqnTKBndrs (which does not create an implication for the telescope), and generalise over /all/ the variables in the LHS,-without treating the explicitly-quantifed ones specially. Wrinkles:+without treating the explicitly-quantified ones specially. Wrinkles: - When generalising, include the explicit user-specified forall'd variables, so that we get an error from Validity.checkFamPatBinders@@ -3311,26 +3318,20 @@ ************************************************************************ -} -dataDeclChecks :: Name -> NewOrData- -> Maybe (LHsContext GhcRn) -> [LConDecl GhcRn]+dataDeclChecks :: Name+ -> Maybe (LHsContext GhcRn) -> DataDefnCons (LConDecl GhcRn) -> TcM Bool-dataDeclChecks tc_name new_or_data mctxt cons+dataDeclChecks tc_name mctxt cons = do { let stupid_theta = fromMaybeContext mctxt -- Check that we don't use GADT syntax in H98 world ; gadtSyntax_ok <- xoptM LangExt.GADTSyntax- ; let gadt_syntax = consUseGadtSyntax cons+ ; let gadt_syntax = anyLConIsGadt cons ; checkTc (gadtSyntax_ok || not gadt_syntax) (badGadtDecl tc_name) -- Check that the stupid theta is empty for a GADT-style declaration. -- See Note [The stupid context] in GHC.Core.DataCon. ; checkTc (null stupid_theta || not gadt_syntax) (badStupidTheta tc_name) - -- Check that a newtype has exactly one constructor- -- Do this before checking for empty data decls, so that- -- we don't suggest -XEmptyDataDecls for newtypes- ; checkTc (new_or_data == DataType || isSingleton cons)- (newtypeConError tc_name (length cons))- -- Check that there's at least one condecl, -- or else we're reading an hs-boot file, or -XEmptyDataDecls ; empty_data_decls <- xoptM LangExt.EmptyDataDecls@@ -3341,12 +3342,6 @@ ------------------------------------consUseGadtSyntax :: [LConDecl GhcRn] -> Bool-consUseGadtSyntax (L _ (ConDeclGADT {}) : _) = True-consUseGadtSyntax _ = False- -- All constructors have same shape------------------------------------- data DataDeclInfo = DDataType -- data T a b = T1 a | T2 b | DDataInstance -- data instance D [a] = D1 a | D2@@ -3359,19 +3354,30 @@ mkTyVarTys (binderVars tc_bndrs) DDataInstance header_ty -> header_ty -tcConDecls :: NewOrData- -> DataDeclInfo+-- We use `concatMapDataDefnConsTcM` here, since the following is illegal:+-- @newtype T a where T1, T2 :: a -> T a@+-- It would be represented as a single 'ConDeclGadt' with multiple names, which is valid for 'data', but not 'newtype'.+-- So when 'tcConDecl' expands the 'ConDecl' per each name it has, if we are type-checking a 'newtype' declaration, we+-- must fail if it returns more than one.+tcConDecls :: DataDeclInfo -> KnotTied TyCon -- Representation TyCon -> [TcTyConBinder] -- Binders of representation TyCon -> TcKind -- Result kind- -> [LConDecl GhcRn] -> TcM [DataCon]-tcConDecls new_or_data dd_info rep_tycon tmpl_bndrs res_kind- = concatMapM $ addLocMA $- tcConDecl new_or_data dd_info rep_tycon tmpl_bndrs res_kind- (mkTyConTagMap rep_tycon)+ -> DataDefnCons (LConDecl GhcRn) -> TcM (DataDefnCons DataCon)+tcConDecls dd_info rep_tycon tmpl_bndrs res_kind+ = concatMapDataDefnConsTcM (tyConName rep_tycon) $ \ new_or_data ->+ addLocMA $ tcConDecl new_or_data dd_info rep_tycon tmpl_bndrs res_kind (mkTyConTagMap rep_tycon) -- mkTyConTagMap: it's important that we pay for tag allocation here, -- once per TyCon. See Note [Constructor tag allocation], fixes #14657 +-- 'concatMap' for 'DataDefnCons', but fail if the given function returns multiple values and the argument is a 'NewTypeCon'.+concatMapDataDefnConsTcM :: Name -> (NewOrData -> a -> TcM (NonEmpty b)) -> DataDefnCons a -> TcM (DataDefnCons b)+concatMapDataDefnConsTcM name f = \ case+ NewTypeCon a -> f NewType a >>= \ case+ b:|[] -> pure (NewTypeCon b)+ bs -> failWithTc $ newtypeConError name (length bs)+ DataTypeCons is_type_data as -> DataTypeCons is_type_data <$> concatMapM (fmap toList . f DataType) as+ tcConDecl :: NewOrData -> DataDeclInfo -> KnotTied TyCon -- Representation tycon. Knot-tied!@@ -3379,14 +3385,14 @@ -> TcKind -- Result kind -> NameEnv ConTag -> ConDecl GhcRn- -> TcM [DataCon]+ -> TcM (NonEmpty DataCon) tcConDecl new_or_data dd_info rep_tycon tc_bndrs res_kind tag_map (ConDeclH98 { con_name = lname@(L _ name) , con_ex_tvs = explicit_tkv_nms , con_mb_cxt = hs_ctxt , con_args = hs_args })- = addErrCtxt (dataConCtxt [lname]) $+ = addErrCtxt (dataConCtxt (NE.singleton lname)) $ do { -- NB: the tyvars from the declaration header are in scope -- Get hold of the existential type variables@@ -3474,7 +3480,7 @@ -- constructor type signature into the data constructor; -- that way checkValidDataCon can complain if it's wrong. - ; return [dc] }+ ; return (NE.singleton dc) } tcConDecl new_or_data dd_info rep_tycon tc_bndrs _res_kind tag_map -- NB: don't use res_kind here, as it's ill-scoped. Instead,@@ -3485,7 +3491,7 @@ , con_res_ty = hs_res_ty }) = addErrCtxt (dataConCtxt names) $ do { traceTc "tcConDecl 1 gadt" (ppr names)- ; let (L _ name : _) = names+ ; let L _ name :| _ = names ; skol_info <- mkSkolemInfo (DataConSkol name) ; (tclvl, wanted, (outer_bndrs, (ctxt, arg_tys, res_ty, field_lbls, stricts))) <- pushLevelAndSolveEqualitiesX "tcConDecl:GADT" $@@ -4237,7 +4243,7 @@ ; ClosedSynFamilyTyCon Nothing -> return () ; AbstractClosedSynFamilyTyCon -> do { hsBoot <- tcIsHsBootOrSig- ; checkTc hsBoot $ TcRnUnknownMessage $ mkPlainError noHints $+ ; checkTc hsBoot $ mkTcRnUnknownMessage $ mkPlainError noHints $ text "You may define an abstract closed type family" $$ text "only in a .hs-boot file" } ; DataFamilyTyCon {} -> return ()@@ -4315,7 +4321,7 @@ checkPartialRecordField all_cons fld = setSrcSpan loc $ warnIf (not is_exhaustive && not (startsWithUnderscore occ_name))- (TcRnUnknownMessage $ mkPlainDiagnostic (WarningWithFlag Opt_WarnPartialFields) noHints $+ (mkTcRnUnknownMessage $ mkPlainDiagnostic (WarningWithFlag Opt_WarnPartialFields) noHints $ sep [text "Use of partial record field selector" <> colon, nest 2 $ quotes (ppr occ_name)]) where@@ -4344,7 +4350,7 @@ checkValidDataCon :: DynFlags -> Bool -> TyCon -> DataCon -> TcM () checkValidDataCon dflags existential_ok tc con = setSrcSpan con_loc $- addErrCtxt (dataConCtxt [L (noAnnSrcSpan con_loc) con_name]) $+ addErrCtxt (dataConCtxt (NE.singleton (L (noAnnSrcSpan con_loc) con_name))) $ do { let tc_tvs = tyConTyVars tc res_ty_tmpl = mkFamilyTyConApp tc (mkTyVarTys tc_tvs) arg_tys = dataConOrigArgTys con@@ -4418,6 +4424,14 @@ ; checkTc (existential_ok || isVanillaDataCon con) (badExistential con) + -- Check that the only constraints in signatures of constructors+ -- in a "type data" declaration are equality constraints.+ -- See Note [Type data declarations] in GHC.Rename.Module,+ -- restriction (R4).+ ; when (isTypeDataCon con) $+ checkTc (all isEqPred (dataConOtherTheta con))+ (TcRnConstraintInKind (dataConRepType con))+ -- Check that UNPACK pragmas and bangs work out -- E.g. reject data T = MkT {-# UNPACK #-} Int -- No "!" -- data T = MkT {-# UNPACK #-} !a -- Can't unpack@@ -4426,13 +4440,13 @@ check_bang orig_arg_ty bang rep_bang n | HsSrcBang _ _ SrcLazy <- bang , not (bang_opt_strict_data bang_opts)- = addErrTc $ TcRnUnknownMessage $ mkPlainError noHints $+ = addErrTc $ mkTcRnUnknownMessage $ mkPlainError noHints $ (bad_bang n (text "Lazy annotation (~) without StrictData")) | HsSrcBang _ want_unpack strict_mark <- bang , isSrcUnpacked want_unpack, not (is_strict strict_mark) , not (isUnliftedType orig_arg_ty)- = addDiagnosticTc $ TcRnUnknownMessage $+ = addDiagnosticTc $ mkTcRnUnknownMessage $ mkPlainDiagnostic WarningWithoutFlag noHints (bad_bang n (text "UNPACK pragma lacks '!'")) -- Warn about a redundant ! on an unlifted type@@ -4461,7 +4475,7 @@ -- warn in this case (it gives users the wrong idea about whether -- or not UNPACK on abstract types is supported; it is!) , isHomeUnitDefinite (hsc_home_unit hsc_env)- = addDiagnosticTc $ TcRnUnknownMessage $+ = addDiagnosticTc $ mkTcRnUnknownMessage $ mkPlainDiagnostic WarningWithoutFlag noHints (bad_bang n (text "Ignoring unusable UNPACK pragma")) | otherwise@@ -4523,18 +4537,18 @@ ; unlifted_newtypes <- xoptM LangExt.UnliftedNewtypes ; let allowedArgType = unlifted_newtypes || typeLevity_maybe (scaledThing arg_ty1) == Just Lifted- ; checkTc allowedArgType $ TcRnUnknownMessage $ mkPlainError noHints $ vcat+ ; checkTc allowedArgType $ mkTcRnUnknownMessage $ mkPlainError noHints $ vcat [ text "A newtype cannot have an unlifted argument type" , text "Perhaps you intended to use UnliftedNewtypes" ] ; show_linear_types <- xopt LangExt.LinearTypes <$> getDynFlags ; let check_con what msg =- checkTc what $ TcRnUnknownMessage $ mkPlainError noHints $+ checkTc what $ mkTcRnUnknownMessage $ mkPlainError noHints $ (msg $$ ppr con <+> dcolon <+> ppr (dataConDisplayType show_linear_types con)) ; checkTc (ok_mult (scaledMult arg_ty1)) $- TcRnUnknownMessage $ mkPlainError noHints $ text "A newtype constructor must be linear"+ mkTcRnUnknownMessage $ mkPlainError noHints $ text "A newtype constructor must be linear" ; check_con (null eq_spec) $ text "A newtype constructor must have a return type of form T a1 ... an"@@ -4565,7 +4579,7 @@ ok_mult _ = False --- | Reject nullary data constructors where a type variables+-- | Reject nullary data constructors where a type variable -- would escape through the result kind -- See Note [Check for escaping result kind] checkEscapingKind :: DataCon -> TcM ()@@ -4630,7 +4644,7 @@ ; unless undecidable_super_classes $ case checkClassCycles cls of Just err -> setSrcSpan (getSrcSpan cls) $- addErrTc (TcRnUnknownMessage $ mkPlainError noHints err)+ addErrTc (mkTcRnUnknownMessage $ mkPlainError noHints err) Nothing -> return () -- Check the class operations.@@ -4773,7 +4787,7 @@ -- default foo2 :: a -> b unless (isJust $ tcMatchTys [dm_phi_ty, vanilla_phi_ty] [vanilla_phi_ty, dm_phi_ty]) $ addErrTc $- TcRnUnknownMessage $ mkPlainError noHints $+ mkTcRnUnknownMessage $ mkPlainError noHints $ hang (text "The default type signature for" <+> ppr sel_id <> colon) 2 (ppr dm_ty)@@ -4793,14 +4807,14 @@ ; checkTc idx_tys err_msg } where err_msg :: TcRnMessage- err_msg = TcRnUnknownMessage $ mkPlainError noHints $+ err_msg = mkTcRnUnknownMessage $ mkPlainError noHints $ hang (text "Illegal family declaration for" <+> quotes (ppr tc_name)) 2 (text "Enable TypeFamilies to allow indexed type families") checkResultSigFlag :: Name -> FamilyResultSig GhcRn -> TcM () checkResultSigFlag tc_name (TyVarSig _ tvb) = do { ty_fam_deps <- xoptM LangExt.TypeFamilyDependencies- ; checkTc ty_fam_deps $ TcRnUnknownMessage $ mkPlainError noHints $+ ; checkTc ty_fam_deps $ mkTcRnUnknownMessage $ mkPlainError noHints $ hang (text "Illegal result type variable" <+> ppr tvb <+> text "for" <+> quotes (ppr tc_name)) 2 (text "Enable TypeFamilyDependencies to allow result variable names") } checkResultSigFlag _ _ = return () -- other cases OK@@ -5143,7 +5157,7 @@ check_ty_roles env role ty report_error doc- = addErrTc $ TcRnUnknownMessage $ mkPlainError noHints $+ = addErrTc $ mkTcRnUnknownMessage $ mkPlainError noHints $ vcat [text "Internal error in role inference:", doc, text "Please report this as a GHC bug: https://www.haskell.org/ghc/reportabug"]@@ -5227,24 +5241,24 @@ resultTypeMisMatch :: FieldLabelString -> DataCon -> DataCon -> TcRnMessage resultTypeMisMatch field_name con1 con2- = TcRnUnknownMessage $ mkPlainError noHints $+ = mkTcRnUnknownMessage $ mkPlainError noHints $ vcat [sep [text "Constructors" <+> ppr con1 <+> text "and" <+> ppr con2, text "have a common field" <+> quotes (ppr field_name) <> comma], nest 2 $ text "but have different result types"] fieldTypeMisMatch :: FieldLabelString -> DataCon -> DataCon -> TcRnMessage fieldTypeMisMatch field_name con1 con2- = TcRnUnknownMessage $ mkPlainError noHints $+ = mkTcRnUnknownMessage $ mkPlainError noHints $ sep [text "Constructors" <+> ppr con1 <+> text "and" <+> ppr con2, text "give different types for field", quotes (ppr field_name)] -dataConCtxt :: [LocatedN Name] -> SDoc-dataConCtxt cons = text "In the definition of data constructor" <> plural cons- <+> ppr_cons cons+dataConCtxt :: NonEmpty (LocatedN Name) -> SDoc+dataConCtxt cons = text "In the definition of data constructor" <> plural (toList cons)+ <+> ppr_cons (toList cons) -dataConResCtxt :: [LocatedN Name] -> SDoc-dataConResCtxt cons = text "In the result type of data constructor" <> plural cons- <+> ppr_cons cons+dataConResCtxt :: NonEmpty (LocatedN Name) -> SDoc+dataConResCtxt cons = text "In the result type of data constructor" <> plural (toList cons)+ <+> ppr_cons (toList cons) ppr_cons :: [LocatedN Name] -> SDoc ppr_cons [con] = quotes (ppr con)@@ -5259,20 +5273,20 @@ | n == 0 = mkErr "No" "no-parameter" | otherwise = mkErr "Too many" "multi-parameter" where- mkErr howMany allowWhat = TcRnUnknownMessage $ mkPlainError noHints $+ mkErr howMany allowWhat = mkTcRnUnknownMessage $ mkPlainError noHints $ vcat [text (howMany ++ " parameters for class") <+> quotes (ppr cls), parens (text ("Enable MultiParamTypeClasses to allow " ++ allowWhat ++ " classes"))] classFunDepsErr :: Class -> TcRnMessage classFunDepsErr cls- = TcRnUnknownMessage $ mkPlainError noHints $+ = mkTcRnUnknownMessage $ mkPlainError noHints $ vcat [text "Fundeps in class" <+> quotes (ppr cls), parens (text "Enable FunctionalDependencies to allow fundeps")] badMethPred :: Id -> TcPredType -> TcRnMessage badMethPred sel_id pred- = TcRnUnknownMessage $ mkPlainError noHints $+ = mkTcRnUnknownMessage $ mkPlainError noHints $ vcat [ hang (text "Constraint" <+> quotes (ppr pred) <+> text "in the type of" <+> quotes (ppr sel_id)) 2 (text "constrains only the class type variables")@@ -5280,14 +5294,14 @@ noClassTyVarErr :: Class -> TyCon -> TcRnMessage noClassTyVarErr clas fam_tc- = TcRnUnknownMessage $ mkPlainError noHints $+ = mkTcRnUnknownMessage $ mkPlainError noHints $ sep [ text "The associated type" <+> quotes (ppr fam_tc <+> hsep (map ppr (tyConTyVars fam_tc))) , text "mentions none of the type or kind variables of the class" <+> quotes (ppr clas <+> hsep (map ppr (classTyVars clas)))] badDataConTyCon :: DataCon -> Type -> TcRnMessage badDataConTyCon data_con res_ty_tmpl- = TcRnUnknownMessage $ mkPlainError noHints $+ = mkTcRnUnknownMessage $ mkPlainError noHints $ hang (text "Data constructor" <+> quotes (ppr data_con) <+> text "returns type" <+> quotes (ppr actual_res_ty)) 2 (text "instead of an instance of its parent type" <+> quotes (ppr res_ty_tmpl))@@ -5296,13 +5310,13 @@ badGadtDecl :: Name -> TcRnMessage badGadtDecl tc_name- = TcRnUnknownMessage $ mkPlainError noHints $+ = mkTcRnUnknownMessage $ mkPlainError noHints $ vcat [ text "Illegal generalised algebraic data declaration for" <+> quotes (ppr tc_name) , nest 2 (parens $ text "Enable the GADTs extension to allow this") ] badExistential :: DataCon -> TcRnMessage badExistential con- = TcRnUnknownMessage $ mkPlainError noHints $+ = mkTcRnUnknownMessage $ mkPlainError noHints $ sdocOption sdocLinearTypes (\show_linear_types -> hang (text "Data constructor" <+> quotes (ppr con) <+> text "has existential type variables, a context, or a specialised result type")@@ -5311,43 +5325,43 @@ badStupidTheta :: Name -> TcRnMessage badStupidTheta tc_name- = TcRnUnknownMessage $ mkPlainError noHints $+ = mkTcRnUnknownMessage $ mkPlainError noHints $ text "A data type declared in GADT style cannot have a context:" <+> quotes (ppr tc_name) newtypeConError :: Name -> Int -> TcRnMessage newtypeConError tycon n- = TcRnUnknownMessage $ mkPlainError noHints $+ = mkTcRnUnknownMessage $ mkPlainError noHints $ sep [text "A newtype must have exactly one constructor,", nest 2 $ text "but" <+> quotes (ppr tycon) <+> text "has" <+> speakN n ] newtypeStrictError :: DataCon -> TcRnMessage newtypeStrictError con- = TcRnUnknownMessage $ mkPlainError noHints $+ = mkTcRnUnknownMessage $ mkPlainError noHints $ sep [text "A newtype constructor cannot have a strictness annotation,", nest 2 $ text "but" <+> quotes (ppr con) <+> text "does"] newtypeFieldErr :: DataCon -> Int -> TcRnMessage newtypeFieldErr con_name n_flds- = TcRnUnknownMessage $ mkPlainError noHints $+ = mkTcRnUnknownMessage $ mkPlainError noHints $ sep [text "The constructor of a newtype must have exactly one field", nest 2 $ text "but" <+> quotes (ppr con_name) <+> text "has" <+> speakN n_flds] badSigTyDecl :: Name -> TcRnMessage badSigTyDecl tc_name- = TcRnUnknownMessage $ mkPlainError noHints $+ = mkTcRnUnknownMessage $ mkPlainError noHints $ vcat [ text "Illegal kind signature" <+> quotes (ppr tc_name) , nest 2 (parens $ text "Use KindSignatures to allow kind signatures") ] emptyConDeclsErr :: Name -> TcRnMessage emptyConDeclsErr tycon- = TcRnUnknownMessage $ mkPlainError noHints $+ = mkTcRnUnknownMessage $ mkPlainError noHints $ sep [quotes (ppr tycon) <+> text "has no constructors", nest 2 $ text "(EmptyDataDecls permits this)"] wrongKindOfFamily :: TyCon -> TcRnMessage wrongKindOfFamily family- = TcRnUnknownMessage $ mkPlainError noHints $+ = mkTcRnUnknownMessage $ mkPlainError noHints $ text "Wrong category of family instance; declaration was for a" <+> kindOfFamily where@@ -5360,13 +5374,13 @@ -- See Note [Oversaturated type family equations] in "GHC.Tc.Validity". wrongNumberOfParmsErr :: Arity -> TcRnMessage wrongNumberOfParmsErr max_args- = TcRnUnknownMessage $ mkPlainError noHints $+ = mkTcRnUnknownMessage $ mkPlainError noHints $ text "Number of parameters must match family declaration; expected" <+> ppr max_args badRoleAnnot :: Name -> Role -> Role -> TcRnMessage badRoleAnnot var annot inferred- = TcRnUnknownMessage $ mkPlainError noHints $+ = mkTcRnUnknownMessage $ mkPlainError noHints $ hang (text "Role mismatch on variable" <+> ppr var <> colon) 2 (sep [ text "Annotation says", ppr annot , text "but role", ppr inferred@@ -5374,7 +5388,7 @@ wrongNumberOfRoles :: [a] -> LRoleAnnotDecl GhcRn -> TcRnMessage wrongNumberOfRoles tyvars d@(L _ (RoleAnnotDecl _ _ annots))- = TcRnUnknownMessage $ mkPlainError noHints $+ = mkTcRnUnknownMessage $ mkPlainError noHints $ hang (text "Wrong number of roles listed in role annotation;" $$ text "Expected" <+> (ppr $ length tyvars) <> comma <+> text "got" <+> (ppr $ length annots) <> colon)@@ -5385,25 +5399,25 @@ illegalRoleAnnotDecl (L loc (RoleAnnotDecl _ tycon _)) = setErrCtxt [] $ setSrcSpanA loc $- addErrTc $ TcRnUnknownMessage $ mkPlainError noHints $+ addErrTc $ mkTcRnUnknownMessage $ mkPlainError noHints $ (text "Illegal role annotation for" <+> ppr tycon <> char ';' $$ text "they are allowed only for datatypes and classes.") needXRoleAnnotations :: TyCon -> TcRnMessage needXRoleAnnotations tc- = TcRnUnknownMessage $ mkPlainError noHints $+ = mkTcRnUnknownMessage $ mkPlainError noHints $ text "Illegal role annotation for" <+> ppr tc <> char ';' $$ text "did you intend to use RoleAnnotations?" incoherentRoles :: TcRnMessage-incoherentRoles = TcRnUnknownMessage $ mkPlainError noHints $+incoherentRoles = mkTcRnUnknownMessage $ mkPlainError noHints $ (text "Roles other than" <+> quotes (text "nominal") <+> text "for class parameters can lead to incoherence.") $$ (text "Use IncoherentInstances to allow this; bad role found") wrongTyFamName :: Name -> Name -> TcRnMessage wrongTyFamName fam_tc_name eqn_tc_name- = TcRnUnknownMessage $ mkPlainError noHints $+ = mkTcRnUnknownMessage $ mkPlainError noHints $ hang (text "Mismatched type name in type family instance.") 2 (vcat [ text "Expected:" <+> ppr fam_tc_name , text " Actual:" <+> ppr eqn_tc_name ])
compiler/GHC/Tc/TyCl/Class.hs view
@@ -99,7 +99,7 @@ newtype CDict a = CDict (forall b. a -> b -> b) -Now DictTy in Type is just a form of type synomym:+Now DictTy in Type is just a form of type synonym: DictTy c t = TyConTy CDict `AppTy` t Death to "ExpandingDicts".
compiler/GHC/Tc/TyCl/Instance.hs view
@@ -79,7 +79,6 @@ import GHC.Types.Name.Set import GHC.Utils.Outputable import GHC.Utils.Panic-import GHC.Utils.Panic.Plain import GHC.Types.SrcLoc import GHC.Utils.Misc import GHC.Data.BooleanFormula ( isUnsatisfied, pprBooleanFormulaNice )@@ -176,7 +175,7 @@ inline df_i in it, and that in turn means that (since it'll be a loop-breaker because df_i isn't), op1_i will ironically never be inlined. But this is OK: the recursion breaking happens by way of- a RULE (the magic ClassOp rule above), and RULES work inside InlineRule+ a RULE (the magic ClassOp rule above), and RULES work inside stable unfoldings. See Note [RULEs enabled in InitialPhase] in GHC.Core.Opt.Simplify.Utils Note [ClassOp/DFun selection]@@ -674,8 +673,7 @@ , feqn_pats = hs_pats , feqn_tycon = lfam_name@(L _ fam_name) , feqn_fixity = fixity- , feqn_rhs = HsDataDefn { dd_ND = new_or_data- , dd_cType = cType+ , feqn_rhs = HsDataDefn { dd_cType = cType , dd_ctxt = hs_ctxt , dd_cons = hs_cons , dd_kindSig = m_ksig@@ -688,10 +686,11 @@ -- Check that the family declaration is for the right kind ; checkTc (isDataFamilyTyCon fam_tc) (wrongKindOfFamily fam_tc)- ; gadt_syntax <- dataDeclChecks fam_name new_or_data hs_ctxt hs_cons+ ; gadt_syntax <- dataDeclChecks fam_name hs_ctxt hs_cons -- Do /not/ check that the number of patterns = tyConArity fam_tc -- See [Arity of data families] in GHC.Core.FamInstEnv ; skol_info <- mkSkolemInfo FamInstSkol+ ; let new_or_data = dataDefnConsNewOrData hs_cons ; (qtvs, pats, tc_res_kind, stupid_theta) <- tcDataFamInstHeader mb_clsinfo skol_info fam_tc outer_bndrs fixity hs_ctxt hs_pats m_ksig new_or_data@@ -767,19 +766,17 @@ do { data_cons <- tcExtendTyVarEnv (binderVars tc_ty_binders) $ -- For H98 decls, the tyvars scope -- over the data constructors- tcConDecls new_or_data (DDataInstance orig_res_ty)- rec_rep_tc tc_ty_binders tc_res_kind- hs_cons+ tcConDecls (DDataInstance orig_res_ty) rec_rep_tc tc_ty_binders tc_res_kind+ hs_cons ; rep_tc_name <- newFamInstTyConName lfam_name pats ; axiom_name <- newFamInstAxiomName lfam_name [pats]- ; tc_rhs <- case new_or_data of- DataType -> return $+ ; tc_rhs <- case data_cons of+ DataTypeCons _ data_cons -> return $ mkLevPolyDataTyConRhs (isFixedRuntimeRepKind res_kind) data_cons- NewType -> assert (not (null data_cons)) $- mkNewTyConRhs rep_tc_name rec_rep_tc (head data_cons)+ NewTypeCon data_con -> mkNewTyConRhs rep_tc_name rec_rep_tc data_con ; let ax_rhs = mkTyConApp rep_tc (mkTyVarTys zonked_post_eta_qtvs) axiom = mkSingleCoAxiom Representational axiom_name@@ -893,7 +890,6 @@ -> NewOrData -> TcM ([TcTyVar], [TcType], TcKind, TcThetaType) -- All skolem TcTyVars, all zonked so it's clear what the free vars are- -- The "header" of a data family instance is the part other than -- the data constructors themselves -- e.g. data instance D [a] :: * -> * where ...@@ -1099,7 +1095,7 @@ Now the subtleties of Note [Newtype eta and homogeneous axioms] are dealt with by the newtype (via mkNewTyConRhs called in tcDataFamInstDecl) while the axiom connecting F Int ~ R:FIntb is eta-reduced, but the- quantifer 'b' is derived from the original data family F, and so the+ quantifier 'b' is derived from the original data family F, and so the kinds will always match. Note [Kind inference for data family instances]@@ -1132,7 +1128,7 @@ So what kind do 'p' and 'q' have? No clues from the header, but from the data constructor we can clearly see that (r :: Type->Type). Does-that mean that the the /entire data instance/ is instantiated at Type,+that mean that the /entire data instance/ is instantiated at Type, like this? data instance T @Type (p :: Type->Type) (q :: Type) where ...@@ -1353,7 +1349,7 @@ -- is messing with. addDFunPrags dfun_id sc_meth_ids | is_newtype- = dfun_id `setIdUnfolding` mkInlineUnfoldingWithArity 0 defaultSimpleOpts con_app+ = dfun_id `setIdUnfolding` mkInlineUnfoldingWithArity defaultSimpleOpts StableSystemSrc 0 con_app `setInlinePragma` alwaysInlinePragma { inl_sat = Just 0 } | otherwise = dfun_id `setIdUnfolding` mkDFunUnfolding dfun_bndrs dict_con dict_args@@ -2030,7 +2026,7 @@ misplacedInstSig :: Name -> LHsSigType GhcRn -> TcRnMessage misplacedInstSig name hs_ty- = TcRnUnknownMessage $ mkPlainError noHints $+ = mkTcRnUnknownMessage $ mkPlainError noHints $ vcat [ hang (text "Illegal type signature in instance declaration:") 2 (hang (pprPrefixName name) 2 (dcolon <+> ppr hs_ty))@@ -2050,7 +2046,7 @@ class method (in this case: Age -> Age -> Bool), but it cannot be less polymorphic. Moreover, if a signature is given, the implementation code should match the signature, and type variables bound in the-singature should scope over the method body.+signature should scope over the method body. We achieve this by building a TcSigInfo for the method, whether or not there is an instance method signature, and using that to typecheck@@ -2158,7 +2154,7 @@ warnUnsatisfiedMinimalDefinition :: ClassMinimalDef -> TcM () warnUnsatisfiedMinimalDefinition mindef = do { warn <- woptM Opt_WarnMissingMethods- ; let msg = TcRnUnknownMessage $+ ; let msg = mkTcRnUnknownMessage $ mkPlainDiagnostic (WarningWithFlag Opt_WarnMissingMethods) noHints message ; diagnosticTc warn msg }@@ -2381,28 +2377,28 @@ badBootFamInstDeclErr :: TcRnMessage badBootFamInstDeclErr- = TcRnUnknownMessage $ mkPlainError noHints $ text "Illegal family instance in hs-boot file"+ = mkTcRnUnknownMessage $ mkPlainError noHints $ text "Illegal family instance in hs-boot file" notFamily :: TyCon -> TcRnMessage notFamily tycon- = TcRnUnknownMessage $ mkPlainError noHints $+ = mkTcRnUnknownMessage $ mkPlainError noHints $ vcat [ text "Illegal family instance for" <+> quotes (ppr tycon) , nest 2 $ parens (ppr tycon <+> text "is not an indexed type family")] assocInClassErr :: TyCon -> TcRnMessage assocInClassErr name- = TcRnUnknownMessage $ mkPlainError noHints $+ = mkTcRnUnknownMessage $ mkPlainError noHints $ text "Associated type" <+> quotes (ppr name) <+> text "must be inside a class instance" badFamInstDecl :: TyCon -> TcRnMessage badFamInstDecl tc_name- = TcRnUnknownMessage $ mkPlainError noHints $+ = mkTcRnUnknownMessage $ mkPlainError noHints $ vcat [ text "Illegal family instance for" <+> quotes (ppr tc_name) , nest 2 (parens $ text "Use TypeFamilies to allow indexed type families") ] notOpenFamily :: TyCon -> TcRnMessage notOpenFamily tc- = TcRnUnknownMessage $ mkPlainError noHints $+ = mkTcRnUnknownMessage $ mkPlainError noHints $ text "Illegal instance for closed family" <+> quotes (ppr tc)
compiler/GHC/Tc/TyCl/PatSyn.hs view
@@ -126,7 +126,7 @@ ones; because pattern synonyms are top-level things, we will never solve them later if we can't solve them now. And if we were to carry on, tc_patsyn_finish does zonkTcTypeToType, which defaults any-unsolved unificatdion variables to Any, which confuses the error+unsolved unification variables to Any, which confuses the error reporting no end (#15685). So we use simplifyTop to completely solve the constraint, report@@ -241,7 +241,7 @@ -- See Note [Coercions that escape] dependentArgErr (arg, bad_cos) = failWithTc $ -- fail here: otherwise we get downstream errors- TcRnUnknownMessage $ mkPlainError noHints $+ mkTcRnUnknownMessage $ mkPlainError noHints $ vcat [ text "Iceland Jack! Iceland Jack! Stop torturing me!" , hang (text "Pattern-bound variable") 2 (ppr arg <+> dcolon <+> ppr (idType arg))@@ -276,7 +276,7 @@ can't go in the inner forall either. (What would the matcher apply the continuation to?) -Solution: do not quantiify over any unification variable whose kind+Solution: do not quantify over any unification variable whose kind mentions the existentials. We can conveniently do that by making the "taus" passed to simplifyInfer look like forall ex_tvs. arg_ty@@ -326,7 +326,7 @@ and is not implicitly instantiated. So in mkProvEvidence we lift (a ~# b) to (a ~ b). Tiresome, and-marginally less efficient, if the builder/martcher are not inlined.+marginally less efficient, if the builder/matcher are not inlined. See also Note [Lift equality constraints when quantifying] in GHC.Tc.Solver @@ -406,7 +406,7 @@ -- The existential 'x' should not appear in the result type -- Can't check this until we know P's arity (decl_arity above) ; let bad_tvs = filter (`elemVarSet` tyCoVarsOfType pat_ty) $ binderVars explicit_ex_bndrs- ; checkTc (null bad_tvs) $ TcRnUnknownMessage $ mkPlainError noHints $+ ; checkTc (null bad_tvs) $ mkTcRnUnknownMessage $ mkPlainError noHints $ hang (sep [ text "The result type of the signature for" <+> quotes (ppr name) <> comma , text "namely" <+> quotes (ppr pat_ty) ]) 2 (text "mentions existential type variable" <> plural bad_tvs@@ -680,7 +680,7 @@ wrongNumberOfParmsErr :: Name -> Arity -> Arity -> TcM a wrongNumberOfParmsErr name decl_arity missing- = failWithTc $ TcRnUnknownMessage $ mkPlainError noHints $+ = failWithTc $ mkTcRnUnknownMessage $ mkPlainError noHints $ hang (text "Pattern synonym" <+> quotes (ppr name) <+> text "has" <+> speakNOf decl_arity (text "argument")) 2 (text "but its type signature has" <+> int missing <+> text "fewer arrows")@@ -922,7 +922,7 @@ = return emptyBag | Left why <- mb_match_group -- Can't invert the pattern- = setSrcSpan (getLocA lpat) $ failWithTc $ TcRnUnknownMessage $ mkPlainError noHints $+ = setSrcSpan (getLocA lpat) $ failWithTc $ mkTcRnUnknownMessage $ mkPlainError noHints $ vcat [ hang (text "Invalid right-hand side of bidirectional pattern synonym" <+> quotes (ppr ps_name) <> colon) 2 why
compiler/GHC/Tc/TyCl/Utils.hs view
@@ -172,7 +172,7 @@ -- TODO: TyConSet is implemented as IntMap over uniques. -- But we could get away with something based on IntSet--- since we only check membershib, but never extract the+-- since we only check membership, but never extract the -- elements. type SynCycleState = TyConSet @@ -208,7 +208,7 @@ checkSynCycles :: Unit -> [TyCon] -> [LTyClDecl GhcRn] -> TcM () checkSynCycles this_uid tcs tyclds = case runSynCycleM (mapM_ (go emptyTyConSet []) tcs) emptyTyConSet of- Left (loc, err) -> setSrcSpan loc $ failWithTc (TcRnUnknownMessage $ mkPlainError noHints err)+ Left (loc, err) -> setSrcSpan loc $ failWithTc (mkTcRnUnknownMessage $ mkPlainError noHints err) Right _ -> return () where -- Try our best to print the LTyClDecl for locally defined things
compiler/GHC/Tc/Utils/Backpack.hs view
@@ -90,9 +90,10 @@ import {-# SOURCE #-} GHC.Tc.Module + fixityMisMatch :: TyThing -> Fixity -> Fixity -> TcRnMessage fixityMisMatch real_thing real_fixity sig_fixity =- TcRnUnknownMessage $ mkPlainError noHints $+ mkTcRnUnknownMessage $ mkPlainError noHints $ vcat [ppr real_thing <+> text "has conflicting fixities in the module", text "and its hsig file", text "Main module:" <+> ppr_fix real_fixity,@@ -169,7 +170,7 @@ -- tcg_env (TODO: but maybe this isn't relevant anymore). r <- tcLookupImported_maybe name case r of- Failed err -> addErr (TcRnUnknownMessage $ mkPlainError noHints err)+ Failed err -> addErr (mkTcRnUnknownMessage $ mkPlainError noHints err) Succeeded real_thing -> checkHsigDeclM sig_iface sig_thing real_thing -- The hsig did NOT define this function; that means it must@@ -687,7 +688,7 @@ -- 3(d). Extend the name substitution (performing shaping) mb_r <- extend_ns nsubst as2 case mb_r of- Left err -> failWithTc (TcRnUnknownMessage $ mkPlainError noHints err)+ Left err -> failWithTc (mkTcRnUnknownMessage $ mkPlainError noHints err) Right nsubst' -> return (nsubst',oks',(imod, thinned_iface):ifaces) nsubst0 = mkNameShape (moduleName inner_mod) (mi_exports lcl_iface0) ok_to_use0 = mkOccSet (exportOccs (mi_exports lcl_iface0))@@ -994,7 +995,7 @@ isig_mod sig_mod NotBoot isig_iface <- case mb_isig_iface of Succeeded (iface, _) -> return iface- Failed err -> failWithTc $ TcRnUnknownMessage $ mkPlainError noHints $+ Failed err -> failWithTc $ mkTcRnUnknownMessage $ mkPlainError noHints $ hang (text "Could not find hi interface for signature" <+> quotes (ppr isig_mod) <> colon) 4 err @@ -1002,7 +1003,7 @@ -- we need. (Notice we IGNORE the Modules in the AvailInfos.) forM_ (exportOccs (mi_exports isig_iface)) $ \occ -> case lookupGlobalRdrEnv impl_gr occ of- [] -> addErr $ TcRnUnknownMessage $ mkPlainError noHints $+ [] -> addErr $ mkTcRnUnknownMessage $ mkPlainError noHints $ quotes (ppr occ) <+> text "is exported by the hsig file, but not exported by the implementing module" <+> quotes (pprWithUnitState unit_state $ ppr impl_mod)
compiler/GHC/Tc/Utils/Env.hs view
@@ -257,7 +257,7 @@ do { mb_thing <- tcLookupImported_maybe name ; case mb_thing of Succeeded thing -> return thing- Failed msg -> failWithTc (TcRnUnknownMessage $ mkPlainError noHints msg)+ Failed msg -> failWithTc (mkTcRnUnknownMessage $ mkPlainError noHints msg) }}} -- Look up only in this module's global env't. Don't look in imports, etc.@@ -328,11 +328,11 @@ = do { instEnv <- tcGetInstEnvs ; case lookupUniqueInstEnv instEnv cls tys of Left err ->- failWithTc $ TcRnUnknownMessage+ failWithTc $ mkTcRnUnknownMessage $ mkPlainError noHints (text "Couldn't match instance:" <+> err) Right (inst, tys) | uniqueTyVars tys -> return inst- | otherwise -> failWithTc (TcRnUnknownMessage $ mkPlainError noHints errNotExact)+ | otherwise -> failWithTc (mkTcRnUnknownMessage $ mkPlainError noHints errNotExact) } where errNotExact = text "Not an exact match (i.e., some variables get instantiated)"@@ -853,7 +853,7 @@ It is entirely reasonable to reject this, but to do so we need A to be in the kind environment when kind-checking the signature for B. -Hence tcAddPatSynPlaceholers adds a binding+Hence tcAddPatSynPlaceholders adds a binding A -> APromotionErr PatSynPE to the environment. Then GHC.Tc.Gen.HsType.tcTyVar will find A in the kind environment, and will give a 'wrongThingErr' as a result. But the@@ -899,7 +899,7 @@ | otherwise -- Badly staged = failWithTc $ -- E.g. \x -> $(f x)- TcRnUnknownMessage $ mkPlainError noHints $+ mkTcRnUnknownMessage $ mkPlainError noHints $ text "Stage error:" <+> pp_thing <+> hsep [text "is bound at stage" <+> ppr bind_lvl, text "but used at stage" <+> ppr use_lvl]@@ -907,7 +907,7 @@ stageRestrictionError :: SDoc -> TcM a stageRestrictionError pp_thing = failWithTc $- TcRnUnknownMessage $ mkPlainError noHints $+ mkTcRnUnknownMessage $ mkPlainError noHints $ sep [ text "GHC stage restriction:" , nest 2 (vcat [ pp_thing <+> text "is used in a top-level splice, quasi-quote, or annotation," , text "and must be imported, not defined locally"])]@@ -961,7 +961,7 @@ -- User-supplied defaults Nothing -> do - -- No use-supplied default+ -- No user-supplied default -- Use [Integer, Double], plus modifications { integer_ty <- tcMetaTy integerTyConName ; list_ty <- tcMetaTy listTyConName@@ -1175,7 +1175,7 @@ -- don't report it again (#11941) | otherwise -> stageRestrictionError (quotes (ppr name)) _ -> failWithTc $- TcRnUnknownMessage $ mkPlainError noHints $+ mkTcRnUnknownMessage $ mkPlainError noHints $ vcat[text "GHC internal error:" <+> quotes (ppr name) <+> text "is not in scope during type checking, but it passed the renamer", text "tcl_env of environment:" <+> ppr (tcl_env lcl_env)]@@ -1188,7 +1188,7 @@ wrongThingErr :: String -> TcTyThing -> Name -> TcM a wrongThingErr expected thing name- = let msg = TcRnUnknownMessage $ mkPlainError noHints $+ = let msg = mkTcRnUnknownMessage $ mkPlainError noHints $ (pprTcTyThingCategory thing <+> quotes (ppr name) <+> text "used as a" <+> text expected) in failWithTc msg
compiler/GHC/Tc/Utils/Instantiate.hs view
@@ -219,7 +219,7 @@ instantiateSigma :: CtOrigin -> [TyVar] -> TcThetaType -> TcSigmaType -> TcM ([TcTyVar], HsWrapper, TcSigmaType) -- (instantiate orig tvs theta ty)--- instantiates the the type variables tvs, emits the (instantiated)+-- instantiates the type variables tvs, emits the (instantiated) -- constraints theta, and returns the (instantiated) type ty instantiateSigma orig tvs theta body_ty = do { (subst, inst_tvs) <- mapAccumLM newMetaTyVarX empty_subst tvs@@ -247,7 +247,7 @@ -- types [ta, tb, tc], but when the kinds of 'a' and 'ta' might -- not yet match (perhaps because there are unsolved constraints; #14154) -- If they don't match, emit a kind-equality to promise that they will--- eventually do so, and thus make a kind-homongeneous substitution.+-- eventually do so, and thus make a kind-homogeneous substitution. instTyVarsWith orig tvs tys = go emptySubst tvs tys where@@ -669,7 +669,7 @@ from old variables to the new variables, then instantiate the type variables substituting the original kind. -Exemple: If we want to instantiate+Example: If we want to instantiate [(k1 :: *), (k2 :: *), (a :: k1 -> k2), (b :: k1)] we want [(?k1 :: *), (?k2 :: *), (?a :: ?k1 -> ?k2), (?b :: ?k1)]
compiler/GHC/Tc/Utils/Monad.hs view
@@ -1191,7 +1191,7 @@ This reliance on delicate inlining and Called Arity is not good. See #18202 for a more general approach. But meanwhile, these-ininings seem unobjectional, and they solve the immediate+inlinings seem unobjectional, and they solve the immediate problem. Note [Error contexts in generated code]@@ -1970,7 +1970,7 @@ It's distressingly delicate though: * If we discard too /many/ constraints we may fail to report the error- that led us to interrupte the constraint gathering process.+ that led us to interrupt the constraint gathering process. One particular example "variable out of scope" Hole constraints. For example (#12529):
compiler/GHC/Tc/Utils/TcMType.hs view
@@ -614,7 +614,7 @@ -- Assuming that the argument type is of kind (TYPE r), -- ensure that it is a /monotype/ -- If it is not a monotype we can see right away (since unification--- varibles and type-function applications stand for monotypes), but+-- variables and type-function applications stand for monotypes), but -- we emit a Wanted equality just to delay the error message until later ensureMonoType res_ty | isTauTy res_ty -- isTauTy doesn't need zonking or anything@@ -1845,7 +1845,7 @@ ; writeMetaTyVar kv liftedTypeKind ; return True } | otherwise- = do { addErr $ TcRnUnknownMessage $ mkPlainError noHints $+ = do { addErr $ mkTcRnUnknownMessage $ mkPlainError noHints $ (vcat [ text "Cannot default kind variable" <+> quotes (ppr kv') , text "of kind:" <+> ppr (tyVarKind kv') , text "Perhaps enable PolyKinds or add a kind signature" ])@@ -1969,7 +1969,7 @@ D. We could error. We choose (D), as described in #17567, and implement this choice in-doNotQuantifyTyVars. Dicsussion of alternativs A-C is below.+doNotQuantifyTyVars. Discussion of alternativs A-C is below. NB: this is all rather similar to, but sadly not the same as Note [Naughty quantification candidates]@@ -2065,7 +2065,7 @@ ; unless (null leftover_metas) $ do { let (tidy_env1, tidied_tvs) = tidyOpenTyCoVars emptyTidyEnv leftover_metas ; (tidy_env2, where_doc) <- where_found tidy_env1- ; let msg = TcRnUnknownMessage $+ ; let msg = mkTcRnUnknownMessage $ mkPlainError noHints $ pprWithExplicitKindsWhen True $ vcat [ text "Uninferrable type variable"@@ -2735,7 +2735,7 @@ orig_ty' = tidyType env orig_ty1 ppr_tidied = pprTyVars . map (tidyTyCoVarOcc env)- msg = TcRnUnknownMessage $ mkPlainError noHints $+ msg = mkTcRnUnknownMessage $ mkPlainError noHints $ pprWithExplicitKindsWhen True $ vcat [ sep [ text "Cannot generalise type; skolem" <> plural escapees' , quotes $ ppr_tidied escapees'
compiler/GHC/Tc/Utils/Unify.hs view
@@ -205,7 +205,7 @@ -- | Like 'matchExpectedFunTys', but used when you have an "actual" type, -- for example in function application. ----- INVARIANT: the returned arguemnt types all have a syntactically fixed RuntimeRep+-- INVARIANT: the returned argument types all have a syntactically fixed RuntimeRep -- in the sense of Note [Fixed RuntimeRep] in GHC.Tc.Utils.Concrete. -- See Note [Return arguments with a fixed RuntimeRep]. matchActualFunTysRho :: ExpectedFunTyOrigin -- ^ See Note [Herald for matchExpectedFunTys]@@ -721,7 +721,7 @@ case e of T1 -> e1 :: (forall a. a->a) -> Int G2 -> e2-where T1 is not GADT or existential, but G2 is a GADT. Then supppose the+where T1 is not GADT or existential, but G2 is a GADT. Then suppose the T1 alternative fills the hole with (forall a. a->a) -> Int, which is fine. But now the G2 alternative must not *just* unify with that else we'd risk allowing through (e2 :: (forall a. a->a) -> Int). If we'd checked G2 first@@ -1156,7 +1156,7 @@ https://github.com/ghc-proposals/ghc-proposals/pull/511. makes a best-efforts attempt implement deep subsumption as it was-prior to the the Simplify Subsumption proposal:+prior to the Simplify Subsumption proposal: https://github.com/ghc-proposals/ghc-proposals/pull/287 @@ -2219,7 +2219,7 @@ assumptions", section 2.2. We say that alpha[1] is "untouchable" inside this implication. - Bottom line: at amibient level 'l', when looking at a constraint+ Bottom line: at ambient level 'l', when looking at a constraint alpha[n] ~ ty, do not unify alpha := ty if there are any given equalities between levels 'n' and 'l'. @@ -2261,7 +2261,7 @@ is sensible, but it can lead to very confusing error messages. It's very much like a Wanted rewriting a Wanted. Even worse, unifying a variable essentially turns an equality into a Given,- and so we could not use the tracking mechansim in+ and so we could not use the tracking mechanism in Note [Wanteds rewrite Wanteds] in GHC.Tc.Types.Constraint. We thus simply do not unify in this case.
compiler/GHC/Tc/Utils/Zonk.hs view
@@ -353,7 +353,7 @@ -- immediately by creating a TypeEnv zonkLIdOcc :: ZonkEnv -> LocatedN TcId -> LocatedN Id-zonkLIdOcc env = mapLoc (zonkIdOcc env)+zonkLIdOcc env = fmap (zonkIdOcc env) zonkIdOcc :: ZonkEnv -> TcId -> Id -- Ids defined in this module should be in the envt;@@ -1178,7 +1178,7 @@ ; (env1, bind_op') <- zonkSyntaxExpr env bind_op ; bind_arg_ty' <- zonkTcTypeToTypeX env1 bind_arg_ty ; (env2, stmts') <- zonkStmts env1 zonkLExpr stmts- ; by' <- fmapMaybeM (zonkLExpr env2) by+ ; by' <- traverse (zonkLExpr env2) by ; using' <- zonkLExpr env2 using ; (env3, return_op') <- zonkSyntaxExpr env2 return_op
compiler/GHC/Tc/Validity.hs view
@@ -362,7 +362,7 @@ checkValidType :: UserTypeCtxt -> Type -> TcM () -- Checks that a user-written type is valid for the given context -- Assumes argument is fully zonked--- Assumes arugment is well-kinded;+-- Assumes argument is well-kinded; -- that is, checkValidType doesn't need to do kind checking -- Not used for instance decls; checkValidInstance instead checkValidType ctxt ty@@ -1091,7 +1091,7 @@ | otherwise -> check_class_pred env dflags ctxt pred cls tys EqPred _ _ _ -> pprPanic "check_pred_help" (ppr pred)- -- EqPreds, such as (t1 ~ #t2) or (t1 ~R# t2), don't even have kind Constraint+ -- EqPreds, such as (t1 ~# t2) or (t1 ~R# t2), don't even have kind Constraint -- and should never appear before the '=>' of a type. Thus -- f :: (a ~# b) => blah -- is wrong. For user written signatures, it'll be rejected by kind-checking@@ -1199,7 +1199,7 @@ = do { result <- matchGlobalInst dflags False cls tys ; case result of OneInst { cir_what = what }- -> let dia = TcRnUnknownMessage $+ -> let dia = mkTcRnUnknownMessage $ mkPlainDiagnostic (WarningWithFlag Opt_WarnSimplifiableClassConstraints) noHints (simplifiable_constraint_warn what)@@ -1327,7 +1327,7 @@ arityErr :: Outputable a => SDoc -> a -> Int -> Int -> TcRnMessage arityErr what name n m- = TcRnUnknownMessage $ mkPlainError noHints $+ = mkTcRnUnknownMessage $ mkPlainError noHints $ hsep [ text "The" <+> what, quotes (ppr name), text "should have", n_arguments <> comma, text "but has been given", if m==0 then text "none" else int m]@@ -1379,7 +1379,7 @@ instance KnownNat T That says that any module satisfying M.hsig must provide a KnownNat-instance for T. We absolultely need that instance when compiling a+instance for T. We absolutely need that instance when compiling a module that imports M.hsig: see #15379 and Note [Fabricating Evidence for Literals in Backpack] in GHC.Tc.Instance.Class. @@ -1568,7 +1568,7 @@ instTypeErr :: Class -> [Type] -> SDoc -> TcRnMessage instTypeErr cls tys msg- = TcRnUnknownMessage $ mkPlainError noHints $+ = mkTcRnUnknownMessage $ mkPlainError noHints $ hang (hang (text "Illegal instance declaration for") 2 (quotes (pprClassPred cls tys))) 2 msg@@ -1742,7 +1742,7 @@ ; expand <- initialExpandMode ; check_valid_theta env0 ctxt expand theta - -- The Termination and Coverate Conditions+ -- The Termination and Coverage Conditions -- Check that instance inference will terminate (if we care) -- For Haskell 98 this will already have been done by checkValidTheta, -- but as we may be using other extensions we need to check.@@ -1831,11 +1831,11 @@ -- when the predicates are individually checked for validity check2 foralld_tvs pred pred_size- | not (null bad_tvs) = failWithTc $ TcRnUnknownMessage $ mkPlainError noHints $+ | not (null bad_tvs) = failWithTc $ mkTcRnUnknownMessage $ mkPlainError noHints $ (noMoreMsg bad_tvs what (ppr head_pred))- | not (isTyFamFree pred) = failWithTc $ TcRnUnknownMessage $ mkPlainError noHints $+ | not (isTyFamFree pred) = failWithTc $ mkTcRnUnknownMessage $ mkPlainError noHints $ (nestedMsg what)- | pred_size >= head_size = failWithTc $ TcRnUnknownMessage $ mkPlainError noHints $+ | pred_size >= head_size = failWithTc $ mkTcRnUnknownMessage $ mkPlainError noHints $ (smallerMsg what (ppr head_pred)) | otherwise = return () -- isTyFamFree: see Note [Type families in instance contexts]@@ -1918,7 +1918,7 @@ -- (b) failure of injectivity check_branch_compat prev_branches cur_branch | cur_branch `isDominatedBy` prev_branches- = do { let dia = TcRnUnknownMessage $+ = do { let dia = mkTcRnUnknownMessage $ mkPlainDiagnostic WarningWithoutFlag noHints (inaccessibleCoAxBranch fam_tc cur_branch) ; addDiagnosticAt (coAxBranchSpan cur_branch) dia ; return prev_branches }@@ -2035,7 +2035,7 @@ extract_tv pat pat_vis = case getTyVar_maybe pat of Just tv -> pure tv- Nothing -> failWithTc $ TcRnUnknownMessage $ mkPlainError noHints $+ Nothing -> failWithTc $ mkTcRnUnknownMessage $ mkPlainError noHints $ pprWithExplicitKindsWhen (isInvisibleArgFlag pat_vis) $ hang (text "Illegal argument" <+> quotes (ppr pat) <+> text "in:") 2 (vcat [ppr_eqn, suggestion])@@ -2053,7 +2053,7 @@ let dups = findDupsEq ((==) `on` fst) cpt_tvs_vis in traverse_ (\d -> let (pat_tv, pat_vis) = NE.head d in failWithTc $- TcRnUnknownMessage $ mkPlainError noHints $+ mkTcRnUnknownMessage $ mkPlainError noHints $ pprWithExplicitKindsWhen (isInvisibleArgFlag pat_vis) $ hang (text "Illegal duplicate variable" <+> quotes (ppr pat_tv) <+> text "in:")@@ -2078,7 +2078,7 @@ -> [(TyCon, [Type])] -- type family calls in RHS -> [TcRnMessage] checkFamInstRhs lhs_tc lhs_tys famInsts- = map (TcRnUnknownMessage . mkPlainError noHints) $ mapMaybe check famInsts+ = map (mkTcRnUnknownMessage . mkPlainError noHints) $ mapMaybe check famInsts where lhs_size = sizeTyConAppArgs lhs_tc lhs_tys inst_head = pprType (TyConApp lhs_tc lhs_tys)@@ -2149,7 +2149,7 @@ dodgy_tvs = cpt_tvs `minusVarSet` inj_cpt_tvs check_tvs tvs what what2- = unless (null tvs) $ addErrAt (getSrcSpan (head tvs)) $ TcRnUnknownMessage $ mkPlainError noHints $+ = unless (null tvs) $ addErrAt (getSrcSpan (head tvs)) $ mkTcRnUnknownMessage $ mkPlainError noHints $ hang (text "Type variable" <> plural tvs <+> pprQuotedList tvs <+> isOrAre tvs <+> what <> comma) 2 (vcat [ text "but not" <+> what2 <+> text "the family instance"@@ -2180,7 +2180,7 @@ -- Ensure that no type family applications occur a type pattern ; case tcTyConAppTyFamInstsAndVis tc pat_ty_args of [] -> pure ()- ((tf_is_invis_arg, tf_tc, tf_args):_) -> failWithTc $ TcRnUnknownMessage $ mkPlainError noHints $+ ((tf_is_invis_arg, tf_tc, tf_args):_) -> failWithTc $ mkTcRnUnknownMessage $ mkPlainError noHints $ ty_fam_inst_illegal_err tf_is_invis_arg (mkTyConApp tf_tc tf_args) } where@@ -2281,7 +2281,7 @@ , Just rl_subst1 <- tcMatchTyX_BM bind_me rl_subst ty2 ty1 = go lr_subst1 rl_subst1 triples | otherwise- = addErrTc (TcRnUnknownMessage $ mkPlainError noHints $ pp_wrong_at_arg vis)+ = addErrTc (mkTcRnUnknownMessage $ mkPlainError noHints $ pp_wrong_at_arg vis) -- The /scoped/ type variables from the class-instance header -- should not be alpha-renamed. Inferred ones can be.@@ -2505,7 +2505,7 @@ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ It's remarkably painful to give a decent error message for conflicts with the class header. Consider- clase C b where+ class C b where type F a b c instance C [b] where type F x Int _ _ = ...@@ -2557,7 +2557,7 @@ first is caught by the renamer, but we catch the last two here. Perhaps one could argue that the second should be accepted, albeit with a warning, but consider the fact that in a type family instance, there is no way to interact-with such a varable. At least with @x :: forall a. Int@ we can use visibile+with such a variable. At least with @x :: forall a. Int@ we can use visible type application, like @x \@Bool 1@. (Of course it does nothing, but it is permissible.) In the type family case, the only sensible explanation is that the user has made a mistake -- thus we throw an error.@@ -2709,7 +2709,7 @@ checkTyConTelescope tc | bad_scope = -- See "Ill-scoped binders" in Note [Bad TyCon telescopes]- addErr $ TcRnUnknownMessage $ mkPlainError noHints $+ addErr $ mkTcRnUnknownMessage $ mkPlainError noHints $ vcat [ hang (text "The kind of" <+> quotes (ppr tc) <+> text "is ill-scoped") 2 pp_tc_kind , extra
compiler/GHC/ThToHs.hs view
@@ -60,6 +60,7 @@ import qualified Data.ByteString as BS import Control.Monad( unless, ap ) import Control.Applicative( (<|>) )+import Data.List.NonEmpty( NonEmpty (..), nonEmpty ) import Data.Maybe( catMaybes, isNothing ) import Language.Haskell.TH as TH hiding (sigP) import Language.Haskell.TH.Syntax as TH@@ -290,10 +291,11 @@ ; cons' <- mapM cvtConstr constrs ; derivs' <- cvtDerivs derivs ; let defn = HsDataDefn { dd_ext = noExtField- , dd_ND = DataType, dd_cType = Nothing+ , dd_cType = Nothing , dd_ctxt = mkHsContextMaybe ctxt' , dd_kindSig = ksig'- , dd_cons = cons', dd_derivs = derivs' }+ , dd_cons = DataTypeCons False cons'+ , dd_derivs = derivs' } ; returnJustLA $ TyClD noExtField $ DataDecl { tcdDExt = noAnn , tcdLName = tc', tcdTyVars = tvs'@@ -306,10 +308,10 @@ ; con' <- cvtConstr constr ; derivs' <- cvtDerivs derivs ; let defn = HsDataDefn { dd_ext = noExtField- , dd_ND = NewType, dd_cType = Nothing+ , dd_cType = Nothing , dd_ctxt = mkHsContextMaybe ctxt' , dd_kindSig = ksig'- , dd_cons = [con']+ , dd_cons = NewTypeCon con' , dd_derivs = derivs' } ; returnJustLA $ TyClD noExtField $ DataDecl { tcdDExt = noAnn@@ -377,10 +379,11 @@ ; cons' <- mapM cvtConstr constrs ; derivs' <- cvtDerivs derivs ; let defn = HsDataDefn { dd_ext = noExtField- , dd_ND = DataType, dd_cType = Nothing+ , dd_cType = Nothing , dd_ctxt = mkHsContextMaybe ctxt' , dd_kindSig = ksig'- , dd_cons = cons', dd_derivs = derivs' }+ , dd_cons = DataTypeCons False cons'+ , dd_derivs = derivs' } ; returnJustLA $ InstD noExtField $ DataFamInstD { dfid_ext = noExtField@@ -398,10 +401,10 @@ ; con' <- cvtConstr constr ; derivs' <- cvtDerivs derivs ; let defn = HsDataDefn { dd_ext = noExtField- , dd_ND = NewType, dd_cType = Nothing+ , dd_cType = Nothing , dd_ctxt = mkHsContextMaybe ctxt' , dd_kindSig = ksig'- , dd_cons = [con'], dd_derivs = derivs' }+ , dd_cons = NewTypeCon con', dd_derivs = derivs' } ; returnJustLA $ InstD noExtField $ DataFamInstD { dfid_ext = noExtField , dfid_inst = DataFamInstDecl { dfid_eqn =@@ -679,26 +682,24 @@ where all_tvs = tvs' ++ ex_tvs -cvtConstr (GadtC [] _strtys _ty)- = failWith (text "GadtC must have at least one constructor name")--cvtConstr (GadtC c strtys ty)- = do { c' <- mapM cNameN c+cvtConstr (GadtC c strtys ty) = case nonEmpty c of+ Nothing -> failWith (text "GadtC must have at least one constructor name")+ Just c -> do+ { c' <- mapM cNameN c ; args <- mapM cvt_arg strtys ; ty' <- cvtType ty ; mk_gadt_decl c' (PrefixConGADT $ map hsLinear args) ty'} -cvtConstr (RecGadtC [] _varstrtys _ty)- = failWith (text "RecGadtC must have at least one constructor name")--cvtConstr (RecGadtC c varstrtys ty)- = do { c' <- mapM cNameN c+cvtConstr (RecGadtC c varstrtys ty) = case nonEmpty c of+ Nothing -> failWith (text "RecGadtC must have at least one constructor name")+ Just c -> do+ { c' <- mapM cNameN c ; ty' <- cvtType ty ; rec_flds <- mapM cvt_id_arg varstrtys ; lrec_flds <- returnLA rec_flds ; mk_gadt_decl c' (RecConGADT lrec_flds noHsUniTok) ty' } -mk_gadt_decl :: [LocatedN RdrName] -> HsConDeclGADTDetails GhcPs -> LHsType GhcPs+mk_gadt_decl :: NonEmpty (LocatedN RdrName) -> HsConDeclGADTDetails GhcPs -> LHsType GhcPs -> CvtM (LConDecl GhcPs) mk_gadt_decl names args res_ty = do bndrs <- returnLA mkHsOuterImplicit
− compiler/GHC/Utils/Monad/State/Lazy.hs
@@ -1,78 +0,0 @@-{-# LANGUAGE DeriveFunctor #-}-{-# LANGUAGE UnboxedTuples #-}-{-# LANGUAGE PatternSynonyms #-}---- | A lazy state monad.-module GHC.Utils.Monad.State.Lazy- ( -- * The State monda- State(State)- , state- , evalState- , execState- , runState- -- * Operations- , get- , gets- , put- , modify- ) where--import GHC.Prelude--import GHC.Exts (oneShot)---- | A state monad which is lazy in the state.-newtype State s a = State' { runState' :: s -> (# a, s #) }- deriving (Functor)--pattern State :: (s -> (# a, s #))- -> State s a---- This pattern synonym makes the monad eta-expand,--- which as a very beneficial effect on compiler performance--- See #18202.--- See Note [The one-shot state monad trick] in GHC.Utils.Monad-pattern State m <- State' m- where- State m = State' (oneShot $ \s -> m s)--instance Applicative (State s) where- pure x = State $ \s -> (# x, s #)- m <*> n = State $ \s -> case runState' m s of- (# f, s' #) -> case runState' n s' of- (# x, s'' #) -> (# f x, s'' #)--instance Monad (State s) where- m >>= n = State $ \s -> case runState' m s of- (# r, s' #) -> runState' (n r) s'--state :: (s -> (a, s)) -> State s a-state f = State $ \s -> case f s of- (r, s') -> (# r, s' #)--get :: State s s-get = State $ \s -> (# s, s #)--gets :: (s -> a) -> State s a-gets f = State $ \s -> (# f s, s #)--put :: s -> State s ()-put s' = State $ \_ -> (# (), s' #)--modify :: (s -> s) -> State s ()-modify f = State $ \s -> (# (), f s #)---evalState :: State s a -> s -> a-evalState s i = case runState' s i of- (# a, _ #) -> a---execState :: State s a -> s -> s-execState s i = case runState' s i of- (# _, s' #) -> s'---runState :: State s a -> s -> (a, s)-runState s i = case runState' s i of- (# a, s' #) -> (a, s')
ghc-lib.cabal view
@@ -1,7 +1,7 @@ cabal-version: 2.0 build-type: Simple name: ghc-lib-version: 0.20220901+version: 0.20221001 license: BSD3 license-file: LICENSE category: Development@@ -83,7 +83,7 @@ stm, rts, hpc == 0.6.*,- ghc-lib-parser == 0.20220901+ ghc-lib-parser == 0.20221001 build-tool-depends: alex:alex >= 3.1, happy:happy >= 1.19.4 other-extensions: BangPatterns@@ -120,6 +120,7 @@ UndecidableInstances default-extensions: BangPatterns+ ImplicitPrelude MonoLocalBinds NoImplicitPrelude ScopedTypeVariables@@ -234,6 +235,7 @@ GHC.Data.Strict, GHC.Data.StringBuffer, GHC.Data.TrieMap,+ GHC.Data.Unboxed, GHC.Driver.Backend, GHC.Driver.Backend.Internal, GHC.Driver.Backpack.Syntax,@@ -371,6 +373,7 @@ GHC.Types.Cpr, GHC.Types.Demand, GHC.Types.Error,+ GHC.Types.Error.Codes, GHC.Types.FieldLabel, GHC.Types.Fixity, GHC.Types.Fixity.Env,@@ -832,7 +835,6 @@ GHC.Types.Unique.MemoFun GHC.Unit.Finder GHC.Utils.Asm- GHC.Utils.Monad.State.Lazy GHCi.CreateBCO GHCi.InfoTable GHCi.ObjLink
ghc-lib/stage0/compiler/build/primop-data-decl.hs-incl view
@@ -568,6 +568,9 @@ | MaskUninterruptibleOp | UnmaskAsyncExceptionsOp | MaskStatus+ | NewPromptTagOp+ | PromptOp+ | Control0Op | AtomicallyOp | RetryOp | CatchRetryOp
ghc-lib/stage0/compiler/build/primop-docs.hs-incl view
@@ -259,6 +259,10 @@ , ("maskAsyncExceptions#"," @'maskAsyncExceptions#' k s@ evaluates @k s@ such that asynchronous\n exceptions are deferred until after evaluation has finished.\n\n Note that the result type here isn't quite as unrestricted as the\n polymorphic type might suggest; see the section \\\"RuntimeRep polymorphism\n in continuation-style primops\\\" for details. ") , ("maskUninterruptible#"," @'maskUninterruptible#' k s@ evaluates @k s@ such that asynchronous\n exceptions are deferred until after evaluation has finished.\n\n Note that the result type here isn't quite as unrestricted as the\n polymorphic type might suggest; see the section \\\"RuntimeRep polymorphism\n in continuation-style primops\\\" for details. ") , ("unmaskAsyncExceptions#"," @'unmaskAsyncUninterruptible#' k s@ evaluates @k s@ such that asynchronous\n exceptions are unmasked.\n\n Note that the result type here isn't quite as unrestricted as the\n polymorphic type might suggest; see the section \\\"RuntimeRep polymorphism\n in continuation-style primops\\\" for details. ")+ , ("PromptTag#"," See \"GHC.Prim#continuations\". ")+ , ("newPromptTag#"," See \"GHC.Prim#continuations\". ")+ , ("prompt#"," See \"GHC.Prim#continuations\". ")+ , ("control0#"," See \"GHC.Prim#continuations\". ") , ("newTVar#","Create a new 'TVar#' holding a specified initial value.") , ("readTVar#","Read contents of 'TVar#' inside an STM transaction,\n i.e. within a call to 'atomically#'.\n Does not force evaluation of the result.") , ("readTVarIO#","Read contents of 'TVar#' outside an STM transaction.\n Does not force evaluation of the result.")@@ -314,7 +318,7 @@ , ("getCurrentCCS#"," Returns the current 'CostCentreStack' (value is @NULL@ if\n not profiling). Takes a dummy argument which can be used to\n avoid the call to 'getCurrentCCS#' being floated out by the\n simplifier, which would result in an uninformative stack\n (\"CAF\"). ") , ("clearCCS#"," Run the supplied IO action with an empty CCS. For example, this\n is used by the interpreter to run an interpreted computation\n without the call stack showing that it was invoked from GHC. ") , ("whereFrom#"," Returns the @InfoProvEnt @ for the info table of the given object\n (value is @NULL@ if the table does not exist or there is no information\n about the closure).")- , ("FUN","The builtin function type, written in infix form as @a # m -> b@.\n Values of this type are functions taking inputs of type @a@ and\n producing outputs of type @b@. The multiplicity of the input is\n @m@.\n\n Note that @'FUN' m a b@ permits representation polymorphism in both\n @a@ and @b@, so that types like @'Int#' -> 'Int#'@ can still be\n well-kinded.\n ")+ , ("FUN","The builtin function type, written in infix form as @a % m -> b@.\n Values of this type are functions taking inputs of type @a@ and\n producing outputs of type @b@. The multiplicity of the input is\n @m@.\n\n Note that @'FUN' m a b@ permits representation polymorphism in both\n @a@ and @b@, so that types like @'Int#' -> 'Int#'@ can still be\n well-kinded.\n ") , ("realWorld#"," The token used in the implementation of the IO monad as a state monad.\n It does not pass any information at runtime.\n See also 'GHC.Magic.runRW#'. ") , ("void#"," This is an alias for the unboxed unit tuple constructor.\n In earlier versions of GHC, 'void#' was a value\n of the primitive type 'Void#', which is now defined to be @(# #)@.\n ") , ("Proxy#"," The type constructor 'Proxy#' is used to bear witness to some\n type variable. It's used when you want to pass around proxy values\n for doing things like modelling type applications. A 'Proxy#'\n is not only unboxed, it also has a polymorphic kind, and has no\n runtime representation, being totally free. ")
ghc-lib/stage0/compiler/build/primop-has-side-effects.hs-incl view
@@ -168,6 +168,9 @@ primOpHasSideEffects MaskUninterruptibleOp = True primOpHasSideEffects UnmaskAsyncExceptionsOp = True primOpHasSideEffects MaskStatus = True+primOpHasSideEffects NewPromptTagOp = True+primOpHasSideEffects PromptOp = True+primOpHasSideEffects Control0Op = True primOpHasSideEffects AtomicallyOp = True primOpHasSideEffects RetryOp = True primOpHasSideEffects CatchRetryOp = True
ghc-lib/stage0/compiler/build/primop-list.hs-incl view
@@ -567,6 +567,9 @@ , MaskUninterruptibleOp , UnmaskAsyncExceptionsOp , MaskStatus+ , NewPromptTagOp+ , PromptOp+ , Control0Op , AtomicallyOp , RetryOp , CatchRetryOp
ghc-lib/stage0/compiler/build/primop-out-of-line.hs-incl view
@@ -38,6 +38,9 @@ primOpOutOfLine MaskUninterruptibleOp = True primOpOutOfLine UnmaskAsyncExceptionsOp = True primOpOutOfLine MaskStatus = True+primOpOutOfLine NewPromptTagOp = True+primOpOutOfLine PromptOp = True+primOpOutOfLine Control0Op = True primOpOutOfLine AtomicallyOp = True primOpOutOfLine RetryOp = True primOpOutOfLine CatchRetryOp = True
ghc-lib/stage0/compiler/build/primop-primop-info.hs-incl view
@@ -567,6 +567,9 @@ primOpInfo MaskUninterruptibleOp = mkGenPrimOp (fsLit "maskUninterruptible#") [runtimeRep1TyVarInf, openAlphaTyVarSpec] [(mkVisFunTyMany (mkStatePrimTy realWorldTy) ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, openAlphaTy]))), mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, openAlphaTy])) primOpInfo UnmaskAsyncExceptionsOp = mkGenPrimOp (fsLit "unmaskAsyncExceptions#") [runtimeRep1TyVarInf, openAlphaTyVarSpec] [(mkVisFunTyMany (mkStatePrimTy realWorldTy) ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, openAlphaTy]))), mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, openAlphaTy])) primOpInfo MaskStatus = mkGenPrimOp (fsLit "getMaskingState#") [] [mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, intPrimTy]))+primOpInfo NewPromptTagOp = mkGenPrimOp (fsLit "newPromptTag#") [alphaTyVarSpec] [mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, mkPromptTagPrimTy alphaTy]))+primOpInfo PromptOp = mkGenPrimOp (fsLit "prompt#") [alphaTyVarSpec] [mkPromptTagPrimTy alphaTy, (mkVisFunTyMany (mkStatePrimTy realWorldTy) ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, alphaTy]))), mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, alphaTy]))+primOpInfo Control0Op = mkGenPrimOp (fsLit "control0#") [runtimeRep2TyVarInf, alphaTyVarSpec, openBetaTyVarSpec] [mkPromptTagPrimTy alphaTy, (mkVisFunTyMany ((mkVisFunTyMany ((mkVisFunTyMany (mkStatePrimTy realWorldTy) ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, openBetaTy])))) ((mkVisFunTyMany (mkStatePrimTy realWorldTy) ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, alphaTy])))))) ((mkVisFunTyMany (mkStatePrimTy realWorldTy) ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, alphaTy]))))), mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, openBetaTy])) primOpInfo AtomicallyOp = mkGenPrimOp (fsLit "atomically#") [levity1TyVarInf, levPolyAlphaTyVarSpec] [(mkVisFunTyMany (mkStatePrimTy realWorldTy) ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, levPolyAlphaTy]))), mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, levPolyAlphaTy])) primOpInfo RetryOp = mkGenPrimOp (fsLit "retry#") [levity1TyVarInf, levPolyAlphaTyVarSpec] [mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, levPolyAlphaTy])) primOpInfo CatchRetryOp = mkGenPrimOp (fsLit "catchRetry#") [levity1TyVarInf, levPolyAlphaTyVarSpec] [(mkVisFunTyMany (mkStatePrimTy realWorldTy) ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, levPolyAlphaTy]))), (mkVisFunTyMany (mkStatePrimTy realWorldTy) ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, levPolyAlphaTy]))), mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, levPolyAlphaTy]))
ghc-lib/stage0/compiler/build/primop-strictness.hs-incl view
@@ -6,6 +6,8 @@ primOpStrictness MaskAsyncExceptionsOp = \ _arity -> mkClosedDmdSig [strictOnceApply1Dmd,topDmd] topDiv primOpStrictness MaskUninterruptibleOp = \ _arity -> mkClosedDmdSig [strictOnceApply1Dmd,topDmd] topDiv primOpStrictness UnmaskAsyncExceptionsOp = \ _arity -> mkClosedDmdSig [strictOnceApply1Dmd,topDmd] topDiv +primOpStrictness PromptOp = \ _arity -> mkClosedDmdSig [topDmd, strictOnceApply1Dmd, topDmd] topDiv +primOpStrictness Control0Op = \ _arity -> mkClosedDmdSig [topDmd, lazyApply2Dmd, topDmd] topDiv primOpStrictness AtomicallyOp = \ _arity -> mkClosedDmdSig [strictManyApply1Dmd,topDmd] topDiv primOpStrictness RetryOp = \ _arity -> mkClosedDmdSig [topDmd] botDiv primOpStrictness CatchRetryOp = \ _arity -> mkClosedDmdSig [ lazyApply1Dmd
ghc-lib/stage0/compiler/build/primop-tag.hs-incl view
@@ -1,1309 +1,1312 @@ maxPrimOpTag :: Int-maxPrimOpTag = 1305-primOpTag :: PrimOp -> Int-primOpTag CharGtOp = 0-primOpTag CharGeOp = 1-primOpTag CharEqOp = 2-primOpTag CharNeOp = 3-primOpTag CharLtOp = 4-primOpTag CharLeOp = 5-primOpTag OrdOp = 6-primOpTag Int8ToIntOp = 7-primOpTag IntToInt8Op = 8-primOpTag Int8NegOp = 9-primOpTag Int8AddOp = 10-primOpTag Int8SubOp = 11-primOpTag Int8MulOp = 12-primOpTag Int8QuotOp = 13-primOpTag Int8RemOp = 14-primOpTag Int8QuotRemOp = 15-primOpTag Int8SllOp = 16-primOpTag Int8SraOp = 17-primOpTag Int8SrlOp = 18-primOpTag Int8ToWord8Op = 19-primOpTag Int8EqOp = 20-primOpTag Int8GeOp = 21-primOpTag Int8GtOp = 22-primOpTag Int8LeOp = 23-primOpTag Int8LtOp = 24-primOpTag Int8NeOp = 25-primOpTag Word8ToWordOp = 26-primOpTag WordToWord8Op = 27-primOpTag Word8AddOp = 28-primOpTag Word8SubOp = 29-primOpTag Word8MulOp = 30-primOpTag Word8QuotOp = 31-primOpTag Word8RemOp = 32-primOpTag Word8QuotRemOp = 33-primOpTag Word8AndOp = 34-primOpTag Word8OrOp = 35-primOpTag Word8XorOp = 36-primOpTag Word8NotOp = 37-primOpTag Word8SllOp = 38-primOpTag Word8SrlOp = 39-primOpTag Word8ToInt8Op = 40-primOpTag Word8EqOp = 41-primOpTag Word8GeOp = 42-primOpTag Word8GtOp = 43-primOpTag Word8LeOp = 44-primOpTag Word8LtOp = 45-primOpTag Word8NeOp = 46-primOpTag Int16ToIntOp = 47-primOpTag IntToInt16Op = 48-primOpTag Int16NegOp = 49-primOpTag Int16AddOp = 50-primOpTag Int16SubOp = 51-primOpTag Int16MulOp = 52-primOpTag Int16QuotOp = 53-primOpTag Int16RemOp = 54-primOpTag Int16QuotRemOp = 55-primOpTag Int16SllOp = 56-primOpTag Int16SraOp = 57-primOpTag Int16SrlOp = 58-primOpTag Int16ToWord16Op = 59-primOpTag Int16EqOp = 60-primOpTag Int16GeOp = 61-primOpTag Int16GtOp = 62-primOpTag Int16LeOp = 63-primOpTag Int16LtOp = 64-primOpTag Int16NeOp = 65-primOpTag Word16ToWordOp = 66-primOpTag WordToWord16Op = 67-primOpTag Word16AddOp = 68-primOpTag Word16SubOp = 69-primOpTag Word16MulOp = 70-primOpTag Word16QuotOp = 71-primOpTag Word16RemOp = 72-primOpTag Word16QuotRemOp = 73-primOpTag Word16AndOp = 74-primOpTag Word16OrOp = 75-primOpTag Word16XorOp = 76-primOpTag Word16NotOp = 77-primOpTag Word16SllOp = 78-primOpTag Word16SrlOp = 79-primOpTag Word16ToInt16Op = 80-primOpTag Word16EqOp = 81-primOpTag Word16GeOp = 82-primOpTag Word16GtOp = 83-primOpTag Word16LeOp = 84-primOpTag Word16LtOp = 85-primOpTag Word16NeOp = 86-primOpTag Int32ToIntOp = 87-primOpTag IntToInt32Op = 88-primOpTag Int32NegOp = 89-primOpTag Int32AddOp = 90-primOpTag Int32SubOp = 91-primOpTag Int32MulOp = 92-primOpTag Int32QuotOp = 93-primOpTag Int32RemOp = 94-primOpTag Int32QuotRemOp = 95-primOpTag Int32SllOp = 96-primOpTag Int32SraOp = 97-primOpTag Int32SrlOp = 98-primOpTag Int32ToWord32Op = 99-primOpTag Int32EqOp = 100-primOpTag Int32GeOp = 101-primOpTag Int32GtOp = 102-primOpTag Int32LeOp = 103-primOpTag Int32LtOp = 104-primOpTag Int32NeOp = 105-primOpTag Word32ToWordOp = 106-primOpTag WordToWord32Op = 107-primOpTag Word32AddOp = 108-primOpTag Word32SubOp = 109-primOpTag Word32MulOp = 110-primOpTag Word32QuotOp = 111-primOpTag Word32RemOp = 112-primOpTag Word32QuotRemOp = 113-primOpTag Word32AndOp = 114-primOpTag Word32OrOp = 115-primOpTag Word32XorOp = 116-primOpTag Word32NotOp = 117-primOpTag Word32SllOp = 118-primOpTag Word32SrlOp = 119-primOpTag Word32ToInt32Op = 120-primOpTag Word32EqOp = 121-primOpTag Word32GeOp = 122-primOpTag Word32GtOp = 123-primOpTag Word32LeOp = 124-primOpTag Word32LtOp = 125-primOpTag Word32NeOp = 126-primOpTag Int64ToIntOp = 127-primOpTag IntToInt64Op = 128-primOpTag Int64NegOp = 129-primOpTag Int64AddOp = 130-primOpTag Int64SubOp = 131-primOpTag Int64MulOp = 132-primOpTag Int64QuotOp = 133-primOpTag Int64RemOp = 134-primOpTag Int64SllOp = 135-primOpTag Int64SraOp = 136-primOpTag Int64SrlOp = 137-primOpTag Int64ToWord64Op = 138-primOpTag Int64EqOp = 139-primOpTag Int64GeOp = 140-primOpTag Int64GtOp = 141-primOpTag Int64LeOp = 142-primOpTag Int64LtOp = 143-primOpTag Int64NeOp = 144-primOpTag Word64ToWordOp = 145-primOpTag WordToWord64Op = 146-primOpTag Word64AddOp = 147-primOpTag Word64SubOp = 148-primOpTag Word64MulOp = 149-primOpTag Word64QuotOp = 150-primOpTag Word64RemOp = 151-primOpTag Word64AndOp = 152-primOpTag Word64OrOp = 153-primOpTag Word64XorOp = 154-primOpTag Word64NotOp = 155-primOpTag Word64SllOp = 156-primOpTag Word64SrlOp = 157-primOpTag Word64ToInt64Op = 158-primOpTag Word64EqOp = 159-primOpTag Word64GeOp = 160-primOpTag Word64GtOp = 161-primOpTag Word64LeOp = 162-primOpTag Word64LtOp = 163-primOpTag Word64NeOp = 164-primOpTag IntAddOp = 165-primOpTag IntSubOp = 166-primOpTag IntMulOp = 167-primOpTag IntMul2Op = 168-primOpTag IntMulMayOfloOp = 169-primOpTag IntQuotOp = 170-primOpTag IntRemOp = 171-primOpTag IntQuotRemOp = 172-primOpTag IntAndOp = 173-primOpTag IntOrOp = 174-primOpTag IntXorOp = 175-primOpTag IntNotOp = 176-primOpTag IntNegOp = 177-primOpTag IntAddCOp = 178-primOpTag IntSubCOp = 179-primOpTag IntGtOp = 180-primOpTag IntGeOp = 181-primOpTag IntEqOp = 182-primOpTag IntNeOp = 183-primOpTag IntLtOp = 184-primOpTag IntLeOp = 185-primOpTag ChrOp = 186-primOpTag IntToWordOp = 187-primOpTag IntToFloatOp = 188-primOpTag IntToDoubleOp = 189-primOpTag WordToFloatOp = 190-primOpTag WordToDoubleOp = 191-primOpTag IntSllOp = 192-primOpTag IntSraOp = 193-primOpTag IntSrlOp = 194-primOpTag WordAddOp = 195-primOpTag WordAddCOp = 196-primOpTag WordSubCOp = 197-primOpTag WordAdd2Op = 198-primOpTag WordSubOp = 199-primOpTag WordMulOp = 200-primOpTag WordMul2Op = 201-primOpTag WordQuotOp = 202-primOpTag WordRemOp = 203-primOpTag WordQuotRemOp = 204-primOpTag WordQuotRem2Op = 205-primOpTag WordAndOp = 206-primOpTag WordOrOp = 207-primOpTag WordXorOp = 208-primOpTag WordNotOp = 209-primOpTag WordSllOp = 210-primOpTag WordSrlOp = 211-primOpTag WordToIntOp = 212-primOpTag WordGtOp = 213-primOpTag WordGeOp = 214-primOpTag WordEqOp = 215-primOpTag WordNeOp = 216-primOpTag WordLtOp = 217-primOpTag WordLeOp = 218-primOpTag PopCnt8Op = 219-primOpTag PopCnt16Op = 220-primOpTag PopCnt32Op = 221-primOpTag PopCnt64Op = 222-primOpTag PopCntOp = 223-primOpTag Pdep8Op = 224-primOpTag Pdep16Op = 225-primOpTag Pdep32Op = 226-primOpTag Pdep64Op = 227-primOpTag PdepOp = 228-primOpTag Pext8Op = 229-primOpTag Pext16Op = 230-primOpTag Pext32Op = 231-primOpTag Pext64Op = 232-primOpTag PextOp = 233-primOpTag Clz8Op = 234-primOpTag Clz16Op = 235-primOpTag Clz32Op = 236-primOpTag Clz64Op = 237-primOpTag ClzOp = 238-primOpTag Ctz8Op = 239-primOpTag Ctz16Op = 240-primOpTag Ctz32Op = 241-primOpTag Ctz64Op = 242-primOpTag CtzOp = 243-primOpTag BSwap16Op = 244-primOpTag BSwap32Op = 245-primOpTag BSwap64Op = 246-primOpTag BSwapOp = 247-primOpTag BRev8Op = 248-primOpTag BRev16Op = 249-primOpTag BRev32Op = 250-primOpTag BRev64Op = 251-primOpTag BRevOp = 252-primOpTag Narrow8IntOp = 253-primOpTag Narrow16IntOp = 254-primOpTag Narrow32IntOp = 255-primOpTag Narrow8WordOp = 256-primOpTag Narrow16WordOp = 257-primOpTag Narrow32WordOp = 258-primOpTag DoubleGtOp = 259-primOpTag DoubleGeOp = 260-primOpTag DoubleEqOp = 261-primOpTag DoubleNeOp = 262-primOpTag DoubleLtOp = 263-primOpTag DoubleLeOp = 264-primOpTag DoubleAddOp = 265-primOpTag DoubleSubOp = 266-primOpTag DoubleMulOp = 267-primOpTag DoubleDivOp = 268-primOpTag DoubleNegOp = 269-primOpTag DoubleFabsOp = 270-primOpTag DoubleToIntOp = 271-primOpTag DoubleToFloatOp = 272-primOpTag DoubleExpOp = 273-primOpTag DoubleExpM1Op = 274-primOpTag DoubleLogOp = 275-primOpTag DoubleLog1POp = 276-primOpTag DoubleSqrtOp = 277-primOpTag DoubleSinOp = 278-primOpTag DoubleCosOp = 279-primOpTag DoubleTanOp = 280-primOpTag DoubleAsinOp = 281-primOpTag DoubleAcosOp = 282-primOpTag DoubleAtanOp = 283-primOpTag DoubleSinhOp = 284-primOpTag DoubleCoshOp = 285-primOpTag DoubleTanhOp = 286-primOpTag DoubleAsinhOp = 287-primOpTag DoubleAcoshOp = 288-primOpTag DoubleAtanhOp = 289-primOpTag DoublePowerOp = 290-primOpTag DoubleDecode_2IntOp = 291-primOpTag DoubleDecode_Int64Op = 292-primOpTag FloatGtOp = 293-primOpTag FloatGeOp = 294-primOpTag FloatEqOp = 295-primOpTag FloatNeOp = 296-primOpTag FloatLtOp = 297-primOpTag FloatLeOp = 298-primOpTag FloatAddOp = 299-primOpTag FloatSubOp = 300-primOpTag FloatMulOp = 301-primOpTag FloatDivOp = 302-primOpTag FloatNegOp = 303-primOpTag FloatFabsOp = 304-primOpTag FloatToIntOp = 305-primOpTag FloatExpOp = 306-primOpTag FloatExpM1Op = 307-primOpTag FloatLogOp = 308-primOpTag FloatLog1POp = 309-primOpTag FloatSqrtOp = 310-primOpTag FloatSinOp = 311-primOpTag FloatCosOp = 312-primOpTag FloatTanOp = 313-primOpTag FloatAsinOp = 314-primOpTag FloatAcosOp = 315-primOpTag FloatAtanOp = 316-primOpTag FloatSinhOp = 317-primOpTag FloatCoshOp = 318-primOpTag FloatTanhOp = 319-primOpTag FloatAsinhOp = 320-primOpTag FloatAcoshOp = 321-primOpTag FloatAtanhOp = 322-primOpTag FloatPowerOp = 323-primOpTag FloatToDoubleOp = 324-primOpTag FloatDecode_IntOp = 325-primOpTag NewArrayOp = 326-primOpTag ReadArrayOp = 327-primOpTag WriteArrayOp = 328-primOpTag SizeofArrayOp = 329-primOpTag SizeofMutableArrayOp = 330-primOpTag IndexArrayOp = 331-primOpTag UnsafeFreezeArrayOp = 332-primOpTag UnsafeThawArrayOp = 333-primOpTag CopyArrayOp = 334-primOpTag CopyMutableArrayOp = 335-primOpTag CloneArrayOp = 336-primOpTag CloneMutableArrayOp = 337-primOpTag FreezeArrayOp = 338-primOpTag ThawArrayOp = 339-primOpTag CasArrayOp = 340-primOpTag NewSmallArrayOp = 341-primOpTag ShrinkSmallMutableArrayOp_Char = 342-primOpTag ReadSmallArrayOp = 343-primOpTag WriteSmallArrayOp = 344-primOpTag SizeofSmallArrayOp = 345-primOpTag SizeofSmallMutableArrayOp = 346-primOpTag GetSizeofSmallMutableArrayOp = 347-primOpTag IndexSmallArrayOp = 348-primOpTag UnsafeFreezeSmallArrayOp = 349-primOpTag UnsafeThawSmallArrayOp = 350-primOpTag CopySmallArrayOp = 351-primOpTag CopySmallMutableArrayOp = 352-primOpTag CloneSmallArrayOp = 353-primOpTag CloneSmallMutableArrayOp = 354-primOpTag FreezeSmallArrayOp = 355-primOpTag ThawSmallArrayOp = 356-primOpTag CasSmallArrayOp = 357-primOpTag NewByteArrayOp_Char = 358-primOpTag NewPinnedByteArrayOp_Char = 359-primOpTag NewAlignedPinnedByteArrayOp_Char = 360-primOpTag MutableByteArrayIsPinnedOp = 361-primOpTag ByteArrayIsPinnedOp = 362-primOpTag ByteArrayContents_Char = 363-primOpTag MutableByteArrayContents_Char = 364-primOpTag ShrinkMutableByteArrayOp_Char = 365-primOpTag ResizeMutableByteArrayOp_Char = 366-primOpTag UnsafeFreezeByteArrayOp = 367-primOpTag SizeofByteArrayOp = 368-primOpTag SizeofMutableByteArrayOp = 369-primOpTag GetSizeofMutableByteArrayOp = 370-primOpTag IndexByteArrayOp_Char = 371-primOpTag IndexByteArrayOp_WideChar = 372-primOpTag IndexByteArrayOp_Int = 373-primOpTag IndexByteArrayOp_Word = 374-primOpTag IndexByteArrayOp_Addr = 375-primOpTag IndexByteArrayOp_Float = 376-primOpTag IndexByteArrayOp_Double = 377-primOpTag IndexByteArrayOp_StablePtr = 378-primOpTag IndexByteArrayOp_Int8 = 379-primOpTag IndexByteArrayOp_Int16 = 380-primOpTag IndexByteArrayOp_Int32 = 381-primOpTag IndexByteArrayOp_Int64 = 382-primOpTag IndexByteArrayOp_Word8 = 383-primOpTag IndexByteArrayOp_Word16 = 384-primOpTag IndexByteArrayOp_Word32 = 385-primOpTag IndexByteArrayOp_Word64 = 386-primOpTag IndexByteArrayOp_Word8AsChar = 387-primOpTag IndexByteArrayOp_Word8AsWideChar = 388-primOpTag IndexByteArrayOp_Word8AsInt = 389-primOpTag IndexByteArrayOp_Word8AsWord = 390-primOpTag IndexByteArrayOp_Word8AsAddr = 391-primOpTag IndexByteArrayOp_Word8AsFloat = 392-primOpTag IndexByteArrayOp_Word8AsDouble = 393-primOpTag IndexByteArrayOp_Word8AsStablePtr = 394-primOpTag IndexByteArrayOp_Word8AsInt16 = 395-primOpTag IndexByteArrayOp_Word8AsInt32 = 396-primOpTag IndexByteArrayOp_Word8AsInt64 = 397-primOpTag IndexByteArrayOp_Word8AsWord16 = 398-primOpTag IndexByteArrayOp_Word8AsWord32 = 399-primOpTag IndexByteArrayOp_Word8AsWord64 = 400-primOpTag ReadByteArrayOp_Char = 401-primOpTag ReadByteArrayOp_WideChar = 402-primOpTag ReadByteArrayOp_Int = 403-primOpTag ReadByteArrayOp_Word = 404-primOpTag ReadByteArrayOp_Addr = 405-primOpTag ReadByteArrayOp_Float = 406-primOpTag ReadByteArrayOp_Double = 407-primOpTag ReadByteArrayOp_StablePtr = 408-primOpTag ReadByteArrayOp_Int8 = 409-primOpTag ReadByteArrayOp_Int16 = 410-primOpTag ReadByteArrayOp_Int32 = 411-primOpTag ReadByteArrayOp_Int64 = 412-primOpTag ReadByteArrayOp_Word8 = 413-primOpTag ReadByteArrayOp_Word16 = 414-primOpTag ReadByteArrayOp_Word32 = 415-primOpTag ReadByteArrayOp_Word64 = 416-primOpTag ReadByteArrayOp_Word8AsChar = 417-primOpTag ReadByteArrayOp_Word8AsWideChar = 418-primOpTag ReadByteArrayOp_Word8AsInt = 419-primOpTag ReadByteArrayOp_Word8AsWord = 420-primOpTag ReadByteArrayOp_Word8AsAddr = 421-primOpTag ReadByteArrayOp_Word8AsFloat = 422-primOpTag ReadByteArrayOp_Word8AsDouble = 423-primOpTag ReadByteArrayOp_Word8AsStablePtr = 424-primOpTag ReadByteArrayOp_Word8AsInt16 = 425-primOpTag ReadByteArrayOp_Word8AsInt32 = 426-primOpTag ReadByteArrayOp_Word8AsInt64 = 427-primOpTag ReadByteArrayOp_Word8AsWord16 = 428-primOpTag ReadByteArrayOp_Word8AsWord32 = 429-primOpTag ReadByteArrayOp_Word8AsWord64 = 430-primOpTag WriteByteArrayOp_Char = 431-primOpTag WriteByteArrayOp_WideChar = 432-primOpTag WriteByteArrayOp_Int = 433-primOpTag WriteByteArrayOp_Word = 434-primOpTag WriteByteArrayOp_Addr = 435-primOpTag WriteByteArrayOp_Float = 436-primOpTag WriteByteArrayOp_Double = 437-primOpTag WriteByteArrayOp_StablePtr = 438-primOpTag WriteByteArrayOp_Int8 = 439-primOpTag WriteByteArrayOp_Int16 = 440-primOpTag WriteByteArrayOp_Int32 = 441-primOpTag WriteByteArrayOp_Int64 = 442-primOpTag WriteByteArrayOp_Word8 = 443-primOpTag WriteByteArrayOp_Word16 = 444-primOpTag WriteByteArrayOp_Word32 = 445-primOpTag WriteByteArrayOp_Word64 = 446-primOpTag WriteByteArrayOp_Word8AsChar = 447-primOpTag WriteByteArrayOp_Word8AsWideChar = 448-primOpTag WriteByteArrayOp_Word8AsInt = 449-primOpTag WriteByteArrayOp_Word8AsWord = 450-primOpTag WriteByteArrayOp_Word8AsAddr = 451-primOpTag WriteByteArrayOp_Word8AsFloat = 452-primOpTag WriteByteArrayOp_Word8AsDouble = 453-primOpTag WriteByteArrayOp_Word8AsStablePtr = 454-primOpTag WriteByteArrayOp_Word8AsInt16 = 455-primOpTag WriteByteArrayOp_Word8AsInt32 = 456-primOpTag WriteByteArrayOp_Word8AsInt64 = 457-primOpTag WriteByteArrayOp_Word8AsWord16 = 458-primOpTag WriteByteArrayOp_Word8AsWord32 = 459-primOpTag WriteByteArrayOp_Word8AsWord64 = 460-primOpTag CompareByteArraysOp = 461-primOpTag CopyByteArrayOp = 462-primOpTag CopyMutableByteArrayOp = 463-primOpTag CopyByteArrayToAddrOp = 464-primOpTag CopyMutableByteArrayToAddrOp = 465-primOpTag CopyAddrToByteArrayOp = 466-primOpTag SetByteArrayOp = 467-primOpTag AtomicReadByteArrayOp_Int = 468-primOpTag AtomicWriteByteArrayOp_Int = 469-primOpTag CasByteArrayOp_Int = 470-primOpTag CasByteArrayOp_Int8 = 471-primOpTag CasByteArrayOp_Int16 = 472-primOpTag CasByteArrayOp_Int32 = 473-primOpTag CasByteArrayOp_Int64 = 474-primOpTag FetchAddByteArrayOp_Int = 475-primOpTag FetchSubByteArrayOp_Int = 476-primOpTag FetchAndByteArrayOp_Int = 477-primOpTag FetchNandByteArrayOp_Int = 478-primOpTag FetchOrByteArrayOp_Int = 479-primOpTag FetchXorByteArrayOp_Int = 480-primOpTag AddrAddOp = 481-primOpTag AddrSubOp = 482-primOpTag AddrRemOp = 483-primOpTag AddrToIntOp = 484-primOpTag IntToAddrOp = 485-primOpTag AddrGtOp = 486-primOpTag AddrGeOp = 487-primOpTag AddrEqOp = 488-primOpTag AddrNeOp = 489-primOpTag AddrLtOp = 490-primOpTag AddrLeOp = 491-primOpTag IndexOffAddrOp_Char = 492-primOpTag IndexOffAddrOp_WideChar = 493-primOpTag IndexOffAddrOp_Int = 494-primOpTag IndexOffAddrOp_Word = 495-primOpTag IndexOffAddrOp_Addr = 496-primOpTag IndexOffAddrOp_Float = 497-primOpTag IndexOffAddrOp_Double = 498-primOpTag IndexOffAddrOp_StablePtr = 499-primOpTag IndexOffAddrOp_Int8 = 500-primOpTag IndexOffAddrOp_Int16 = 501-primOpTag IndexOffAddrOp_Int32 = 502-primOpTag IndexOffAddrOp_Int64 = 503-primOpTag IndexOffAddrOp_Word8 = 504-primOpTag IndexOffAddrOp_Word16 = 505-primOpTag IndexOffAddrOp_Word32 = 506-primOpTag IndexOffAddrOp_Word64 = 507-primOpTag ReadOffAddrOp_Char = 508-primOpTag ReadOffAddrOp_WideChar = 509-primOpTag ReadOffAddrOp_Int = 510-primOpTag ReadOffAddrOp_Word = 511-primOpTag ReadOffAddrOp_Addr = 512-primOpTag ReadOffAddrOp_Float = 513-primOpTag ReadOffAddrOp_Double = 514-primOpTag ReadOffAddrOp_StablePtr = 515-primOpTag ReadOffAddrOp_Int8 = 516-primOpTag ReadOffAddrOp_Int16 = 517-primOpTag ReadOffAddrOp_Int32 = 518-primOpTag ReadOffAddrOp_Int64 = 519-primOpTag ReadOffAddrOp_Word8 = 520-primOpTag ReadOffAddrOp_Word16 = 521-primOpTag ReadOffAddrOp_Word32 = 522-primOpTag ReadOffAddrOp_Word64 = 523-primOpTag WriteOffAddrOp_Char = 524-primOpTag WriteOffAddrOp_WideChar = 525-primOpTag WriteOffAddrOp_Int = 526-primOpTag WriteOffAddrOp_Word = 527-primOpTag WriteOffAddrOp_Addr = 528-primOpTag WriteOffAddrOp_Float = 529-primOpTag WriteOffAddrOp_Double = 530-primOpTag WriteOffAddrOp_StablePtr = 531-primOpTag WriteOffAddrOp_Int8 = 532-primOpTag WriteOffAddrOp_Int16 = 533-primOpTag WriteOffAddrOp_Int32 = 534-primOpTag WriteOffAddrOp_Int64 = 535-primOpTag WriteOffAddrOp_Word8 = 536-primOpTag WriteOffAddrOp_Word16 = 537-primOpTag WriteOffAddrOp_Word32 = 538-primOpTag WriteOffAddrOp_Word64 = 539-primOpTag InterlockedExchange_Addr = 540-primOpTag InterlockedExchange_Word = 541-primOpTag CasAddrOp_Addr = 542-primOpTag CasAddrOp_Word = 543-primOpTag CasAddrOp_Word8 = 544-primOpTag CasAddrOp_Word16 = 545-primOpTag CasAddrOp_Word32 = 546-primOpTag CasAddrOp_Word64 = 547-primOpTag FetchAddAddrOp_Word = 548-primOpTag FetchSubAddrOp_Word = 549-primOpTag FetchAndAddrOp_Word = 550-primOpTag FetchNandAddrOp_Word = 551-primOpTag FetchOrAddrOp_Word = 552-primOpTag FetchXorAddrOp_Word = 553-primOpTag AtomicReadAddrOp_Word = 554-primOpTag AtomicWriteAddrOp_Word = 555-primOpTag NewMutVarOp = 556-primOpTag ReadMutVarOp = 557-primOpTag WriteMutVarOp = 558-primOpTag AtomicModifyMutVar2Op = 559-primOpTag AtomicModifyMutVar_Op = 560-primOpTag CasMutVarOp = 561-primOpTag CatchOp = 562-primOpTag RaiseOp = 563-primOpTag RaiseIOOp = 564-primOpTag MaskAsyncExceptionsOp = 565-primOpTag MaskUninterruptibleOp = 566-primOpTag UnmaskAsyncExceptionsOp = 567-primOpTag MaskStatus = 568-primOpTag AtomicallyOp = 569-primOpTag RetryOp = 570-primOpTag CatchRetryOp = 571-primOpTag CatchSTMOp = 572-primOpTag NewTVarOp = 573-primOpTag ReadTVarOp = 574-primOpTag ReadTVarIOOp = 575-primOpTag WriteTVarOp = 576-primOpTag NewMVarOp = 577-primOpTag TakeMVarOp = 578-primOpTag TryTakeMVarOp = 579-primOpTag PutMVarOp = 580-primOpTag TryPutMVarOp = 581-primOpTag ReadMVarOp = 582-primOpTag TryReadMVarOp = 583-primOpTag IsEmptyMVarOp = 584-primOpTag NewIOPortOp = 585-primOpTag ReadIOPortOp = 586-primOpTag WriteIOPortOp = 587-primOpTag DelayOp = 588-primOpTag WaitReadOp = 589-primOpTag WaitWriteOp = 590-primOpTag ForkOp = 591-primOpTag ForkOnOp = 592-primOpTag KillThreadOp = 593-primOpTag YieldOp = 594-primOpTag MyThreadIdOp = 595-primOpTag LabelThreadOp = 596-primOpTag IsCurrentThreadBoundOp = 597-primOpTag NoDuplicateOp = 598-primOpTag GetThreadLabelOp = 599-primOpTag ThreadStatusOp = 600-primOpTag ListThreadsOp = 601-primOpTag MkWeakOp = 602-primOpTag MkWeakNoFinalizerOp = 603-primOpTag AddCFinalizerToWeakOp = 604-primOpTag DeRefWeakOp = 605-primOpTag FinalizeWeakOp = 606-primOpTag TouchOp = 607-primOpTag MakeStablePtrOp = 608-primOpTag DeRefStablePtrOp = 609-primOpTag EqStablePtrOp = 610-primOpTag MakeStableNameOp = 611-primOpTag StableNameToIntOp = 612-primOpTag CompactNewOp = 613-primOpTag CompactResizeOp = 614-primOpTag CompactContainsOp = 615-primOpTag CompactContainsAnyOp = 616-primOpTag CompactGetFirstBlockOp = 617-primOpTag CompactGetNextBlockOp = 618-primOpTag CompactAllocateBlockOp = 619-primOpTag CompactFixupPointersOp = 620-primOpTag CompactAdd = 621-primOpTag CompactAddWithSharing = 622-primOpTag CompactSize = 623-primOpTag ReallyUnsafePtrEqualityOp = 624-primOpTag ParOp = 625-primOpTag SparkOp = 626-primOpTag SeqOp = 627-primOpTag GetSparkOp = 628-primOpTag NumSparks = 629-primOpTag KeepAliveOp = 630-primOpTag DataToTagOp = 631-primOpTag TagToEnumOp = 632-primOpTag AddrToAnyOp = 633-primOpTag AnyToAddrOp = 634-primOpTag MkApUpd0_Op = 635-primOpTag NewBCOOp = 636-primOpTag UnpackClosureOp = 637-primOpTag ClosureSizeOp = 638-primOpTag GetApStackValOp = 639-primOpTag GetCCSOfOp = 640-primOpTag GetCurrentCCSOp = 641-primOpTag ClearCCSOp = 642-primOpTag WhereFromOp = 643-primOpTag TraceEventOp = 644-primOpTag TraceEventBinaryOp = 645-primOpTag TraceMarkerOp = 646-primOpTag SetThreadAllocationCounter = 647-primOpTag (VecBroadcastOp IntVec 16 W8) = 648-primOpTag (VecBroadcastOp IntVec 8 W16) = 649-primOpTag (VecBroadcastOp IntVec 4 W32) = 650-primOpTag (VecBroadcastOp IntVec 2 W64) = 651-primOpTag (VecBroadcastOp IntVec 32 W8) = 652-primOpTag (VecBroadcastOp IntVec 16 W16) = 653-primOpTag (VecBroadcastOp IntVec 8 W32) = 654-primOpTag (VecBroadcastOp IntVec 4 W64) = 655-primOpTag (VecBroadcastOp IntVec 64 W8) = 656-primOpTag (VecBroadcastOp IntVec 32 W16) = 657-primOpTag (VecBroadcastOp IntVec 16 W32) = 658-primOpTag (VecBroadcastOp IntVec 8 W64) = 659-primOpTag (VecBroadcastOp WordVec 16 W8) = 660-primOpTag (VecBroadcastOp WordVec 8 W16) = 661-primOpTag (VecBroadcastOp WordVec 4 W32) = 662-primOpTag (VecBroadcastOp WordVec 2 W64) = 663-primOpTag (VecBroadcastOp WordVec 32 W8) = 664-primOpTag (VecBroadcastOp WordVec 16 W16) = 665-primOpTag (VecBroadcastOp WordVec 8 W32) = 666-primOpTag (VecBroadcastOp WordVec 4 W64) = 667-primOpTag (VecBroadcastOp WordVec 64 W8) = 668-primOpTag (VecBroadcastOp WordVec 32 W16) = 669-primOpTag (VecBroadcastOp WordVec 16 W32) = 670-primOpTag (VecBroadcastOp WordVec 8 W64) = 671-primOpTag (VecBroadcastOp FloatVec 4 W32) = 672-primOpTag (VecBroadcastOp FloatVec 2 W64) = 673-primOpTag (VecBroadcastOp FloatVec 8 W32) = 674-primOpTag (VecBroadcastOp FloatVec 4 W64) = 675-primOpTag (VecBroadcastOp FloatVec 16 W32) = 676-primOpTag (VecBroadcastOp FloatVec 8 W64) = 677-primOpTag (VecPackOp IntVec 16 W8) = 678-primOpTag (VecPackOp IntVec 8 W16) = 679-primOpTag (VecPackOp IntVec 4 W32) = 680-primOpTag (VecPackOp IntVec 2 W64) = 681-primOpTag (VecPackOp IntVec 32 W8) = 682-primOpTag (VecPackOp IntVec 16 W16) = 683-primOpTag (VecPackOp IntVec 8 W32) = 684-primOpTag (VecPackOp IntVec 4 W64) = 685-primOpTag (VecPackOp IntVec 64 W8) = 686-primOpTag (VecPackOp IntVec 32 W16) = 687-primOpTag (VecPackOp IntVec 16 W32) = 688-primOpTag (VecPackOp IntVec 8 W64) = 689-primOpTag (VecPackOp WordVec 16 W8) = 690-primOpTag (VecPackOp WordVec 8 W16) = 691-primOpTag (VecPackOp WordVec 4 W32) = 692-primOpTag (VecPackOp WordVec 2 W64) = 693-primOpTag (VecPackOp WordVec 32 W8) = 694-primOpTag (VecPackOp WordVec 16 W16) = 695-primOpTag (VecPackOp WordVec 8 W32) = 696-primOpTag (VecPackOp WordVec 4 W64) = 697-primOpTag (VecPackOp WordVec 64 W8) = 698-primOpTag (VecPackOp WordVec 32 W16) = 699-primOpTag (VecPackOp WordVec 16 W32) = 700-primOpTag (VecPackOp WordVec 8 W64) = 701-primOpTag (VecPackOp FloatVec 4 W32) = 702-primOpTag (VecPackOp FloatVec 2 W64) = 703-primOpTag (VecPackOp FloatVec 8 W32) = 704-primOpTag (VecPackOp FloatVec 4 W64) = 705-primOpTag (VecPackOp FloatVec 16 W32) = 706-primOpTag (VecPackOp FloatVec 8 W64) = 707-primOpTag (VecUnpackOp IntVec 16 W8) = 708-primOpTag (VecUnpackOp IntVec 8 W16) = 709-primOpTag (VecUnpackOp IntVec 4 W32) = 710-primOpTag (VecUnpackOp IntVec 2 W64) = 711-primOpTag (VecUnpackOp IntVec 32 W8) = 712-primOpTag (VecUnpackOp IntVec 16 W16) = 713-primOpTag (VecUnpackOp IntVec 8 W32) = 714-primOpTag (VecUnpackOp IntVec 4 W64) = 715-primOpTag (VecUnpackOp IntVec 64 W8) = 716-primOpTag (VecUnpackOp IntVec 32 W16) = 717-primOpTag (VecUnpackOp IntVec 16 W32) = 718-primOpTag (VecUnpackOp IntVec 8 W64) = 719-primOpTag (VecUnpackOp WordVec 16 W8) = 720-primOpTag (VecUnpackOp WordVec 8 W16) = 721-primOpTag (VecUnpackOp WordVec 4 W32) = 722-primOpTag (VecUnpackOp WordVec 2 W64) = 723-primOpTag (VecUnpackOp WordVec 32 W8) = 724-primOpTag (VecUnpackOp WordVec 16 W16) = 725-primOpTag (VecUnpackOp WordVec 8 W32) = 726-primOpTag (VecUnpackOp WordVec 4 W64) = 727-primOpTag (VecUnpackOp WordVec 64 W8) = 728-primOpTag (VecUnpackOp WordVec 32 W16) = 729-primOpTag (VecUnpackOp WordVec 16 W32) = 730-primOpTag (VecUnpackOp WordVec 8 W64) = 731-primOpTag (VecUnpackOp FloatVec 4 W32) = 732-primOpTag (VecUnpackOp FloatVec 2 W64) = 733-primOpTag (VecUnpackOp FloatVec 8 W32) = 734-primOpTag (VecUnpackOp FloatVec 4 W64) = 735-primOpTag (VecUnpackOp FloatVec 16 W32) = 736-primOpTag (VecUnpackOp FloatVec 8 W64) = 737-primOpTag (VecInsertOp IntVec 16 W8) = 738-primOpTag (VecInsertOp IntVec 8 W16) = 739-primOpTag (VecInsertOp IntVec 4 W32) = 740-primOpTag (VecInsertOp IntVec 2 W64) = 741-primOpTag (VecInsertOp IntVec 32 W8) = 742-primOpTag (VecInsertOp IntVec 16 W16) = 743-primOpTag (VecInsertOp IntVec 8 W32) = 744-primOpTag (VecInsertOp IntVec 4 W64) = 745-primOpTag (VecInsertOp IntVec 64 W8) = 746-primOpTag (VecInsertOp IntVec 32 W16) = 747-primOpTag (VecInsertOp IntVec 16 W32) = 748-primOpTag (VecInsertOp IntVec 8 W64) = 749-primOpTag (VecInsertOp WordVec 16 W8) = 750-primOpTag (VecInsertOp WordVec 8 W16) = 751-primOpTag (VecInsertOp WordVec 4 W32) = 752-primOpTag (VecInsertOp WordVec 2 W64) = 753-primOpTag (VecInsertOp WordVec 32 W8) = 754-primOpTag (VecInsertOp WordVec 16 W16) = 755-primOpTag (VecInsertOp WordVec 8 W32) = 756-primOpTag (VecInsertOp WordVec 4 W64) = 757-primOpTag (VecInsertOp WordVec 64 W8) = 758-primOpTag (VecInsertOp WordVec 32 W16) = 759-primOpTag (VecInsertOp WordVec 16 W32) = 760-primOpTag (VecInsertOp WordVec 8 W64) = 761-primOpTag (VecInsertOp FloatVec 4 W32) = 762-primOpTag (VecInsertOp FloatVec 2 W64) = 763-primOpTag (VecInsertOp FloatVec 8 W32) = 764-primOpTag (VecInsertOp FloatVec 4 W64) = 765-primOpTag (VecInsertOp FloatVec 16 W32) = 766-primOpTag (VecInsertOp FloatVec 8 W64) = 767-primOpTag (VecAddOp IntVec 16 W8) = 768-primOpTag (VecAddOp IntVec 8 W16) = 769-primOpTag (VecAddOp IntVec 4 W32) = 770-primOpTag (VecAddOp IntVec 2 W64) = 771-primOpTag (VecAddOp IntVec 32 W8) = 772-primOpTag (VecAddOp IntVec 16 W16) = 773-primOpTag (VecAddOp IntVec 8 W32) = 774-primOpTag (VecAddOp IntVec 4 W64) = 775-primOpTag (VecAddOp IntVec 64 W8) = 776-primOpTag (VecAddOp IntVec 32 W16) = 777-primOpTag (VecAddOp IntVec 16 W32) = 778-primOpTag (VecAddOp IntVec 8 W64) = 779-primOpTag (VecAddOp WordVec 16 W8) = 780-primOpTag (VecAddOp WordVec 8 W16) = 781-primOpTag (VecAddOp WordVec 4 W32) = 782-primOpTag (VecAddOp WordVec 2 W64) = 783-primOpTag (VecAddOp WordVec 32 W8) = 784-primOpTag (VecAddOp WordVec 16 W16) = 785-primOpTag (VecAddOp WordVec 8 W32) = 786-primOpTag (VecAddOp WordVec 4 W64) = 787-primOpTag (VecAddOp WordVec 64 W8) = 788-primOpTag (VecAddOp WordVec 32 W16) = 789-primOpTag (VecAddOp WordVec 16 W32) = 790-primOpTag (VecAddOp WordVec 8 W64) = 791-primOpTag (VecAddOp FloatVec 4 W32) = 792-primOpTag (VecAddOp FloatVec 2 W64) = 793-primOpTag (VecAddOp FloatVec 8 W32) = 794-primOpTag (VecAddOp FloatVec 4 W64) = 795-primOpTag (VecAddOp FloatVec 16 W32) = 796-primOpTag (VecAddOp FloatVec 8 W64) = 797-primOpTag (VecSubOp IntVec 16 W8) = 798-primOpTag (VecSubOp IntVec 8 W16) = 799-primOpTag (VecSubOp IntVec 4 W32) = 800-primOpTag (VecSubOp IntVec 2 W64) = 801-primOpTag (VecSubOp IntVec 32 W8) = 802-primOpTag (VecSubOp IntVec 16 W16) = 803-primOpTag (VecSubOp IntVec 8 W32) = 804-primOpTag (VecSubOp IntVec 4 W64) = 805-primOpTag (VecSubOp IntVec 64 W8) = 806-primOpTag (VecSubOp IntVec 32 W16) = 807-primOpTag (VecSubOp IntVec 16 W32) = 808-primOpTag (VecSubOp IntVec 8 W64) = 809-primOpTag (VecSubOp WordVec 16 W8) = 810-primOpTag (VecSubOp WordVec 8 W16) = 811-primOpTag (VecSubOp WordVec 4 W32) = 812-primOpTag (VecSubOp WordVec 2 W64) = 813-primOpTag (VecSubOp WordVec 32 W8) = 814-primOpTag (VecSubOp WordVec 16 W16) = 815-primOpTag (VecSubOp WordVec 8 W32) = 816-primOpTag (VecSubOp WordVec 4 W64) = 817-primOpTag (VecSubOp WordVec 64 W8) = 818-primOpTag (VecSubOp WordVec 32 W16) = 819-primOpTag (VecSubOp WordVec 16 W32) = 820-primOpTag (VecSubOp WordVec 8 W64) = 821-primOpTag (VecSubOp FloatVec 4 W32) = 822-primOpTag (VecSubOp FloatVec 2 W64) = 823-primOpTag (VecSubOp FloatVec 8 W32) = 824-primOpTag (VecSubOp FloatVec 4 W64) = 825-primOpTag (VecSubOp FloatVec 16 W32) = 826-primOpTag (VecSubOp FloatVec 8 W64) = 827-primOpTag (VecMulOp IntVec 16 W8) = 828-primOpTag (VecMulOp IntVec 8 W16) = 829-primOpTag (VecMulOp IntVec 4 W32) = 830-primOpTag (VecMulOp IntVec 2 W64) = 831-primOpTag (VecMulOp IntVec 32 W8) = 832-primOpTag (VecMulOp IntVec 16 W16) = 833-primOpTag (VecMulOp IntVec 8 W32) = 834-primOpTag (VecMulOp IntVec 4 W64) = 835-primOpTag (VecMulOp IntVec 64 W8) = 836-primOpTag (VecMulOp IntVec 32 W16) = 837-primOpTag (VecMulOp IntVec 16 W32) = 838-primOpTag (VecMulOp IntVec 8 W64) = 839-primOpTag (VecMulOp WordVec 16 W8) = 840-primOpTag (VecMulOp WordVec 8 W16) = 841-primOpTag (VecMulOp WordVec 4 W32) = 842-primOpTag (VecMulOp WordVec 2 W64) = 843-primOpTag (VecMulOp WordVec 32 W8) = 844-primOpTag (VecMulOp WordVec 16 W16) = 845-primOpTag (VecMulOp WordVec 8 W32) = 846-primOpTag (VecMulOp WordVec 4 W64) = 847-primOpTag (VecMulOp WordVec 64 W8) = 848-primOpTag (VecMulOp WordVec 32 W16) = 849-primOpTag (VecMulOp WordVec 16 W32) = 850-primOpTag (VecMulOp WordVec 8 W64) = 851-primOpTag (VecMulOp FloatVec 4 W32) = 852-primOpTag (VecMulOp FloatVec 2 W64) = 853-primOpTag (VecMulOp FloatVec 8 W32) = 854-primOpTag (VecMulOp FloatVec 4 W64) = 855-primOpTag (VecMulOp FloatVec 16 W32) = 856-primOpTag (VecMulOp FloatVec 8 W64) = 857-primOpTag (VecDivOp FloatVec 4 W32) = 858-primOpTag (VecDivOp FloatVec 2 W64) = 859-primOpTag (VecDivOp FloatVec 8 W32) = 860-primOpTag (VecDivOp FloatVec 4 W64) = 861-primOpTag (VecDivOp FloatVec 16 W32) = 862-primOpTag (VecDivOp FloatVec 8 W64) = 863-primOpTag (VecQuotOp IntVec 16 W8) = 864-primOpTag (VecQuotOp IntVec 8 W16) = 865-primOpTag (VecQuotOp IntVec 4 W32) = 866-primOpTag (VecQuotOp IntVec 2 W64) = 867-primOpTag (VecQuotOp IntVec 32 W8) = 868-primOpTag (VecQuotOp IntVec 16 W16) = 869-primOpTag (VecQuotOp IntVec 8 W32) = 870-primOpTag (VecQuotOp IntVec 4 W64) = 871-primOpTag (VecQuotOp IntVec 64 W8) = 872-primOpTag (VecQuotOp IntVec 32 W16) = 873-primOpTag (VecQuotOp IntVec 16 W32) = 874-primOpTag (VecQuotOp IntVec 8 W64) = 875-primOpTag (VecQuotOp WordVec 16 W8) = 876-primOpTag (VecQuotOp WordVec 8 W16) = 877-primOpTag (VecQuotOp WordVec 4 W32) = 878-primOpTag (VecQuotOp WordVec 2 W64) = 879-primOpTag (VecQuotOp WordVec 32 W8) = 880-primOpTag (VecQuotOp WordVec 16 W16) = 881-primOpTag (VecQuotOp WordVec 8 W32) = 882-primOpTag (VecQuotOp WordVec 4 W64) = 883-primOpTag (VecQuotOp WordVec 64 W8) = 884-primOpTag (VecQuotOp WordVec 32 W16) = 885-primOpTag (VecQuotOp WordVec 16 W32) = 886-primOpTag (VecQuotOp WordVec 8 W64) = 887-primOpTag (VecRemOp IntVec 16 W8) = 888-primOpTag (VecRemOp IntVec 8 W16) = 889-primOpTag (VecRemOp IntVec 4 W32) = 890-primOpTag (VecRemOp IntVec 2 W64) = 891-primOpTag (VecRemOp IntVec 32 W8) = 892-primOpTag (VecRemOp IntVec 16 W16) = 893-primOpTag (VecRemOp IntVec 8 W32) = 894-primOpTag (VecRemOp IntVec 4 W64) = 895-primOpTag (VecRemOp IntVec 64 W8) = 896-primOpTag (VecRemOp IntVec 32 W16) = 897-primOpTag (VecRemOp IntVec 16 W32) = 898-primOpTag (VecRemOp IntVec 8 W64) = 899-primOpTag (VecRemOp WordVec 16 W8) = 900-primOpTag (VecRemOp WordVec 8 W16) = 901-primOpTag (VecRemOp WordVec 4 W32) = 902-primOpTag (VecRemOp WordVec 2 W64) = 903-primOpTag (VecRemOp WordVec 32 W8) = 904-primOpTag (VecRemOp WordVec 16 W16) = 905-primOpTag (VecRemOp WordVec 8 W32) = 906-primOpTag (VecRemOp WordVec 4 W64) = 907-primOpTag (VecRemOp WordVec 64 W8) = 908-primOpTag (VecRemOp WordVec 32 W16) = 909-primOpTag (VecRemOp WordVec 16 W32) = 910-primOpTag (VecRemOp WordVec 8 W64) = 911-primOpTag (VecNegOp IntVec 16 W8) = 912-primOpTag (VecNegOp IntVec 8 W16) = 913-primOpTag (VecNegOp IntVec 4 W32) = 914-primOpTag (VecNegOp IntVec 2 W64) = 915-primOpTag (VecNegOp IntVec 32 W8) = 916-primOpTag (VecNegOp IntVec 16 W16) = 917-primOpTag (VecNegOp IntVec 8 W32) = 918-primOpTag (VecNegOp IntVec 4 W64) = 919-primOpTag (VecNegOp IntVec 64 W8) = 920-primOpTag (VecNegOp IntVec 32 W16) = 921-primOpTag (VecNegOp IntVec 16 W32) = 922-primOpTag (VecNegOp IntVec 8 W64) = 923-primOpTag (VecNegOp FloatVec 4 W32) = 924-primOpTag (VecNegOp FloatVec 2 W64) = 925-primOpTag (VecNegOp FloatVec 8 W32) = 926-primOpTag (VecNegOp FloatVec 4 W64) = 927-primOpTag (VecNegOp FloatVec 16 W32) = 928-primOpTag (VecNegOp FloatVec 8 W64) = 929-primOpTag (VecIndexByteArrayOp IntVec 16 W8) = 930-primOpTag (VecIndexByteArrayOp IntVec 8 W16) = 931-primOpTag (VecIndexByteArrayOp IntVec 4 W32) = 932-primOpTag (VecIndexByteArrayOp IntVec 2 W64) = 933-primOpTag (VecIndexByteArrayOp IntVec 32 W8) = 934-primOpTag (VecIndexByteArrayOp IntVec 16 W16) = 935-primOpTag (VecIndexByteArrayOp IntVec 8 W32) = 936-primOpTag (VecIndexByteArrayOp IntVec 4 W64) = 937-primOpTag (VecIndexByteArrayOp IntVec 64 W8) = 938-primOpTag (VecIndexByteArrayOp IntVec 32 W16) = 939-primOpTag (VecIndexByteArrayOp IntVec 16 W32) = 940-primOpTag (VecIndexByteArrayOp IntVec 8 W64) = 941-primOpTag (VecIndexByteArrayOp WordVec 16 W8) = 942-primOpTag (VecIndexByteArrayOp WordVec 8 W16) = 943-primOpTag (VecIndexByteArrayOp WordVec 4 W32) = 944-primOpTag (VecIndexByteArrayOp WordVec 2 W64) = 945-primOpTag (VecIndexByteArrayOp WordVec 32 W8) = 946-primOpTag (VecIndexByteArrayOp WordVec 16 W16) = 947-primOpTag (VecIndexByteArrayOp WordVec 8 W32) = 948-primOpTag (VecIndexByteArrayOp WordVec 4 W64) = 949-primOpTag (VecIndexByteArrayOp WordVec 64 W8) = 950-primOpTag (VecIndexByteArrayOp WordVec 32 W16) = 951-primOpTag (VecIndexByteArrayOp WordVec 16 W32) = 952-primOpTag (VecIndexByteArrayOp WordVec 8 W64) = 953-primOpTag (VecIndexByteArrayOp FloatVec 4 W32) = 954-primOpTag (VecIndexByteArrayOp FloatVec 2 W64) = 955-primOpTag (VecIndexByteArrayOp FloatVec 8 W32) = 956-primOpTag (VecIndexByteArrayOp FloatVec 4 W64) = 957-primOpTag (VecIndexByteArrayOp FloatVec 16 W32) = 958-primOpTag (VecIndexByteArrayOp FloatVec 8 W64) = 959-primOpTag (VecReadByteArrayOp IntVec 16 W8) = 960-primOpTag (VecReadByteArrayOp IntVec 8 W16) = 961-primOpTag (VecReadByteArrayOp IntVec 4 W32) = 962-primOpTag (VecReadByteArrayOp IntVec 2 W64) = 963-primOpTag (VecReadByteArrayOp IntVec 32 W8) = 964-primOpTag (VecReadByteArrayOp IntVec 16 W16) = 965-primOpTag (VecReadByteArrayOp IntVec 8 W32) = 966-primOpTag (VecReadByteArrayOp IntVec 4 W64) = 967-primOpTag (VecReadByteArrayOp IntVec 64 W8) = 968-primOpTag (VecReadByteArrayOp IntVec 32 W16) = 969-primOpTag (VecReadByteArrayOp IntVec 16 W32) = 970-primOpTag (VecReadByteArrayOp IntVec 8 W64) = 971-primOpTag (VecReadByteArrayOp WordVec 16 W8) = 972-primOpTag (VecReadByteArrayOp WordVec 8 W16) = 973-primOpTag (VecReadByteArrayOp WordVec 4 W32) = 974-primOpTag (VecReadByteArrayOp WordVec 2 W64) = 975-primOpTag (VecReadByteArrayOp WordVec 32 W8) = 976-primOpTag (VecReadByteArrayOp WordVec 16 W16) = 977-primOpTag (VecReadByteArrayOp WordVec 8 W32) = 978-primOpTag (VecReadByteArrayOp WordVec 4 W64) = 979-primOpTag (VecReadByteArrayOp WordVec 64 W8) = 980-primOpTag (VecReadByteArrayOp WordVec 32 W16) = 981-primOpTag (VecReadByteArrayOp WordVec 16 W32) = 982-primOpTag (VecReadByteArrayOp WordVec 8 W64) = 983-primOpTag (VecReadByteArrayOp FloatVec 4 W32) = 984-primOpTag (VecReadByteArrayOp FloatVec 2 W64) = 985-primOpTag (VecReadByteArrayOp FloatVec 8 W32) = 986-primOpTag (VecReadByteArrayOp FloatVec 4 W64) = 987-primOpTag (VecReadByteArrayOp FloatVec 16 W32) = 988-primOpTag (VecReadByteArrayOp FloatVec 8 W64) = 989-primOpTag (VecWriteByteArrayOp IntVec 16 W8) = 990-primOpTag (VecWriteByteArrayOp IntVec 8 W16) = 991-primOpTag (VecWriteByteArrayOp IntVec 4 W32) = 992-primOpTag (VecWriteByteArrayOp IntVec 2 W64) = 993-primOpTag (VecWriteByteArrayOp IntVec 32 W8) = 994-primOpTag (VecWriteByteArrayOp IntVec 16 W16) = 995-primOpTag (VecWriteByteArrayOp IntVec 8 W32) = 996-primOpTag (VecWriteByteArrayOp IntVec 4 W64) = 997-primOpTag (VecWriteByteArrayOp IntVec 64 W8) = 998-primOpTag (VecWriteByteArrayOp IntVec 32 W16) = 999-primOpTag (VecWriteByteArrayOp IntVec 16 W32) = 1000-primOpTag (VecWriteByteArrayOp IntVec 8 W64) = 1001-primOpTag (VecWriteByteArrayOp WordVec 16 W8) = 1002-primOpTag (VecWriteByteArrayOp WordVec 8 W16) = 1003-primOpTag (VecWriteByteArrayOp WordVec 4 W32) = 1004-primOpTag (VecWriteByteArrayOp WordVec 2 W64) = 1005-primOpTag (VecWriteByteArrayOp WordVec 32 W8) = 1006-primOpTag (VecWriteByteArrayOp WordVec 16 W16) = 1007-primOpTag (VecWriteByteArrayOp WordVec 8 W32) = 1008-primOpTag (VecWriteByteArrayOp WordVec 4 W64) = 1009-primOpTag (VecWriteByteArrayOp WordVec 64 W8) = 1010-primOpTag (VecWriteByteArrayOp WordVec 32 W16) = 1011-primOpTag (VecWriteByteArrayOp WordVec 16 W32) = 1012-primOpTag (VecWriteByteArrayOp WordVec 8 W64) = 1013-primOpTag (VecWriteByteArrayOp FloatVec 4 W32) = 1014-primOpTag (VecWriteByteArrayOp FloatVec 2 W64) = 1015-primOpTag (VecWriteByteArrayOp FloatVec 8 W32) = 1016-primOpTag (VecWriteByteArrayOp FloatVec 4 W64) = 1017-primOpTag (VecWriteByteArrayOp FloatVec 16 W32) = 1018-primOpTag (VecWriteByteArrayOp FloatVec 8 W64) = 1019-primOpTag (VecIndexOffAddrOp IntVec 16 W8) = 1020-primOpTag (VecIndexOffAddrOp IntVec 8 W16) = 1021-primOpTag (VecIndexOffAddrOp IntVec 4 W32) = 1022-primOpTag (VecIndexOffAddrOp IntVec 2 W64) = 1023-primOpTag (VecIndexOffAddrOp IntVec 32 W8) = 1024-primOpTag (VecIndexOffAddrOp IntVec 16 W16) = 1025-primOpTag (VecIndexOffAddrOp IntVec 8 W32) = 1026-primOpTag (VecIndexOffAddrOp IntVec 4 W64) = 1027-primOpTag (VecIndexOffAddrOp IntVec 64 W8) = 1028-primOpTag (VecIndexOffAddrOp IntVec 32 W16) = 1029-primOpTag (VecIndexOffAddrOp IntVec 16 W32) = 1030-primOpTag (VecIndexOffAddrOp IntVec 8 W64) = 1031-primOpTag (VecIndexOffAddrOp WordVec 16 W8) = 1032-primOpTag (VecIndexOffAddrOp WordVec 8 W16) = 1033-primOpTag (VecIndexOffAddrOp WordVec 4 W32) = 1034-primOpTag (VecIndexOffAddrOp WordVec 2 W64) = 1035-primOpTag (VecIndexOffAddrOp WordVec 32 W8) = 1036-primOpTag (VecIndexOffAddrOp WordVec 16 W16) = 1037-primOpTag (VecIndexOffAddrOp WordVec 8 W32) = 1038-primOpTag (VecIndexOffAddrOp WordVec 4 W64) = 1039-primOpTag (VecIndexOffAddrOp WordVec 64 W8) = 1040-primOpTag (VecIndexOffAddrOp WordVec 32 W16) = 1041-primOpTag (VecIndexOffAddrOp WordVec 16 W32) = 1042-primOpTag (VecIndexOffAddrOp WordVec 8 W64) = 1043-primOpTag (VecIndexOffAddrOp FloatVec 4 W32) = 1044-primOpTag (VecIndexOffAddrOp FloatVec 2 W64) = 1045-primOpTag (VecIndexOffAddrOp FloatVec 8 W32) = 1046-primOpTag (VecIndexOffAddrOp FloatVec 4 W64) = 1047-primOpTag (VecIndexOffAddrOp FloatVec 16 W32) = 1048-primOpTag (VecIndexOffAddrOp FloatVec 8 W64) = 1049-primOpTag (VecReadOffAddrOp IntVec 16 W8) = 1050-primOpTag (VecReadOffAddrOp IntVec 8 W16) = 1051-primOpTag (VecReadOffAddrOp IntVec 4 W32) = 1052-primOpTag (VecReadOffAddrOp IntVec 2 W64) = 1053-primOpTag (VecReadOffAddrOp IntVec 32 W8) = 1054-primOpTag (VecReadOffAddrOp IntVec 16 W16) = 1055-primOpTag (VecReadOffAddrOp IntVec 8 W32) = 1056-primOpTag (VecReadOffAddrOp IntVec 4 W64) = 1057-primOpTag (VecReadOffAddrOp IntVec 64 W8) = 1058-primOpTag (VecReadOffAddrOp IntVec 32 W16) = 1059-primOpTag (VecReadOffAddrOp IntVec 16 W32) = 1060-primOpTag (VecReadOffAddrOp IntVec 8 W64) = 1061-primOpTag (VecReadOffAddrOp WordVec 16 W8) = 1062-primOpTag (VecReadOffAddrOp WordVec 8 W16) = 1063-primOpTag (VecReadOffAddrOp WordVec 4 W32) = 1064-primOpTag (VecReadOffAddrOp WordVec 2 W64) = 1065-primOpTag (VecReadOffAddrOp WordVec 32 W8) = 1066-primOpTag (VecReadOffAddrOp WordVec 16 W16) = 1067-primOpTag (VecReadOffAddrOp WordVec 8 W32) = 1068-primOpTag (VecReadOffAddrOp WordVec 4 W64) = 1069-primOpTag (VecReadOffAddrOp WordVec 64 W8) = 1070-primOpTag (VecReadOffAddrOp WordVec 32 W16) = 1071-primOpTag (VecReadOffAddrOp WordVec 16 W32) = 1072-primOpTag (VecReadOffAddrOp WordVec 8 W64) = 1073-primOpTag (VecReadOffAddrOp FloatVec 4 W32) = 1074-primOpTag (VecReadOffAddrOp FloatVec 2 W64) = 1075-primOpTag (VecReadOffAddrOp FloatVec 8 W32) = 1076-primOpTag (VecReadOffAddrOp FloatVec 4 W64) = 1077-primOpTag (VecReadOffAddrOp FloatVec 16 W32) = 1078-primOpTag (VecReadOffAddrOp FloatVec 8 W64) = 1079-primOpTag (VecWriteOffAddrOp IntVec 16 W8) = 1080-primOpTag (VecWriteOffAddrOp IntVec 8 W16) = 1081-primOpTag (VecWriteOffAddrOp IntVec 4 W32) = 1082-primOpTag (VecWriteOffAddrOp IntVec 2 W64) = 1083-primOpTag (VecWriteOffAddrOp IntVec 32 W8) = 1084-primOpTag (VecWriteOffAddrOp IntVec 16 W16) = 1085-primOpTag (VecWriteOffAddrOp IntVec 8 W32) = 1086-primOpTag (VecWriteOffAddrOp IntVec 4 W64) = 1087-primOpTag (VecWriteOffAddrOp IntVec 64 W8) = 1088-primOpTag (VecWriteOffAddrOp IntVec 32 W16) = 1089-primOpTag (VecWriteOffAddrOp IntVec 16 W32) = 1090-primOpTag (VecWriteOffAddrOp IntVec 8 W64) = 1091-primOpTag (VecWriteOffAddrOp WordVec 16 W8) = 1092-primOpTag (VecWriteOffAddrOp WordVec 8 W16) = 1093-primOpTag (VecWriteOffAddrOp WordVec 4 W32) = 1094-primOpTag (VecWriteOffAddrOp WordVec 2 W64) = 1095-primOpTag (VecWriteOffAddrOp WordVec 32 W8) = 1096-primOpTag (VecWriteOffAddrOp WordVec 16 W16) = 1097-primOpTag (VecWriteOffAddrOp WordVec 8 W32) = 1098-primOpTag (VecWriteOffAddrOp WordVec 4 W64) = 1099-primOpTag (VecWriteOffAddrOp WordVec 64 W8) = 1100-primOpTag (VecWriteOffAddrOp WordVec 32 W16) = 1101-primOpTag (VecWriteOffAddrOp WordVec 16 W32) = 1102-primOpTag (VecWriteOffAddrOp WordVec 8 W64) = 1103-primOpTag (VecWriteOffAddrOp FloatVec 4 W32) = 1104-primOpTag (VecWriteOffAddrOp FloatVec 2 W64) = 1105-primOpTag (VecWriteOffAddrOp FloatVec 8 W32) = 1106-primOpTag (VecWriteOffAddrOp FloatVec 4 W64) = 1107-primOpTag (VecWriteOffAddrOp FloatVec 16 W32) = 1108-primOpTag (VecWriteOffAddrOp FloatVec 8 W64) = 1109-primOpTag (VecIndexScalarByteArrayOp IntVec 16 W8) = 1110-primOpTag (VecIndexScalarByteArrayOp IntVec 8 W16) = 1111-primOpTag (VecIndexScalarByteArrayOp IntVec 4 W32) = 1112-primOpTag (VecIndexScalarByteArrayOp IntVec 2 W64) = 1113-primOpTag (VecIndexScalarByteArrayOp IntVec 32 W8) = 1114-primOpTag (VecIndexScalarByteArrayOp IntVec 16 W16) = 1115-primOpTag (VecIndexScalarByteArrayOp IntVec 8 W32) = 1116-primOpTag (VecIndexScalarByteArrayOp IntVec 4 W64) = 1117-primOpTag (VecIndexScalarByteArrayOp IntVec 64 W8) = 1118-primOpTag (VecIndexScalarByteArrayOp IntVec 32 W16) = 1119-primOpTag (VecIndexScalarByteArrayOp IntVec 16 W32) = 1120-primOpTag (VecIndexScalarByteArrayOp IntVec 8 W64) = 1121-primOpTag (VecIndexScalarByteArrayOp WordVec 16 W8) = 1122-primOpTag (VecIndexScalarByteArrayOp WordVec 8 W16) = 1123-primOpTag (VecIndexScalarByteArrayOp WordVec 4 W32) = 1124-primOpTag (VecIndexScalarByteArrayOp WordVec 2 W64) = 1125-primOpTag (VecIndexScalarByteArrayOp WordVec 32 W8) = 1126-primOpTag (VecIndexScalarByteArrayOp WordVec 16 W16) = 1127-primOpTag (VecIndexScalarByteArrayOp WordVec 8 W32) = 1128-primOpTag (VecIndexScalarByteArrayOp WordVec 4 W64) = 1129-primOpTag (VecIndexScalarByteArrayOp WordVec 64 W8) = 1130-primOpTag (VecIndexScalarByteArrayOp WordVec 32 W16) = 1131-primOpTag (VecIndexScalarByteArrayOp WordVec 16 W32) = 1132-primOpTag (VecIndexScalarByteArrayOp WordVec 8 W64) = 1133-primOpTag (VecIndexScalarByteArrayOp FloatVec 4 W32) = 1134-primOpTag (VecIndexScalarByteArrayOp FloatVec 2 W64) = 1135-primOpTag (VecIndexScalarByteArrayOp FloatVec 8 W32) = 1136-primOpTag (VecIndexScalarByteArrayOp FloatVec 4 W64) = 1137-primOpTag (VecIndexScalarByteArrayOp FloatVec 16 W32) = 1138-primOpTag (VecIndexScalarByteArrayOp FloatVec 8 W64) = 1139-primOpTag (VecReadScalarByteArrayOp IntVec 16 W8) = 1140-primOpTag (VecReadScalarByteArrayOp IntVec 8 W16) = 1141-primOpTag (VecReadScalarByteArrayOp IntVec 4 W32) = 1142-primOpTag (VecReadScalarByteArrayOp IntVec 2 W64) = 1143-primOpTag (VecReadScalarByteArrayOp IntVec 32 W8) = 1144-primOpTag (VecReadScalarByteArrayOp IntVec 16 W16) = 1145-primOpTag (VecReadScalarByteArrayOp IntVec 8 W32) = 1146-primOpTag (VecReadScalarByteArrayOp IntVec 4 W64) = 1147-primOpTag (VecReadScalarByteArrayOp IntVec 64 W8) = 1148-primOpTag (VecReadScalarByteArrayOp IntVec 32 W16) = 1149-primOpTag (VecReadScalarByteArrayOp IntVec 16 W32) = 1150-primOpTag (VecReadScalarByteArrayOp IntVec 8 W64) = 1151-primOpTag (VecReadScalarByteArrayOp WordVec 16 W8) = 1152-primOpTag (VecReadScalarByteArrayOp WordVec 8 W16) = 1153-primOpTag (VecReadScalarByteArrayOp WordVec 4 W32) = 1154-primOpTag (VecReadScalarByteArrayOp WordVec 2 W64) = 1155-primOpTag (VecReadScalarByteArrayOp WordVec 32 W8) = 1156-primOpTag (VecReadScalarByteArrayOp WordVec 16 W16) = 1157-primOpTag (VecReadScalarByteArrayOp WordVec 8 W32) = 1158-primOpTag (VecReadScalarByteArrayOp WordVec 4 W64) = 1159-primOpTag (VecReadScalarByteArrayOp WordVec 64 W8) = 1160-primOpTag (VecReadScalarByteArrayOp WordVec 32 W16) = 1161-primOpTag (VecReadScalarByteArrayOp WordVec 16 W32) = 1162-primOpTag (VecReadScalarByteArrayOp WordVec 8 W64) = 1163-primOpTag (VecReadScalarByteArrayOp FloatVec 4 W32) = 1164-primOpTag (VecReadScalarByteArrayOp FloatVec 2 W64) = 1165-primOpTag (VecReadScalarByteArrayOp FloatVec 8 W32) = 1166-primOpTag (VecReadScalarByteArrayOp FloatVec 4 W64) = 1167-primOpTag (VecReadScalarByteArrayOp FloatVec 16 W32) = 1168-primOpTag (VecReadScalarByteArrayOp FloatVec 8 W64) = 1169-primOpTag (VecWriteScalarByteArrayOp IntVec 16 W8) = 1170-primOpTag (VecWriteScalarByteArrayOp IntVec 8 W16) = 1171-primOpTag (VecWriteScalarByteArrayOp IntVec 4 W32) = 1172-primOpTag (VecWriteScalarByteArrayOp IntVec 2 W64) = 1173-primOpTag (VecWriteScalarByteArrayOp IntVec 32 W8) = 1174-primOpTag (VecWriteScalarByteArrayOp IntVec 16 W16) = 1175-primOpTag (VecWriteScalarByteArrayOp IntVec 8 W32) = 1176-primOpTag (VecWriteScalarByteArrayOp IntVec 4 W64) = 1177-primOpTag (VecWriteScalarByteArrayOp IntVec 64 W8) = 1178-primOpTag (VecWriteScalarByteArrayOp IntVec 32 W16) = 1179-primOpTag (VecWriteScalarByteArrayOp IntVec 16 W32) = 1180-primOpTag (VecWriteScalarByteArrayOp IntVec 8 W64) = 1181-primOpTag (VecWriteScalarByteArrayOp WordVec 16 W8) = 1182-primOpTag (VecWriteScalarByteArrayOp WordVec 8 W16) = 1183-primOpTag (VecWriteScalarByteArrayOp WordVec 4 W32) = 1184-primOpTag (VecWriteScalarByteArrayOp WordVec 2 W64) = 1185-primOpTag (VecWriteScalarByteArrayOp WordVec 32 W8) = 1186-primOpTag (VecWriteScalarByteArrayOp WordVec 16 W16) = 1187-primOpTag (VecWriteScalarByteArrayOp WordVec 8 W32) = 1188-primOpTag (VecWriteScalarByteArrayOp WordVec 4 W64) = 1189-primOpTag (VecWriteScalarByteArrayOp WordVec 64 W8) = 1190-primOpTag (VecWriteScalarByteArrayOp WordVec 32 W16) = 1191-primOpTag (VecWriteScalarByteArrayOp WordVec 16 W32) = 1192-primOpTag (VecWriteScalarByteArrayOp WordVec 8 W64) = 1193-primOpTag (VecWriteScalarByteArrayOp FloatVec 4 W32) = 1194-primOpTag (VecWriteScalarByteArrayOp FloatVec 2 W64) = 1195-primOpTag (VecWriteScalarByteArrayOp FloatVec 8 W32) = 1196-primOpTag (VecWriteScalarByteArrayOp FloatVec 4 W64) = 1197-primOpTag (VecWriteScalarByteArrayOp FloatVec 16 W32) = 1198-primOpTag (VecWriteScalarByteArrayOp FloatVec 8 W64) = 1199-primOpTag (VecIndexScalarOffAddrOp IntVec 16 W8) = 1200-primOpTag (VecIndexScalarOffAddrOp IntVec 8 W16) = 1201-primOpTag (VecIndexScalarOffAddrOp IntVec 4 W32) = 1202-primOpTag (VecIndexScalarOffAddrOp IntVec 2 W64) = 1203-primOpTag (VecIndexScalarOffAddrOp IntVec 32 W8) = 1204-primOpTag (VecIndexScalarOffAddrOp IntVec 16 W16) = 1205-primOpTag (VecIndexScalarOffAddrOp IntVec 8 W32) = 1206-primOpTag (VecIndexScalarOffAddrOp IntVec 4 W64) = 1207-primOpTag (VecIndexScalarOffAddrOp IntVec 64 W8) = 1208-primOpTag (VecIndexScalarOffAddrOp IntVec 32 W16) = 1209-primOpTag (VecIndexScalarOffAddrOp IntVec 16 W32) = 1210-primOpTag (VecIndexScalarOffAddrOp IntVec 8 W64) = 1211-primOpTag (VecIndexScalarOffAddrOp WordVec 16 W8) = 1212-primOpTag (VecIndexScalarOffAddrOp WordVec 8 W16) = 1213-primOpTag (VecIndexScalarOffAddrOp WordVec 4 W32) = 1214-primOpTag (VecIndexScalarOffAddrOp WordVec 2 W64) = 1215-primOpTag (VecIndexScalarOffAddrOp WordVec 32 W8) = 1216-primOpTag (VecIndexScalarOffAddrOp WordVec 16 W16) = 1217-primOpTag (VecIndexScalarOffAddrOp WordVec 8 W32) = 1218-primOpTag (VecIndexScalarOffAddrOp WordVec 4 W64) = 1219-primOpTag (VecIndexScalarOffAddrOp WordVec 64 W8) = 1220-primOpTag (VecIndexScalarOffAddrOp WordVec 32 W16) = 1221-primOpTag (VecIndexScalarOffAddrOp WordVec 16 W32) = 1222-primOpTag (VecIndexScalarOffAddrOp WordVec 8 W64) = 1223-primOpTag (VecIndexScalarOffAddrOp FloatVec 4 W32) = 1224-primOpTag (VecIndexScalarOffAddrOp FloatVec 2 W64) = 1225-primOpTag (VecIndexScalarOffAddrOp FloatVec 8 W32) = 1226-primOpTag (VecIndexScalarOffAddrOp FloatVec 4 W64) = 1227-primOpTag (VecIndexScalarOffAddrOp FloatVec 16 W32) = 1228-primOpTag (VecIndexScalarOffAddrOp FloatVec 8 W64) = 1229-primOpTag (VecReadScalarOffAddrOp IntVec 16 W8) = 1230-primOpTag (VecReadScalarOffAddrOp IntVec 8 W16) = 1231-primOpTag (VecReadScalarOffAddrOp IntVec 4 W32) = 1232-primOpTag (VecReadScalarOffAddrOp IntVec 2 W64) = 1233-primOpTag (VecReadScalarOffAddrOp IntVec 32 W8) = 1234-primOpTag (VecReadScalarOffAddrOp IntVec 16 W16) = 1235-primOpTag (VecReadScalarOffAddrOp IntVec 8 W32) = 1236-primOpTag (VecReadScalarOffAddrOp IntVec 4 W64) = 1237-primOpTag (VecReadScalarOffAddrOp IntVec 64 W8) = 1238-primOpTag (VecReadScalarOffAddrOp IntVec 32 W16) = 1239-primOpTag (VecReadScalarOffAddrOp IntVec 16 W32) = 1240-primOpTag (VecReadScalarOffAddrOp IntVec 8 W64) = 1241-primOpTag (VecReadScalarOffAddrOp WordVec 16 W8) = 1242-primOpTag (VecReadScalarOffAddrOp WordVec 8 W16) = 1243-primOpTag (VecReadScalarOffAddrOp WordVec 4 W32) = 1244-primOpTag (VecReadScalarOffAddrOp WordVec 2 W64) = 1245-primOpTag (VecReadScalarOffAddrOp WordVec 32 W8) = 1246-primOpTag (VecReadScalarOffAddrOp WordVec 16 W16) = 1247-primOpTag (VecReadScalarOffAddrOp WordVec 8 W32) = 1248-primOpTag (VecReadScalarOffAddrOp WordVec 4 W64) = 1249-primOpTag (VecReadScalarOffAddrOp WordVec 64 W8) = 1250-primOpTag (VecReadScalarOffAddrOp WordVec 32 W16) = 1251-primOpTag (VecReadScalarOffAddrOp WordVec 16 W32) = 1252-primOpTag (VecReadScalarOffAddrOp WordVec 8 W64) = 1253-primOpTag (VecReadScalarOffAddrOp FloatVec 4 W32) = 1254-primOpTag (VecReadScalarOffAddrOp FloatVec 2 W64) = 1255-primOpTag (VecReadScalarOffAddrOp FloatVec 8 W32) = 1256-primOpTag (VecReadScalarOffAddrOp FloatVec 4 W64) = 1257-primOpTag (VecReadScalarOffAddrOp FloatVec 16 W32) = 1258-primOpTag (VecReadScalarOffAddrOp FloatVec 8 W64) = 1259-primOpTag (VecWriteScalarOffAddrOp IntVec 16 W8) = 1260-primOpTag (VecWriteScalarOffAddrOp IntVec 8 W16) = 1261-primOpTag (VecWriteScalarOffAddrOp IntVec 4 W32) = 1262-primOpTag (VecWriteScalarOffAddrOp IntVec 2 W64) = 1263-primOpTag (VecWriteScalarOffAddrOp IntVec 32 W8) = 1264-primOpTag (VecWriteScalarOffAddrOp IntVec 16 W16) = 1265-primOpTag (VecWriteScalarOffAddrOp IntVec 8 W32) = 1266-primOpTag (VecWriteScalarOffAddrOp IntVec 4 W64) = 1267-primOpTag (VecWriteScalarOffAddrOp IntVec 64 W8) = 1268-primOpTag (VecWriteScalarOffAddrOp IntVec 32 W16) = 1269-primOpTag (VecWriteScalarOffAddrOp IntVec 16 W32) = 1270-primOpTag (VecWriteScalarOffAddrOp IntVec 8 W64) = 1271-primOpTag (VecWriteScalarOffAddrOp WordVec 16 W8) = 1272-primOpTag (VecWriteScalarOffAddrOp WordVec 8 W16) = 1273-primOpTag (VecWriteScalarOffAddrOp WordVec 4 W32) = 1274-primOpTag (VecWriteScalarOffAddrOp WordVec 2 W64) = 1275-primOpTag (VecWriteScalarOffAddrOp WordVec 32 W8) = 1276-primOpTag (VecWriteScalarOffAddrOp WordVec 16 W16) = 1277-primOpTag (VecWriteScalarOffAddrOp WordVec 8 W32) = 1278-primOpTag (VecWriteScalarOffAddrOp WordVec 4 W64) = 1279-primOpTag (VecWriteScalarOffAddrOp WordVec 64 W8) = 1280-primOpTag (VecWriteScalarOffAddrOp WordVec 32 W16) = 1281-primOpTag (VecWriteScalarOffAddrOp WordVec 16 W32) = 1282-primOpTag (VecWriteScalarOffAddrOp WordVec 8 W64) = 1283-primOpTag (VecWriteScalarOffAddrOp FloatVec 4 W32) = 1284-primOpTag (VecWriteScalarOffAddrOp FloatVec 2 W64) = 1285-primOpTag (VecWriteScalarOffAddrOp FloatVec 8 W32) = 1286-primOpTag (VecWriteScalarOffAddrOp FloatVec 4 W64) = 1287-primOpTag (VecWriteScalarOffAddrOp FloatVec 16 W32) = 1288-primOpTag (VecWriteScalarOffAddrOp FloatVec 8 W64) = 1289-primOpTag PrefetchByteArrayOp3 = 1290-primOpTag PrefetchMutableByteArrayOp3 = 1291-primOpTag PrefetchAddrOp3 = 1292-primOpTag PrefetchValueOp3 = 1293-primOpTag PrefetchByteArrayOp2 = 1294-primOpTag PrefetchMutableByteArrayOp2 = 1295-primOpTag PrefetchAddrOp2 = 1296-primOpTag PrefetchValueOp2 = 1297-primOpTag PrefetchByteArrayOp1 = 1298-primOpTag PrefetchMutableByteArrayOp1 = 1299-primOpTag PrefetchAddrOp1 = 1300-primOpTag PrefetchValueOp1 = 1301-primOpTag PrefetchByteArrayOp0 = 1302-primOpTag PrefetchMutableByteArrayOp0 = 1303-primOpTag PrefetchAddrOp0 = 1304-primOpTag PrefetchValueOp0 = 1305+maxPrimOpTag = 1308+primOpTag :: PrimOp -> Int+primOpTag CharGtOp = 0+primOpTag CharGeOp = 1+primOpTag CharEqOp = 2+primOpTag CharNeOp = 3+primOpTag CharLtOp = 4+primOpTag CharLeOp = 5+primOpTag OrdOp = 6+primOpTag Int8ToIntOp = 7+primOpTag IntToInt8Op = 8+primOpTag Int8NegOp = 9+primOpTag Int8AddOp = 10+primOpTag Int8SubOp = 11+primOpTag Int8MulOp = 12+primOpTag Int8QuotOp = 13+primOpTag Int8RemOp = 14+primOpTag Int8QuotRemOp = 15+primOpTag Int8SllOp = 16+primOpTag Int8SraOp = 17+primOpTag Int8SrlOp = 18+primOpTag Int8ToWord8Op = 19+primOpTag Int8EqOp = 20+primOpTag Int8GeOp = 21+primOpTag Int8GtOp = 22+primOpTag Int8LeOp = 23+primOpTag Int8LtOp = 24+primOpTag Int8NeOp = 25+primOpTag Word8ToWordOp = 26+primOpTag WordToWord8Op = 27+primOpTag Word8AddOp = 28+primOpTag Word8SubOp = 29+primOpTag Word8MulOp = 30+primOpTag Word8QuotOp = 31+primOpTag Word8RemOp = 32+primOpTag Word8QuotRemOp = 33+primOpTag Word8AndOp = 34+primOpTag Word8OrOp = 35+primOpTag Word8XorOp = 36+primOpTag Word8NotOp = 37+primOpTag Word8SllOp = 38+primOpTag Word8SrlOp = 39+primOpTag Word8ToInt8Op = 40+primOpTag Word8EqOp = 41+primOpTag Word8GeOp = 42+primOpTag Word8GtOp = 43+primOpTag Word8LeOp = 44+primOpTag Word8LtOp = 45+primOpTag Word8NeOp = 46+primOpTag Int16ToIntOp = 47+primOpTag IntToInt16Op = 48+primOpTag Int16NegOp = 49+primOpTag Int16AddOp = 50+primOpTag Int16SubOp = 51+primOpTag Int16MulOp = 52+primOpTag Int16QuotOp = 53+primOpTag Int16RemOp = 54+primOpTag Int16QuotRemOp = 55+primOpTag Int16SllOp = 56+primOpTag Int16SraOp = 57+primOpTag Int16SrlOp = 58+primOpTag Int16ToWord16Op = 59+primOpTag Int16EqOp = 60+primOpTag Int16GeOp = 61+primOpTag Int16GtOp = 62+primOpTag Int16LeOp = 63+primOpTag Int16LtOp = 64+primOpTag Int16NeOp = 65+primOpTag Word16ToWordOp = 66+primOpTag WordToWord16Op = 67+primOpTag Word16AddOp = 68+primOpTag Word16SubOp = 69+primOpTag Word16MulOp = 70+primOpTag Word16QuotOp = 71+primOpTag Word16RemOp = 72+primOpTag Word16QuotRemOp = 73+primOpTag Word16AndOp = 74+primOpTag Word16OrOp = 75+primOpTag Word16XorOp = 76+primOpTag Word16NotOp = 77+primOpTag Word16SllOp = 78+primOpTag Word16SrlOp = 79+primOpTag Word16ToInt16Op = 80+primOpTag Word16EqOp = 81+primOpTag Word16GeOp = 82+primOpTag Word16GtOp = 83+primOpTag Word16LeOp = 84+primOpTag Word16LtOp = 85+primOpTag Word16NeOp = 86+primOpTag Int32ToIntOp = 87+primOpTag IntToInt32Op = 88+primOpTag Int32NegOp = 89+primOpTag Int32AddOp = 90+primOpTag Int32SubOp = 91+primOpTag Int32MulOp = 92+primOpTag Int32QuotOp = 93+primOpTag Int32RemOp = 94+primOpTag Int32QuotRemOp = 95+primOpTag Int32SllOp = 96+primOpTag Int32SraOp = 97+primOpTag Int32SrlOp = 98+primOpTag Int32ToWord32Op = 99+primOpTag Int32EqOp = 100+primOpTag Int32GeOp = 101+primOpTag Int32GtOp = 102+primOpTag Int32LeOp = 103+primOpTag Int32LtOp = 104+primOpTag Int32NeOp = 105+primOpTag Word32ToWordOp = 106+primOpTag WordToWord32Op = 107+primOpTag Word32AddOp = 108+primOpTag Word32SubOp = 109+primOpTag Word32MulOp = 110+primOpTag Word32QuotOp = 111+primOpTag Word32RemOp = 112+primOpTag Word32QuotRemOp = 113+primOpTag Word32AndOp = 114+primOpTag Word32OrOp = 115+primOpTag Word32XorOp = 116+primOpTag Word32NotOp = 117+primOpTag Word32SllOp = 118+primOpTag Word32SrlOp = 119+primOpTag Word32ToInt32Op = 120+primOpTag Word32EqOp = 121+primOpTag Word32GeOp = 122+primOpTag Word32GtOp = 123+primOpTag Word32LeOp = 124+primOpTag Word32LtOp = 125+primOpTag Word32NeOp = 126+primOpTag Int64ToIntOp = 127+primOpTag IntToInt64Op = 128+primOpTag Int64NegOp = 129+primOpTag Int64AddOp = 130+primOpTag Int64SubOp = 131+primOpTag Int64MulOp = 132+primOpTag Int64QuotOp = 133+primOpTag Int64RemOp = 134+primOpTag Int64SllOp = 135+primOpTag Int64SraOp = 136+primOpTag Int64SrlOp = 137+primOpTag Int64ToWord64Op = 138+primOpTag Int64EqOp = 139+primOpTag Int64GeOp = 140+primOpTag Int64GtOp = 141+primOpTag Int64LeOp = 142+primOpTag Int64LtOp = 143+primOpTag Int64NeOp = 144+primOpTag Word64ToWordOp = 145+primOpTag WordToWord64Op = 146+primOpTag Word64AddOp = 147+primOpTag Word64SubOp = 148+primOpTag Word64MulOp = 149+primOpTag Word64QuotOp = 150+primOpTag Word64RemOp = 151+primOpTag Word64AndOp = 152+primOpTag Word64OrOp = 153+primOpTag Word64XorOp = 154+primOpTag Word64NotOp = 155+primOpTag Word64SllOp = 156+primOpTag Word64SrlOp = 157+primOpTag Word64ToInt64Op = 158+primOpTag Word64EqOp = 159+primOpTag Word64GeOp = 160+primOpTag Word64GtOp = 161+primOpTag Word64LeOp = 162+primOpTag Word64LtOp = 163+primOpTag Word64NeOp = 164+primOpTag IntAddOp = 165+primOpTag IntSubOp = 166+primOpTag IntMulOp = 167+primOpTag IntMul2Op = 168+primOpTag IntMulMayOfloOp = 169+primOpTag IntQuotOp = 170+primOpTag IntRemOp = 171+primOpTag IntQuotRemOp = 172+primOpTag IntAndOp = 173+primOpTag IntOrOp = 174+primOpTag IntXorOp = 175+primOpTag IntNotOp = 176+primOpTag IntNegOp = 177+primOpTag IntAddCOp = 178+primOpTag IntSubCOp = 179+primOpTag IntGtOp = 180+primOpTag IntGeOp = 181+primOpTag IntEqOp = 182+primOpTag IntNeOp = 183+primOpTag IntLtOp = 184+primOpTag IntLeOp = 185+primOpTag ChrOp = 186+primOpTag IntToWordOp = 187+primOpTag IntToFloatOp = 188+primOpTag IntToDoubleOp = 189+primOpTag WordToFloatOp = 190+primOpTag WordToDoubleOp = 191+primOpTag IntSllOp = 192+primOpTag IntSraOp = 193+primOpTag IntSrlOp = 194+primOpTag WordAddOp = 195+primOpTag WordAddCOp = 196+primOpTag WordSubCOp = 197+primOpTag WordAdd2Op = 198+primOpTag WordSubOp = 199+primOpTag WordMulOp = 200+primOpTag WordMul2Op = 201+primOpTag WordQuotOp = 202+primOpTag WordRemOp = 203+primOpTag WordQuotRemOp = 204+primOpTag WordQuotRem2Op = 205+primOpTag WordAndOp = 206+primOpTag WordOrOp = 207+primOpTag WordXorOp = 208+primOpTag WordNotOp = 209+primOpTag WordSllOp = 210+primOpTag WordSrlOp = 211+primOpTag WordToIntOp = 212+primOpTag WordGtOp = 213+primOpTag WordGeOp = 214+primOpTag WordEqOp = 215+primOpTag WordNeOp = 216+primOpTag WordLtOp = 217+primOpTag WordLeOp = 218+primOpTag PopCnt8Op = 219+primOpTag PopCnt16Op = 220+primOpTag PopCnt32Op = 221+primOpTag PopCnt64Op = 222+primOpTag PopCntOp = 223+primOpTag Pdep8Op = 224+primOpTag Pdep16Op = 225+primOpTag Pdep32Op = 226+primOpTag Pdep64Op = 227+primOpTag PdepOp = 228+primOpTag Pext8Op = 229+primOpTag Pext16Op = 230+primOpTag Pext32Op = 231+primOpTag Pext64Op = 232+primOpTag PextOp = 233+primOpTag Clz8Op = 234+primOpTag Clz16Op = 235+primOpTag Clz32Op = 236+primOpTag Clz64Op = 237+primOpTag ClzOp = 238+primOpTag Ctz8Op = 239+primOpTag Ctz16Op = 240+primOpTag Ctz32Op = 241+primOpTag Ctz64Op = 242+primOpTag CtzOp = 243+primOpTag BSwap16Op = 244+primOpTag BSwap32Op = 245+primOpTag BSwap64Op = 246+primOpTag BSwapOp = 247+primOpTag BRev8Op = 248+primOpTag BRev16Op = 249+primOpTag BRev32Op = 250+primOpTag BRev64Op = 251+primOpTag BRevOp = 252+primOpTag Narrow8IntOp = 253+primOpTag Narrow16IntOp = 254+primOpTag Narrow32IntOp = 255+primOpTag Narrow8WordOp = 256+primOpTag Narrow16WordOp = 257+primOpTag Narrow32WordOp = 258+primOpTag DoubleGtOp = 259+primOpTag DoubleGeOp = 260+primOpTag DoubleEqOp = 261+primOpTag DoubleNeOp = 262+primOpTag DoubleLtOp = 263+primOpTag DoubleLeOp = 264+primOpTag DoubleAddOp = 265+primOpTag DoubleSubOp = 266+primOpTag DoubleMulOp = 267+primOpTag DoubleDivOp = 268+primOpTag DoubleNegOp = 269+primOpTag DoubleFabsOp = 270+primOpTag DoubleToIntOp = 271+primOpTag DoubleToFloatOp = 272+primOpTag DoubleExpOp = 273+primOpTag DoubleExpM1Op = 274+primOpTag DoubleLogOp = 275+primOpTag DoubleLog1POp = 276+primOpTag DoubleSqrtOp = 277+primOpTag DoubleSinOp = 278+primOpTag DoubleCosOp = 279+primOpTag DoubleTanOp = 280+primOpTag DoubleAsinOp = 281+primOpTag DoubleAcosOp = 282+primOpTag DoubleAtanOp = 283+primOpTag DoubleSinhOp = 284+primOpTag DoubleCoshOp = 285+primOpTag DoubleTanhOp = 286+primOpTag DoubleAsinhOp = 287+primOpTag DoubleAcoshOp = 288+primOpTag DoubleAtanhOp = 289+primOpTag DoublePowerOp = 290+primOpTag DoubleDecode_2IntOp = 291+primOpTag DoubleDecode_Int64Op = 292+primOpTag FloatGtOp = 293+primOpTag FloatGeOp = 294+primOpTag FloatEqOp = 295+primOpTag FloatNeOp = 296+primOpTag FloatLtOp = 297+primOpTag FloatLeOp = 298+primOpTag FloatAddOp = 299+primOpTag FloatSubOp = 300+primOpTag FloatMulOp = 301+primOpTag FloatDivOp = 302+primOpTag FloatNegOp = 303+primOpTag FloatFabsOp = 304+primOpTag FloatToIntOp = 305+primOpTag FloatExpOp = 306+primOpTag FloatExpM1Op = 307+primOpTag FloatLogOp = 308+primOpTag FloatLog1POp = 309+primOpTag FloatSqrtOp = 310+primOpTag FloatSinOp = 311+primOpTag FloatCosOp = 312+primOpTag FloatTanOp = 313+primOpTag FloatAsinOp = 314+primOpTag FloatAcosOp = 315+primOpTag FloatAtanOp = 316+primOpTag FloatSinhOp = 317+primOpTag FloatCoshOp = 318+primOpTag FloatTanhOp = 319+primOpTag FloatAsinhOp = 320+primOpTag FloatAcoshOp = 321+primOpTag FloatAtanhOp = 322+primOpTag FloatPowerOp = 323+primOpTag FloatToDoubleOp = 324+primOpTag FloatDecode_IntOp = 325+primOpTag NewArrayOp = 326+primOpTag ReadArrayOp = 327+primOpTag WriteArrayOp = 328+primOpTag SizeofArrayOp = 329+primOpTag SizeofMutableArrayOp = 330+primOpTag IndexArrayOp = 331+primOpTag UnsafeFreezeArrayOp = 332+primOpTag UnsafeThawArrayOp = 333+primOpTag CopyArrayOp = 334+primOpTag CopyMutableArrayOp = 335+primOpTag CloneArrayOp = 336+primOpTag CloneMutableArrayOp = 337+primOpTag FreezeArrayOp = 338+primOpTag ThawArrayOp = 339+primOpTag CasArrayOp = 340+primOpTag NewSmallArrayOp = 341+primOpTag ShrinkSmallMutableArrayOp_Char = 342+primOpTag ReadSmallArrayOp = 343+primOpTag WriteSmallArrayOp = 344+primOpTag SizeofSmallArrayOp = 345+primOpTag SizeofSmallMutableArrayOp = 346+primOpTag GetSizeofSmallMutableArrayOp = 347+primOpTag IndexSmallArrayOp = 348+primOpTag UnsafeFreezeSmallArrayOp = 349+primOpTag UnsafeThawSmallArrayOp = 350+primOpTag CopySmallArrayOp = 351+primOpTag CopySmallMutableArrayOp = 352+primOpTag CloneSmallArrayOp = 353+primOpTag CloneSmallMutableArrayOp = 354+primOpTag FreezeSmallArrayOp = 355+primOpTag ThawSmallArrayOp = 356+primOpTag CasSmallArrayOp = 357+primOpTag NewByteArrayOp_Char = 358+primOpTag NewPinnedByteArrayOp_Char = 359+primOpTag NewAlignedPinnedByteArrayOp_Char = 360+primOpTag MutableByteArrayIsPinnedOp = 361+primOpTag ByteArrayIsPinnedOp = 362+primOpTag ByteArrayContents_Char = 363+primOpTag MutableByteArrayContents_Char = 364+primOpTag ShrinkMutableByteArrayOp_Char = 365+primOpTag ResizeMutableByteArrayOp_Char = 366+primOpTag UnsafeFreezeByteArrayOp = 367+primOpTag SizeofByteArrayOp = 368+primOpTag SizeofMutableByteArrayOp = 369+primOpTag GetSizeofMutableByteArrayOp = 370+primOpTag IndexByteArrayOp_Char = 371+primOpTag IndexByteArrayOp_WideChar = 372+primOpTag IndexByteArrayOp_Int = 373+primOpTag IndexByteArrayOp_Word = 374+primOpTag IndexByteArrayOp_Addr = 375+primOpTag IndexByteArrayOp_Float = 376+primOpTag IndexByteArrayOp_Double = 377+primOpTag IndexByteArrayOp_StablePtr = 378+primOpTag IndexByteArrayOp_Int8 = 379+primOpTag IndexByteArrayOp_Int16 = 380+primOpTag IndexByteArrayOp_Int32 = 381+primOpTag IndexByteArrayOp_Int64 = 382+primOpTag IndexByteArrayOp_Word8 = 383+primOpTag IndexByteArrayOp_Word16 = 384+primOpTag IndexByteArrayOp_Word32 = 385+primOpTag IndexByteArrayOp_Word64 = 386+primOpTag IndexByteArrayOp_Word8AsChar = 387+primOpTag IndexByteArrayOp_Word8AsWideChar = 388+primOpTag IndexByteArrayOp_Word8AsInt = 389+primOpTag IndexByteArrayOp_Word8AsWord = 390+primOpTag IndexByteArrayOp_Word8AsAddr = 391+primOpTag IndexByteArrayOp_Word8AsFloat = 392+primOpTag IndexByteArrayOp_Word8AsDouble = 393+primOpTag IndexByteArrayOp_Word8AsStablePtr = 394+primOpTag IndexByteArrayOp_Word8AsInt16 = 395+primOpTag IndexByteArrayOp_Word8AsInt32 = 396+primOpTag IndexByteArrayOp_Word8AsInt64 = 397+primOpTag IndexByteArrayOp_Word8AsWord16 = 398+primOpTag IndexByteArrayOp_Word8AsWord32 = 399+primOpTag IndexByteArrayOp_Word8AsWord64 = 400+primOpTag ReadByteArrayOp_Char = 401+primOpTag ReadByteArrayOp_WideChar = 402+primOpTag ReadByteArrayOp_Int = 403+primOpTag ReadByteArrayOp_Word = 404+primOpTag ReadByteArrayOp_Addr = 405+primOpTag ReadByteArrayOp_Float = 406+primOpTag ReadByteArrayOp_Double = 407+primOpTag ReadByteArrayOp_StablePtr = 408+primOpTag ReadByteArrayOp_Int8 = 409+primOpTag ReadByteArrayOp_Int16 = 410+primOpTag ReadByteArrayOp_Int32 = 411+primOpTag ReadByteArrayOp_Int64 = 412+primOpTag ReadByteArrayOp_Word8 = 413+primOpTag ReadByteArrayOp_Word16 = 414+primOpTag ReadByteArrayOp_Word32 = 415+primOpTag ReadByteArrayOp_Word64 = 416+primOpTag ReadByteArrayOp_Word8AsChar = 417+primOpTag ReadByteArrayOp_Word8AsWideChar = 418+primOpTag ReadByteArrayOp_Word8AsInt = 419+primOpTag ReadByteArrayOp_Word8AsWord = 420+primOpTag ReadByteArrayOp_Word8AsAddr = 421+primOpTag ReadByteArrayOp_Word8AsFloat = 422+primOpTag ReadByteArrayOp_Word8AsDouble = 423+primOpTag ReadByteArrayOp_Word8AsStablePtr = 424+primOpTag ReadByteArrayOp_Word8AsInt16 = 425+primOpTag ReadByteArrayOp_Word8AsInt32 = 426+primOpTag ReadByteArrayOp_Word8AsInt64 = 427+primOpTag ReadByteArrayOp_Word8AsWord16 = 428+primOpTag ReadByteArrayOp_Word8AsWord32 = 429+primOpTag ReadByteArrayOp_Word8AsWord64 = 430+primOpTag WriteByteArrayOp_Char = 431+primOpTag WriteByteArrayOp_WideChar = 432+primOpTag WriteByteArrayOp_Int = 433+primOpTag WriteByteArrayOp_Word = 434+primOpTag WriteByteArrayOp_Addr = 435+primOpTag WriteByteArrayOp_Float = 436+primOpTag WriteByteArrayOp_Double = 437+primOpTag WriteByteArrayOp_StablePtr = 438+primOpTag WriteByteArrayOp_Int8 = 439+primOpTag WriteByteArrayOp_Int16 = 440+primOpTag WriteByteArrayOp_Int32 = 441+primOpTag WriteByteArrayOp_Int64 = 442+primOpTag WriteByteArrayOp_Word8 = 443+primOpTag WriteByteArrayOp_Word16 = 444+primOpTag WriteByteArrayOp_Word32 = 445+primOpTag WriteByteArrayOp_Word64 = 446+primOpTag WriteByteArrayOp_Word8AsChar = 447+primOpTag WriteByteArrayOp_Word8AsWideChar = 448+primOpTag WriteByteArrayOp_Word8AsInt = 449+primOpTag WriteByteArrayOp_Word8AsWord = 450+primOpTag WriteByteArrayOp_Word8AsAddr = 451+primOpTag WriteByteArrayOp_Word8AsFloat = 452+primOpTag WriteByteArrayOp_Word8AsDouble = 453+primOpTag WriteByteArrayOp_Word8AsStablePtr = 454+primOpTag WriteByteArrayOp_Word8AsInt16 = 455+primOpTag WriteByteArrayOp_Word8AsInt32 = 456+primOpTag WriteByteArrayOp_Word8AsInt64 = 457+primOpTag WriteByteArrayOp_Word8AsWord16 = 458+primOpTag WriteByteArrayOp_Word8AsWord32 = 459+primOpTag WriteByteArrayOp_Word8AsWord64 = 460+primOpTag CompareByteArraysOp = 461+primOpTag CopyByteArrayOp = 462+primOpTag CopyMutableByteArrayOp = 463+primOpTag CopyByteArrayToAddrOp = 464+primOpTag CopyMutableByteArrayToAddrOp = 465+primOpTag CopyAddrToByteArrayOp = 466+primOpTag SetByteArrayOp = 467+primOpTag AtomicReadByteArrayOp_Int = 468+primOpTag AtomicWriteByteArrayOp_Int = 469+primOpTag CasByteArrayOp_Int = 470+primOpTag CasByteArrayOp_Int8 = 471+primOpTag CasByteArrayOp_Int16 = 472+primOpTag CasByteArrayOp_Int32 = 473+primOpTag CasByteArrayOp_Int64 = 474+primOpTag FetchAddByteArrayOp_Int = 475+primOpTag FetchSubByteArrayOp_Int = 476+primOpTag FetchAndByteArrayOp_Int = 477+primOpTag FetchNandByteArrayOp_Int = 478+primOpTag FetchOrByteArrayOp_Int = 479+primOpTag FetchXorByteArrayOp_Int = 480+primOpTag AddrAddOp = 481+primOpTag AddrSubOp = 482+primOpTag AddrRemOp = 483+primOpTag AddrToIntOp = 484+primOpTag IntToAddrOp = 485+primOpTag AddrGtOp = 486+primOpTag AddrGeOp = 487+primOpTag AddrEqOp = 488+primOpTag AddrNeOp = 489+primOpTag AddrLtOp = 490+primOpTag AddrLeOp = 491+primOpTag IndexOffAddrOp_Char = 492+primOpTag IndexOffAddrOp_WideChar = 493+primOpTag IndexOffAddrOp_Int = 494+primOpTag IndexOffAddrOp_Word = 495+primOpTag IndexOffAddrOp_Addr = 496+primOpTag IndexOffAddrOp_Float = 497+primOpTag IndexOffAddrOp_Double = 498+primOpTag IndexOffAddrOp_StablePtr = 499+primOpTag IndexOffAddrOp_Int8 = 500+primOpTag IndexOffAddrOp_Int16 = 501+primOpTag IndexOffAddrOp_Int32 = 502+primOpTag IndexOffAddrOp_Int64 = 503+primOpTag IndexOffAddrOp_Word8 = 504+primOpTag IndexOffAddrOp_Word16 = 505+primOpTag IndexOffAddrOp_Word32 = 506+primOpTag IndexOffAddrOp_Word64 = 507+primOpTag ReadOffAddrOp_Char = 508+primOpTag ReadOffAddrOp_WideChar = 509+primOpTag ReadOffAddrOp_Int = 510+primOpTag ReadOffAddrOp_Word = 511+primOpTag ReadOffAddrOp_Addr = 512+primOpTag ReadOffAddrOp_Float = 513+primOpTag ReadOffAddrOp_Double = 514+primOpTag ReadOffAddrOp_StablePtr = 515+primOpTag ReadOffAddrOp_Int8 = 516+primOpTag ReadOffAddrOp_Int16 = 517+primOpTag ReadOffAddrOp_Int32 = 518+primOpTag ReadOffAddrOp_Int64 = 519+primOpTag ReadOffAddrOp_Word8 = 520+primOpTag ReadOffAddrOp_Word16 = 521+primOpTag ReadOffAddrOp_Word32 = 522+primOpTag ReadOffAddrOp_Word64 = 523+primOpTag WriteOffAddrOp_Char = 524+primOpTag WriteOffAddrOp_WideChar = 525+primOpTag WriteOffAddrOp_Int = 526+primOpTag WriteOffAddrOp_Word = 527+primOpTag WriteOffAddrOp_Addr = 528+primOpTag WriteOffAddrOp_Float = 529+primOpTag WriteOffAddrOp_Double = 530+primOpTag WriteOffAddrOp_StablePtr = 531+primOpTag WriteOffAddrOp_Int8 = 532+primOpTag WriteOffAddrOp_Int16 = 533+primOpTag WriteOffAddrOp_Int32 = 534+primOpTag WriteOffAddrOp_Int64 = 535+primOpTag WriteOffAddrOp_Word8 = 536+primOpTag WriteOffAddrOp_Word16 = 537+primOpTag WriteOffAddrOp_Word32 = 538+primOpTag WriteOffAddrOp_Word64 = 539+primOpTag InterlockedExchange_Addr = 540+primOpTag InterlockedExchange_Word = 541+primOpTag CasAddrOp_Addr = 542+primOpTag CasAddrOp_Word = 543+primOpTag CasAddrOp_Word8 = 544+primOpTag CasAddrOp_Word16 = 545+primOpTag CasAddrOp_Word32 = 546+primOpTag CasAddrOp_Word64 = 547+primOpTag FetchAddAddrOp_Word = 548+primOpTag FetchSubAddrOp_Word = 549+primOpTag FetchAndAddrOp_Word = 550+primOpTag FetchNandAddrOp_Word = 551+primOpTag FetchOrAddrOp_Word = 552+primOpTag FetchXorAddrOp_Word = 553+primOpTag AtomicReadAddrOp_Word = 554+primOpTag AtomicWriteAddrOp_Word = 555+primOpTag NewMutVarOp = 556+primOpTag ReadMutVarOp = 557+primOpTag WriteMutVarOp = 558+primOpTag AtomicModifyMutVar2Op = 559+primOpTag AtomicModifyMutVar_Op = 560+primOpTag CasMutVarOp = 561+primOpTag CatchOp = 562+primOpTag RaiseOp = 563+primOpTag RaiseIOOp = 564+primOpTag MaskAsyncExceptionsOp = 565+primOpTag MaskUninterruptibleOp = 566+primOpTag UnmaskAsyncExceptionsOp = 567+primOpTag MaskStatus = 568+primOpTag NewPromptTagOp = 569+primOpTag PromptOp = 570+primOpTag Control0Op = 571+primOpTag AtomicallyOp = 572+primOpTag RetryOp = 573+primOpTag CatchRetryOp = 574+primOpTag CatchSTMOp = 575+primOpTag NewTVarOp = 576+primOpTag ReadTVarOp = 577+primOpTag ReadTVarIOOp = 578+primOpTag WriteTVarOp = 579+primOpTag NewMVarOp = 580+primOpTag TakeMVarOp = 581+primOpTag TryTakeMVarOp = 582+primOpTag PutMVarOp = 583+primOpTag TryPutMVarOp = 584+primOpTag ReadMVarOp = 585+primOpTag TryReadMVarOp = 586+primOpTag IsEmptyMVarOp = 587+primOpTag NewIOPortOp = 588+primOpTag ReadIOPortOp = 589+primOpTag WriteIOPortOp = 590+primOpTag DelayOp = 591+primOpTag WaitReadOp = 592+primOpTag WaitWriteOp = 593+primOpTag ForkOp = 594+primOpTag ForkOnOp = 595+primOpTag KillThreadOp = 596+primOpTag YieldOp = 597+primOpTag MyThreadIdOp = 598+primOpTag LabelThreadOp = 599+primOpTag IsCurrentThreadBoundOp = 600+primOpTag NoDuplicateOp = 601+primOpTag GetThreadLabelOp = 602+primOpTag ThreadStatusOp = 603+primOpTag ListThreadsOp = 604+primOpTag MkWeakOp = 605+primOpTag MkWeakNoFinalizerOp = 606+primOpTag AddCFinalizerToWeakOp = 607+primOpTag DeRefWeakOp = 608+primOpTag FinalizeWeakOp = 609+primOpTag TouchOp = 610+primOpTag MakeStablePtrOp = 611+primOpTag DeRefStablePtrOp = 612+primOpTag EqStablePtrOp = 613+primOpTag MakeStableNameOp = 614+primOpTag StableNameToIntOp = 615+primOpTag CompactNewOp = 616+primOpTag CompactResizeOp = 617+primOpTag CompactContainsOp = 618+primOpTag CompactContainsAnyOp = 619+primOpTag CompactGetFirstBlockOp = 620+primOpTag CompactGetNextBlockOp = 621+primOpTag CompactAllocateBlockOp = 622+primOpTag CompactFixupPointersOp = 623+primOpTag CompactAdd = 624+primOpTag CompactAddWithSharing = 625+primOpTag CompactSize = 626+primOpTag ReallyUnsafePtrEqualityOp = 627+primOpTag ParOp = 628+primOpTag SparkOp = 629+primOpTag SeqOp = 630+primOpTag GetSparkOp = 631+primOpTag NumSparks = 632+primOpTag KeepAliveOp = 633+primOpTag DataToTagOp = 634+primOpTag TagToEnumOp = 635+primOpTag AddrToAnyOp = 636+primOpTag AnyToAddrOp = 637+primOpTag MkApUpd0_Op = 638+primOpTag NewBCOOp = 639+primOpTag UnpackClosureOp = 640+primOpTag ClosureSizeOp = 641+primOpTag GetApStackValOp = 642+primOpTag GetCCSOfOp = 643+primOpTag GetCurrentCCSOp = 644+primOpTag ClearCCSOp = 645+primOpTag WhereFromOp = 646+primOpTag TraceEventOp = 647+primOpTag TraceEventBinaryOp = 648+primOpTag TraceMarkerOp = 649+primOpTag SetThreadAllocationCounter = 650+primOpTag (VecBroadcastOp IntVec 16 W8) = 651+primOpTag (VecBroadcastOp IntVec 8 W16) = 652+primOpTag (VecBroadcastOp IntVec 4 W32) = 653+primOpTag (VecBroadcastOp IntVec 2 W64) = 654+primOpTag (VecBroadcastOp IntVec 32 W8) = 655+primOpTag (VecBroadcastOp IntVec 16 W16) = 656+primOpTag (VecBroadcastOp IntVec 8 W32) = 657+primOpTag (VecBroadcastOp IntVec 4 W64) = 658+primOpTag (VecBroadcastOp IntVec 64 W8) = 659+primOpTag (VecBroadcastOp IntVec 32 W16) = 660+primOpTag (VecBroadcastOp IntVec 16 W32) = 661+primOpTag (VecBroadcastOp IntVec 8 W64) = 662+primOpTag (VecBroadcastOp WordVec 16 W8) = 663+primOpTag (VecBroadcastOp WordVec 8 W16) = 664+primOpTag (VecBroadcastOp WordVec 4 W32) = 665+primOpTag (VecBroadcastOp WordVec 2 W64) = 666+primOpTag (VecBroadcastOp WordVec 32 W8) = 667+primOpTag (VecBroadcastOp WordVec 16 W16) = 668+primOpTag (VecBroadcastOp WordVec 8 W32) = 669+primOpTag (VecBroadcastOp WordVec 4 W64) = 670+primOpTag (VecBroadcastOp WordVec 64 W8) = 671+primOpTag (VecBroadcastOp WordVec 32 W16) = 672+primOpTag (VecBroadcastOp WordVec 16 W32) = 673+primOpTag (VecBroadcastOp WordVec 8 W64) = 674+primOpTag (VecBroadcastOp FloatVec 4 W32) = 675+primOpTag (VecBroadcastOp FloatVec 2 W64) = 676+primOpTag (VecBroadcastOp FloatVec 8 W32) = 677+primOpTag (VecBroadcastOp FloatVec 4 W64) = 678+primOpTag (VecBroadcastOp FloatVec 16 W32) = 679+primOpTag (VecBroadcastOp FloatVec 8 W64) = 680+primOpTag (VecPackOp IntVec 16 W8) = 681+primOpTag (VecPackOp IntVec 8 W16) = 682+primOpTag (VecPackOp IntVec 4 W32) = 683+primOpTag (VecPackOp IntVec 2 W64) = 684+primOpTag (VecPackOp IntVec 32 W8) = 685+primOpTag (VecPackOp IntVec 16 W16) = 686+primOpTag (VecPackOp IntVec 8 W32) = 687+primOpTag (VecPackOp IntVec 4 W64) = 688+primOpTag (VecPackOp IntVec 64 W8) = 689+primOpTag (VecPackOp IntVec 32 W16) = 690+primOpTag (VecPackOp IntVec 16 W32) = 691+primOpTag (VecPackOp IntVec 8 W64) = 692+primOpTag (VecPackOp WordVec 16 W8) = 693+primOpTag (VecPackOp WordVec 8 W16) = 694+primOpTag (VecPackOp WordVec 4 W32) = 695+primOpTag (VecPackOp WordVec 2 W64) = 696+primOpTag (VecPackOp WordVec 32 W8) = 697+primOpTag (VecPackOp WordVec 16 W16) = 698+primOpTag (VecPackOp WordVec 8 W32) = 699+primOpTag (VecPackOp WordVec 4 W64) = 700+primOpTag (VecPackOp WordVec 64 W8) = 701+primOpTag (VecPackOp WordVec 32 W16) = 702+primOpTag (VecPackOp WordVec 16 W32) = 703+primOpTag (VecPackOp WordVec 8 W64) = 704+primOpTag (VecPackOp FloatVec 4 W32) = 705+primOpTag (VecPackOp FloatVec 2 W64) = 706+primOpTag (VecPackOp FloatVec 8 W32) = 707+primOpTag (VecPackOp FloatVec 4 W64) = 708+primOpTag (VecPackOp FloatVec 16 W32) = 709+primOpTag (VecPackOp FloatVec 8 W64) = 710+primOpTag (VecUnpackOp IntVec 16 W8) = 711+primOpTag (VecUnpackOp IntVec 8 W16) = 712+primOpTag (VecUnpackOp IntVec 4 W32) = 713+primOpTag (VecUnpackOp IntVec 2 W64) = 714+primOpTag (VecUnpackOp IntVec 32 W8) = 715+primOpTag (VecUnpackOp IntVec 16 W16) = 716+primOpTag (VecUnpackOp IntVec 8 W32) = 717+primOpTag (VecUnpackOp IntVec 4 W64) = 718+primOpTag (VecUnpackOp IntVec 64 W8) = 719+primOpTag (VecUnpackOp IntVec 32 W16) = 720+primOpTag (VecUnpackOp IntVec 16 W32) = 721+primOpTag (VecUnpackOp IntVec 8 W64) = 722+primOpTag (VecUnpackOp WordVec 16 W8) = 723+primOpTag (VecUnpackOp WordVec 8 W16) = 724+primOpTag (VecUnpackOp WordVec 4 W32) = 725+primOpTag (VecUnpackOp WordVec 2 W64) = 726+primOpTag (VecUnpackOp WordVec 32 W8) = 727+primOpTag (VecUnpackOp WordVec 16 W16) = 728+primOpTag (VecUnpackOp WordVec 8 W32) = 729+primOpTag (VecUnpackOp WordVec 4 W64) = 730+primOpTag (VecUnpackOp WordVec 64 W8) = 731+primOpTag (VecUnpackOp WordVec 32 W16) = 732+primOpTag (VecUnpackOp WordVec 16 W32) = 733+primOpTag (VecUnpackOp WordVec 8 W64) = 734+primOpTag (VecUnpackOp FloatVec 4 W32) = 735+primOpTag (VecUnpackOp FloatVec 2 W64) = 736+primOpTag (VecUnpackOp FloatVec 8 W32) = 737+primOpTag (VecUnpackOp FloatVec 4 W64) = 738+primOpTag (VecUnpackOp FloatVec 16 W32) = 739+primOpTag (VecUnpackOp FloatVec 8 W64) = 740+primOpTag (VecInsertOp IntVec 16 W8) = 741+primOpTag (VecInsertOp IntVec 8 W16) = 742+primOpTag (VecInsertOp IntVec 4 W32) = 743+primOpTag (VecInsertOp IntVec 2 W64) = 744+primOpTag (VecInsertOp IntVec 32 W8) = 745+primOpTag (VecInsertOp IntVec 16 W16) = 746+primOpTag (VecInsertOp IntVec 8 W32) = 747+primOpTag (VecInsertOp IntVec 4 W64) = 748+primOpTag (VecInsertOp IntVec 64 W8) = 749+primOpTag (VecInsertOp IntVec 32 W16) = 750+primOpTag (VecInsertOp IntVec 16 W32) = 751+primOpTag (VecInsertOp IntVec 8 W64) = 752+primOpTag (VecInsertOp WordVec 16 W8) = 753+primOpTag (VecInsertOp WordVec 8 W16) = 754+primOpTag (VecInsertOp WordVec 4 W32) = 755+primOpTag (VecInsertOp WordVec 2 W64) = 756+primOpTag (VecInsertOp WordVec 32 W8) = 757+primOpTag (VecInsertOp WordVec 16 W16) = 758+primOpTag (VecInsertOp WordVec 8 W32) = 759+primOpTag (VecInsertOp WordVec 4 W64) = 760+primOpTag (VecInsertOp WordVec 64 W8) = 761+primOpTag (VecInsertOp WordVec 32 W16) = 762+primOpTag (VecInsertOp WordVec 16 W32) = 763+primOpTag (VecInsertOp WordVec 8 W64) = 764+primOpTag (VecInsertOp FloatVec 4 W32) = 765+primOpTag (VecInsertOp FloatVec 2 W64) = 766+primOpTag (VecInsertOp FloatVec 8 W32) = 767+primOpTag (VecInsertOp FloatVec 4 W64) = 768+primOpTag (VecInsertOp FloatVec 16 W32) = 769+primOpTag (VecInsertOp FloatVec 8 W64) = 770+primOpTag (VecAddOp IntVec 16 W8) = 771+primOpTag (VecAddOp IntVec 8 W16) = 772+primOpTag (VecAddOp IntVec 4 W32) = 773+primOpTag (VecAddOp IntVec 2 W64) = 774+primOpTag (VecAddOp IntVec 32 W8) = 775+primOpTag (VecAddOp IntVec 16 W16) = 776+primOpTag (VecAddOp IntVec 8 W32) = 777+primOpTag (VecAddOp IntVec 4 W64) = 778+primOpTag (VecAddOp IntVec 64 W8) = 779+primOpTag (VecAddOp IntVec 32 W16) = 780+primOpTag (VecAddOp IntVec 16 W32) = 781+primOpTag (VecAddOp IntVec 8 W64) = 782+primOpTag (VecAddOp WordVec 16 W8) = 783+primOpTag (VecAddOp WordVec 8 W16) = 784+primOpTag (VecAddOp WordVec 4 W32) = 785+primOpTag (VecAddOp WordVec 2 W64) = 786+primOpTag (VecAddOp WordVec 32 W8) = 787+primOpTag (VecAddOp WordVec 16 W16) = 788+primOpTag (VecAddOp WordVec 8 W32) = 789+primOpTag (VecAddOp WordVec 4 W64) = 790+primOpTag (VecAddOp WordVec 64 W8) = 791+primOpTag (VecAddOp WordVec 32 W16) = 792+primOpTag (VecAddOp WordVec 16 W32) = 793+primOpTag (VecAddOp WordVec 8 W64) = 794+primOpTag (VecAddOp FloatVec 4 W32) = 795+primOpTag (VecAddOp FloatVec 2 W64) = 796+primOpTag (VecAddOp FloatVec 8 W32) = 797+primOpTag (VecAddOp FloatVec 4 W64) = 798+primOpTag (VecAddOp FloatVec 16 W32) = 799+primOpTag (VecAddOp FloatVec 8 W64) = 800+primOpTag (VecSubOp IntVec 16 W8) = 801+primOpTag (VecSubOp IntVec 8 W16) = 802+primOpTag (VecSubOp IntVec 4 W32) = 803+primOpTag (VecSubOp IntVec 2 W64) = 804+primOpTag (VecSubOp IntVec 32 W8) = 805+primOpTag (VecSubOp IntVec 16 W16) = 806+primOpTag (VecSubOp IntVec 8 W32) = 807+primOpTag (VecSubOp IntVec 4 W64) = 808+primOpTag (VecSubOp IntVec 64 W8) = 809+primOpTag (VecSubOp IntVec 32 W16) = 810+primOpTag (VecSubOp IntVec 16 W32) = 811+primOpTag (VecSubOp IntVec 8 W64) = 812+primOpTag (VecSubOp WordVec 16 W8) = 813+primOpTag (VecSubOp WordVec 8 W16) = 814+primOpTag (VecSubOp WordVec 4 W32) = 815+primOpTag (VecSubOp WordVec 2 W64) = 816+primOpTag (VecSubOp WordVec 32 W8) = 817+primOpTag (VecSubOp WordVec 16 W16) = 818+primOpTag (VecSubOp WordVec 8 W32) = 819+primOpTag (VecSubOp WordVec 4 W64) = 820+primOpTag (VecSubOp WordVec 64 W8) = 821+primOpTag (VecSubOp WordVec 32 W16) = 822+primOpTag (VecSubOp WordVec 16 W32) = 823+primOpTag (VecSubOp WordVec 8 W64) = 824+primOpTag (VecSubOp FloatVec 4 W32) = 825+primOpTag (VecSubOp FloatVec 2 W64) = 826+primOpTag (VecSubOp FloatVec 8 W32) = 827+primOpTag (VecSubOp FloatVec 4 W64) = 828+primOpTag (VecSubOp FloatVec 16 W32) = 829+primOpTag (VecSubOp FloatVec 8 W64) = 830+primOpTag (VecMulOp IntVec 16 W8) = 831+primOpTag (VecMulOp IntVec 8 W16) = 832+primOpTag (VecMulOp IntVec 4 W32) = 833+primOpTag (VecMulOp IntVec 2 W64) = 834+primOpTag (VecMulOp IntVec 32 W8) = 835+primOpTag (VecMulOp IntVec 16 W16) = 836+primOpTag (VecMulOp IntVec 8 W32) = 837+primOpTag (VecMulOp IntVec 4 W64) = 838+primOpTag (VecMulOp IntVec 64 W8) = 839+primOpTag (VecMulOp IntVec 32 W16) = 840+primOpTag (VecMulOp IntVec 16 W32) = 841+primOpTag (VecMulOp IntVec 8 W64) = 842+primOpTag (VecMulOp WordVec 16 W8) = 843+primOpTag (VecMulOp WordVec 8 W16) = 844+primOpTag (VecMulOp WordVec 4 W32) = 845+primOpTag (VecMulOp WordVec 2 W64) = 846+primOpTag (VecMulOp WordVec 32 W8) = 847+primOpTag (VecMulOp WordVec 16 W16) = 848+primOpTag (VecMulOp WordVec 8 W32) = 849+primOpTag (VecMulOp WordVec 4 W64) = 850+primOpTag (VecMulOp WordVec 64 W8) = 851+primOpTag (VecMulOp WordVec 32 W16) = 852+primOpTag (VecMulOp WordVec 16 W32) = 853+primOpTag (VecMulOp WordVec 8 W64) = 854+primOpTag (VecMulOp FloatVec 4 W32) = 855+primOpTag (VecMulOp FloatVec 2 W64) = 856+primOpTag (VecMulOp FloatVec 8 W32) = 857+primOpTag (VecMulOp FloatVec 4 W64) = 858+primOpTag (VecMulOp FloatVec 16 W32) = 859+primOpTag (VecMulOp FloatVec 8 W64) = 860+primOpTag (VecDivOp FloatVec 4 W32) = 861+primOpTag (VecDivOp FloatVec 2 W64) = 862+primOpTag (VecDivOp FloatVec 8 W32) = 863+primOpTag (VecDivOp FloatVec 4 W64) = 864+primOpTag (VecDivOp FloatVec 16 W32) = 865+primOpTag (VecDivOp FloatVec 8 W64) = 866+primOpTag (VecQuotOp IntVec 16 W8) = 867+primOpTag (VecQuotOp IntVec 8 W16) = 868+primOpTag (VecQuotOp IntVec 4 W32) = 869+primOpTag (VecQuotOp IntVec 2 W64) = 870+primOpTag (VecQuotOp IntVec 32 W8) = 871+primOpTag (VecQuotOp IntVec 16 W16) = 872+primOpTag (VecQuotOp IntVec 8 W32) = 873+primOpTag (VecQuotOp IntVec 4 W64) = 874+primOpTag (VecQuotOp IntVec 64 W8) = 875+primOpTag (VecQuotOp IntVec 32 W16) = 876+primOpTag (VecQuotOp IntVec 16 W32) = 877+primOpTag (VecQuotOp IntVec 8 W64) = 878+primOpTag (VecQuotOp WordVec 16 W8) = 879+primOpTag (VecQuotOp WordVec 8 W16) = 880+primOpTag (VecQuotOp WordVec 4 W32) = 881+primOpTag (VecQuotOp WordVec 2 W64) = 882+primOpTag (VecQuotOp WordVec 32 W8) = 883+primOpTag (VecQuotOp WordVec 16 W16) = 884+primOpTag (VecQuotOp WordVec 8 W32) = 885+primOpTag (VecQuotOp WordVec 4 W64) = 886+primOpTag (VecQuotOp WordVec 64 W8) = 887+primOpTag (VecQuotOp WordVec 32 W16) = 888+primOpTag (VecQuotOp WordVec 16 W32) = 889+primOpTag (VecQuotOp WordVec 8 W64) = 890+primOpTag (VecRemOp IntVec 16 W8) = 891+primOpTag (VecRemOp IntVec 8 W16) = 892+primOpTag (VecRemOp IntVec 4 W32) = 893+primOpTag (VecRemOp IntVec 2 W64) = 894+primOpTag (VecRemOp IntVec 32 W8) = 895+primOpTag (VecRemOp IntVec 16 W16) = 896+primOpTag (VecRemOp IntVec 8 W32) = 897+primOpTag (VecRemOp IntVec 4 W64) = 898+primOpTag (VecRemOp IntVec 64 W8) = 899+primOpTag (VecRemOp IntVec 32 W16) = 900+primOpTag (VecRemOp IntVec 16 W32) = 901+primOpTag (VecRemOp IntVec 8 W64) = 902+primOpTag (VecRemOp WordVec 16 W8) = 903+primOpTag (VecRemOp WordVec 8 W16) = 904+primOpTag (VecRemOp WordVec 4 W32) = 905+primOpTag (VecRemOp WordVec 2 W64) = 906+primOpTag (VecRemOp WordVec 32 W8) = 907+primOpTag (VecRemOp WordVec 16 W16) = 908+primOpTag (VecRemOp WordVec 8 W32) = 909+primOpTag (VecRemOp WordVec 4 W64) = 910+primOpTag (VecRemOp WordVec 64 W8) = 911+primOpTag (VecRemOp WordVec 32 W16) = 912+primOpTag (VecRemOp WordVec 16 W32) = 913+primOpTag (VecRemOp WordVec 8 W64) = 914+primOpTag (VecNegOp IntVec 16 W8) = 915+primOpTag (VecNegOp IntVec 8 W16) = 916+primOpTag (VecNegOp IntVec 4 W32) = 917+primOpTag (VecNegOp IntVec 2 W64) = 918+primOpTag (VecNegOp IntVec 32 W8) = 919+primOpTag (VecNegOp IntVec 16 W16) = 920+primOpTag (VecNegOp IntVec 8 W32) = 921+primOpTag (VecNegOp IntVec 4 W64) = 922+primOpTag (VecNegOp IntVec 64 W8) = 923+primOpTag (VecNegOp IntVec 32 W16) = 924+primOpTag (VecNegOp IntVec 16 W32) = 925+primOpTag (VecNegOp IntVec 8 W64) = 926+primOpTag (VecNegOp FloatVec 4 W32) = 927+primOpTag (VecNegOp FloatVec 2 W64) = 928+primOpTag (VecNegOp FloatVec 8 W32) = 929+primOpTag (VecNegOp FloatVec 4 W64) = 930+primOpTag (VecNegOp FloatVec 16 W32) = 931+primOpTag (VecNegOp FloatVec 8 W64) = 932+primOpTag (VecIndexByteArrayOp IntVec 16 W8) = 933+primOpTag (VecIndexByteArrayOp IntVec 8 W16) = 934+primOpTag (VecIndexByteArrayOp IntVec 4 W32) = 935+primOpTag (VecIndexByteArrayOp IntVec 2 W64) = 936+primOpTag (VecIndexByteArrayOp IntVec 32 W8) = 937+primOpTag (VecIndexByteArrayOp IntVec 16 W16) = 938+primOpTag (VecIndexByteArrayOp IntVec 8 W32) = 939+primOpTag (VecIndexByteArrayOp IntVec 4 W64) = 940+primOpTag (VecIndexByteArrayOp IntVec 64 W8) = 941+primOpTag (VecIndexByteArrayOp IntVec 32 W16) = 942+primOpTag (VecIndexByteArrayOp IntVec 16 W32) = 943+primOpTag (VecIndexByteArrayOp IntVec 8 W64) = 944+primOpTag (VecIndexByteArrayOp WordVec 16 W8) = 945+primOpTag (VecIndexByteArrayOp WordVec 8 W16) = 946+primOpTag (VecIndexByteArrayOp WordVec 4 W32) = 947+primOpTag (VecIndexByteArrayOp WordVec 2 W64) = 948+primOpTag (VecIndexByteArrayOp WordVec 32 W8) = 949+primOpTag (VecIndexByteArrayOp WordVec 16 W16) = 950+primOpTag (VecIndexByteArrayOp WordVec 8 W32) = 951+primOpTag (VecIndexByteArrayOp WordVec 4 W64) = 952+primOpTag (VecIndexByteArrayOp WordVec 64 W8) = 953+primOpTag (VecIndexByteArrayOp WordVec 32 W16) = 954+primOpTag (VecIndexByteArrayOp WordVec 16 W32) = 955+primOpTag (VecIndexByteArrayOp WordVec 8 W64) = 956+primOpTag (VecIndexByteArrayOp FloatVec 4 W32) = 957+primOpTag (VecIndexByteArrayOp FloatVec 2 W64) = 958+primOpTag (VecIndexByteArrayOp FloatVec 8 W32) = 959+primOpTag (VecIndexByteArrayOp FloatVec 4 W64) = 960+primOpTag (VecIndexByteArrayOp FloatVec 16 W32) = 961+primOpTag (VecIndexByteArrayOp FloatVec 8 W64) = 962+primOpTag (VecReadByteArrayOp IntVec 16 W8) = 963+primOpTag (VecReadByteArrayOp IntVec 8 W16) = 964+primOpTag (VecReadByteArrayOp IntVec 4 W32) = 965+primOpTag (VecReadByteArrayOp IntVec 2 W64) = 966+primOpTag (VecReadByteArrayOp IntVec 32 W8) = 967+primOpTag (VecReadByteArrayOp IntVec 16 W16) = 968+primOpTag (VecReadByteArrayOp IntVec 8 W32) = 969+primOpTag (VecReadByteArrayOp IntVec 4 W64) = 970+primOpTag (VecReadByteArrayOp IntVec 64 W8) = 971+primOpTag (VecReadByteArrayOp IntVec 32 W16) = 972+primOpTag (VecReadByteArrayOp IntVec 16 W32) = 973+primOpTag (VecReadByteArrayOp IntVec 8 W64) = 974+primOpTag (VecReadByteArrayOp WordVec 16 W8) = 975+primOpTag (VecReadByteArrayOp WordVec 8 W16) = 976+primOpTag (VecReadByteArrayOp WordVec 4 W32) = 977+primOpTag (VecReadByteArrayOp WordVec 2 W64) = 978+primOpTag (VecReadByteArrayOp WordVec 32 W8) = 979+primOpTag (VecReadByteArrayOp WordVec 16 W16) = 980+primOpTag (VecReadByteArrayOp WordVec 8 W32) = 981+primOpTag (VecReadByteArrayOp WordVec 4 W64) = 982+primOpTag (VecReadByteArrayOp WordVec 64 W8) = 983+primOpTag (VecReadByteArrayOp WordVec 32 W16) = 984+primOpTag (VecReadByteArrayOp WordVec 16 W32) = 985+primOpTag (VecReadByteArrayOp WordVec 8 W64) = 986+primOpTag (VecReadByteArrayOp FloatVec 4 W32) = 987+primOpTag (VecReadByteArrayOp FloatVec 2 W64) = 988+primOpTag (VecReadByteArrayOp FloatVec 8 W32) = 989+primOpTag (VecReadByteArrayOp FloatVec 4 W64) = 990+primOpTag (VecReadByteArrayOp FloatVec 16 W32) = 991+primOpTag (VecReadByteArrayOp FloatVec 8 W64) = 992+primOpTag (VecWriteByteArrayOp IntVec 16 W8) = 993+primOpTag (VecWriteByteArrayOp IntVec 8 W16) = 994+primOpTag (VecWriteByteArrayOp IntVec 4 W32) = 995+primOpTag (VecWriteByteArrayOp IntVec 2 W64) = 996+primOpTag (VecWriteByteArrayOp IntVec 32 W8) = 997+primOpTag (VecWriteByteArrayOp IntVec 16 W16) = 998+primOpTag (VecWriteByteArrayOp IntVec 8 W32) = 999+primOpTag (VecWriteByteArrayOp IntVec 4 W64) = 1000+primOpTag (VecWriteByteArrayOp IntVec 64 W8) = 1001+primOpTag (VecWriteByteArrayOp IntVec 32 W16) = 1002+primOpTag (VecWriteByteArrayOp IntVec 16 W32) = 1003+primOpTag (VecWriteByteArrayOp IntVec 8 W64) = 1004+primOpTag (VecWriteByteArrayOp WordVec 16 W8) = 1005+primOpTag (VecWriteByteArrayOp WordVec 8 W16) = 1006+primOpTag (VecWriteByteArrayOp WordVec 4 W32) = 1007+primOpTag (VecWriteByteArrayOp WordVec 2 W64) = 1008+primOpTag (VecWriteByteArrayOp WordVec 32 W8) = 1009+primOpTag (VecWriteByteArrayOp WordVec 16 W16) = 1010+primOpTag (VecWriteByteArrayOp WordVec 8 W32) = 1011+primOpTag (VecWriteByteArrayOp WordVec 4 W64) = 1012+primOpTag (VecWriteByteArrayOp WordVec 64 W8) = 1013+primOpTag (VecWriteByteArrayOp WordVec 32 W16) = 1014+primOpTag (VecWriteByteArrayOp WordVec 16 W32) = 1015+primOpTag (VecWriteByteArrayOp WordVec 8 W64) = 1016+primOpTag (VecWriteByteArrayOp FloatVec 4 W32) = 1017+primOpTag (VecWriteByteArrayOp FloatVec 2 W64) = 1018+primOpTag (VecWriteByteArrayOp FloatVec 8 W32) = 1019+primOpTag (VecWriteByteArrayOp FloatVec 4 W64) = 1020+primOpTag (VecWriteByteArrayOp FloatVec 16 W32) = 1021+primOpTag (VecWriteByteArrayOp FloatVec 8 W64) = 1022+primOpTag (VecIndexOffAddrOp IntVec 16 W8) = 1023+primOpTag (VecIndexOffAddrOp IntVec 8 W16) = 1024+primOpTag (VecIndexOffAddrOp IntVec 4 W32) = 1025+primOpTag (VecIndexOffAddrOp IntVec 2 W64) = 1026+primOpTag (VecIndexOffAddrOp IntVec 32 W8) = 1027+primOpTag (VecIndexOffAddrOp IntVec 16 W16) = 1028+primOpTag (VecIndexOffAddrOp IntVec 8 W32) = 1029+primOpTag (VecIndexOffAddrOp IntVec 4 W64) = 1030+primOpTag (VecIndexOffAddrOp IntVec 64 W8) = 1031+primOpTag (VecIndexOffAddrOp IntVec 32 W16) = 1032+primOpTag (VecIndexOffAddrOp IntVec 16 W32) = 1033+primOpTag (VecIndexOffAddrOp IntVec 8 W64) = 1034+primOpTag (VecIndexOffAddrOp WordVec 16 W8) = 1035+primOpTag (VecIndexOffAddrOp WordVec 8 W16) = 1036+primOpTag (VecIndexOffAddrOp WordVec 4 W32) = 1037+primOpTag (VecIndexOffAddrOp WordVec 2 W64) = 1038+primOpTag (VecIndexOffAddrOp WordVec 32 W8) = 1039+primOpTag (VecIndexOffAddrOp WordVec 16 W16) = 1040+primOpTag (VecIndexOffAddrOp WordVec 8 W32) = 1041+primOpTag (VecIndexOffAddrOp WordVec 4 W64) = 1042+primOpTag (VecIndexOffAddrOp WordVec 64 W8) = 1043+primOpTag (VecIndexOffAddrOp WordVec 32 W16) = 1044+primOpTag (VecIndexOffAddrOp WordVec 16 W32) = 1045+primOpTag (VecIndexOffAddrOp WordVec 8 W64) = 1046+primOpTag (VecIndexOffAddrOp FloatVec 4 W32) = 1047+primOpTag (VecIndexOffAddrOp FloatVec 2 W64) = 1048+primOpTag (VecIndexOffAddrOp FloatVec 8 W32) = 1049+primOpTag (VecIndexOffAddrOp FloatVec 4 W64) = 1050+primOpTag (VecIndexOffAddrOp FloatVec 16 W32) = 1051+primOpTag (VecIndexOffAddrOp FloatVec 8 W64) = 1052+primOpTag (VecReadOffAddrOp IntVec 16 W8) = 1053+primOpTag (VecReadOffAddrOp IntVec 8 W16) = 1054+primOpTag (VecReadOffAddrOp IntVec 4 W32) = 1055+primOpTag (VecReadOffAddrOp IntVec 2 W64) = 1056+primOpTag (VecReadOffAddrOp IntVec 32 W8) = 1057+primOpTag (VecReadOffAddrOp IntVec 16 W16) = 1058+primOpTag (VecReadOffAddrOp IntVec 8 W32) = 1059+primOpTag (VecReadOffAddrOp IntVec 4 W64) = 1060+primOpTag (VecReadOffAddrOp IntVec 64 W8) = 1061+primOpTag (VecReadOffAddrOp IntVec 32 W16) = 1062+primOpTag (VecReadOffAddrOp IntVec 16 W32) = 1063+primOpTag (VecReadOffAddrOp IntVec 8 W64) = 1064+primOpTag (VecReadOffAddrOp WordVec 16 W8) = 1065+primOpTag (VecReadOffAddrOp WordVec 8 W16) = 1066+primOpTag (VecReadOffAddrOp WordVec 4 W32) = 1067+primOpTag (VecReadOffAddrOp WordVec 2 W64) = 1068+primOpTag (VecReadOffAddrOp WordVec 32 W8) = 1069+primOpTag (VecReadOffAddrOp WordVec 16 W16) = 1070+primOpTag (VecReadOffAddrOp WordVec 8 W32) = 1071+primOpTag (VecReadOffAddrOp WordVec 4 W64) = 1072+primOpTag (VecReadOffAddrOp WordVec 64 W8) = 1073+primOpTag (VecReadOffAddrOp WordVec 32 W16) = 1074+primOpTag (VecReadOffAddrOp WordVec 16 W32) = 1075+primOpTag (VecReadOffAddrOp WordVec 8 W64) = 1076+primOpTag (VecReadOffAddrOp FloatVec 4 W32) = 1077+primOpTag (VecReadOffAddrOp FloatVec 2 W64) = 1078+primOpTag (VecReadOffAddrOp FloatVec 8 W32) = 1079+primOpTag (VecReadOffAddrOp FloatVec 4 W64) = 1080+primOpTag (VecReadOffAddrOp FloatVec 16 W32) = 1081+primOpTag (VecReadOffAddrOp FloatVec 8 W64) = 1082+primOpTag (VecWriteOffAddrOp IntVec 16 W8) = 1083+primOpTag (VecWriteOffAddrOp IntVec 8 W16) = 1084+primOpTag (VecWriteOffAddrOp IntVec 4 W32) = 1085+primOpTag (VecWriteOffAddrOp IntVec 2 W64) = 1086+primOpTag (VecWriteOffAddrOp IntVec 32 W8) = 1087+primOpTag (VecWriteOffAddrOp IntVec 16 W16) = 1088+primOpTag (VecWriteOffAddrOp IntVec 8 W32) = 1089+primOpTag (VecWriteOffAddrOp IntVec 4 W64) = 1090+primOpTag (VecWriteOffAddrOp IntVec 64 W8) = 1091+primOpTag (VecWriteOffAddrOp IntVec 32 W16) = 1092+primOpTag (VecWriteOffAddrOp IntVec 16 W32) = 1093+primOpTag (VecWriteOffAddrOp IntVec 8 W64) = 1094+primOpTag (VecWriteOffAddrOp WordVec 16 W8) = 1095+primOpTag (VecWriteOffAddrOp WordVec 8 W16) = 1096+primOpTag (VecWriteOffAddrOp WordVec 4 W32) = 1097+primOpTag (VecWriteOffAddrOp WordVec 2 W64) = 1098+primOpTag (VecWriteOffAddrOp WordVec 32 W8) = 1099+primOpTag (VecWriteOffAddrOp WordVec 16 W16) = 1100+primOpTag (VecWriteOffAddrOp WordVec 8 W32) = 1101+primOpTag (VecWriteOffAddrOp WordVec 4 W64) = 1102+primOpTag (VecWriteOffAddrOp WordVec 64 W8) = 1103+primOpTag (VecWriteOffAddrOp WordVec 32 W16) = 1104+primOpTag (VecWriteOffAddrOp WordVec 16 W32) = 1105+primOpTag (VecWriteOffAddrOp WordVec 8 W64) = 1106+primOpTag (VecWriteOffAddrOp FloatVec 4 W32) = 1107+primOpTag (VecWriteOffAddrOp FloatVec 2 W64) = 1108+primOpTag (VecWriteOffAddrOp FloatVec 8 W32) = 1109+primOpTag (VecWriteOffAddrOp FloatVec 4 W64) = 1110+primOpTag (VecWriteOffAddrOp FloatVec 16 W32) = 1111+primOpTag (VecWriteOffAddrOp FloatVec 8 W64) = 1112+primOpTag (VecIndexScalarByteArrayOp IntVec 16 W8) = 1113+primOpTag (VecIndexScalarByteArrayOp IntVec 8 W16) = 1114+primOpTag (VecIndexScalarByteArrayOp IntVec 4 W32) = 1115+primOpTag (VecIndexScalarByteArrayOp IntVec 2 W64) = 1116+primOpTag (VecIndexScalarByteArrayOp IntVec 32 W8) = 1117+primOpTag (VecIndexScalarByteArrayOp IntVec 16 W16) = 1118+primOpTag (VecIndexScalarByteArrayOp IntVec 8 W32) = 1119+primOpTag (VecIndexScalarByteArrayOp IntVec 4 W64) = 1120+primOpTag (VecIndexScalarByteArrayOp IntVec 64 W8) = 1121+primOpTag (VecIndexScalarByteArrayOp IntVec 32 W16) = 1122+primOpTag (VecIndexScalarByteArrayOp IntVec 16 W32) = 1123+primOpTag (VecIndexScalarByteArrayOp IntVec 8 W64) = 1124+primOpTag (VecIndexScalarByteArrayOp WordVec 16 W8) = 1125+primOpTag (VecIndexScalarByteArrayOp WordVec 8 W16) = 1126+primOpTag (VecIndexScalarByteArrayOp WordVec 4 W32) = 1127+primOpTag (VecIndexScalarByteArrayOp WordVec 2 W64) = 1128+primOpTag (VecIndexScalarByteArrayOp WordVec 32 W8) = 1129+primOpTag (VecIndexScalarByteArrayOp WordVec 16 W16) = 1130+primOpTag (VecIndexScalarByteArrayOp WordVec 8 W32) = 1131+primOpTag (VecIndexScalarByteArrayOp WordVec 4 W64) = 1132+primOpTag (VecIndexScalarByteArrayOp WordVec 64 W8) = 1133+primOpTag (VecIndexScalarByteArrayOp WordVec 32 W16) = 1134+primOpTag (VecIndexScalarByteArrayOp WordVec 16 W32) = 1135+primOpTag (VecIndexScalarByteArrayOp WordVec 8 W64) = 1136+primOpTag (VecIndexScalarByteArrayOp FloatVec 4 W32) = 1137+primOpTag (VecIndexScalarByteArrayOp FloatVec 2 W64) = 1138+primOpTag (VecIndexScalarByteArrayOp FloatVec 8 W32) = 1139+primOpTag (VecIndexScalarByteArrayOp FloatVec 4 W64) = 1140+primOpTag (VecIndexScalarByteArrayOp FloatVec 16 W32) = 1141+primOpTag (VecIndexScalarByteArrayOp FloatVec 8 W64) = 1142+primOpTag (VecReadScalarByteArrayOp IntVec 16 W8) = 1143+primOpTag (VecReadScalarByteArrayOp IntVec 8 W16) = 1144+primOpTag (VecReadScalarByteArrayOp IntVec 4 W32) = 1145+primOpTag (VecReadScalarByteArrayOp IntVec 2 W64) = 1146+primOpTag (VecReadScalarByteArrayOp IntVec 32 W8) = 1147+primOpTag (VecReadScalarByteArrayOp IntVec 16 W16) = 1148+primOpTag (VecReadScalarByteArrayOp IntVec 8 W32) = 1149+primOpTag (VecReadScalarByteArrayOp IntVec 4 W64) = 1150+primOpTag (VecReadScalarByteArrayOp IntVec 64 W8) = 1151+primOpTag (VecReadScalarByteArrayOp IntVec 32 W16) = 1152+primOpTag (VecReadScalarByteArrayOp IntVec 16 W32) = 1153+primOpTag (VecReadScalarByteArrayOp IntVec 8 W64) = 1154+primOpTag (VecReadScalarByteArrayOp WordVec 16 W8) = 1155+primOpTag (VecReadScalarByteArrayOp WordVec 8 W16) = 1156+primOpTag (VecReadScalarByteArrayOp WordVec 4 W32) = 1157+primOpTag (VecReadScalarByteArrayOp WordVec 2 W64) = 1158+primOpTag (VecReadScalarByteArrayOp WordVec 32 W8) = 1159+primOpTag (VecReadScalarByteArrayOp WordVec 16 W16) = 1160+primOpTag (VecReadScalarByteArrayOp WordVec 8 W32) = 1161+primOpTag (VecReadScalarByteArrayOp WordVec 4 W64) = 1162+primOpTag (VecReadScalarByteArrayOp WordVec 64 W8) = 1163+primOpTag (VecReadScalarByteArrayOp WordVec 32 W16) = 1164+primOpTag (VecReadScalarByteArrayOp WordVec 16 W32) = 1165+primOpTag (VecReadScalarByteArrayOp WordVec 8 W64) = 1166+primOpTag (VecReadScalarByteArrayOp FloatVec 4 W32) = 1167+primOpTag (VecReadScalarByteArrayOp FloatVec 2 W64) = 1168+primOpTag (VecReadScalarByteArrayOp FloatVec 8 W32) = 1169+primOpTag (VecReadScalarByteArrayOp FloatVec 4 W64) = 1170+primOpTag (VecReadScalarByteArrayOp FloatVec 16 W32) = 1171+primOpTag (VecReadScalarByteArrayOp FloatVec 8 W64) = 1172+primOpTag (VecWriteScalarByteArrayOp IntVec 16 W8) = 1173+primOpTag (VecWriteScalarByteArrayOp IntVec 8 W16) = 1174+primOpTag (VecWriteScalarByteArrayOp IntVec 4 W32) = 1175+primOpTag (VecWriteScalarByteArrayOp IntVec 2 W64) = 1176+primOpTag (VecWriteScalarByteArrayOp IntVec 32 W8) = 1177+primOpTag (VecWriteScalarByteArrayOp IntVec 16 W16) = 1178+primOpTag (VecWriteScalarByteArrayOp IntVec 8 W32) = 1179+primOpTag (VecWriteScalarByteArrayOp IntVec 4 W64) = 1180+primOpTag (VecWriteScalarByteArrayOp IntVec 64 W8) = 1181+primOpTag (VecWriteScalarByteArrayOp IntVec 32 W16) = 1182+primOpTag (VecWriteScalarByteArrayOp IntVec 16 W32) = 1183+primOpTag (VecWriteScalarByteArrayOp IntVec 8 W64) = 1184+primOpTag (VecWriteScalarByteArrayOp WordVec 16 W8) = 1185+primOpTag (VecWriteScalarByteArrayOp WordVec 8 W16) = 1186+primOpTag (VecWriteScalarByteArrayOp WordVec 4 W32) = 1187+primOpTag (VecWriteScalarByteArrayOp WordVec 2 W64) = 1188+primOpTag (VecWriteScalarByteArrayOp WordVec 32 W8) = 1189+primOpTag (VecWriteScalarByteArrayOp WordVec 16 W16) = 1190+primOpTag (VecWriteScalarByteArrayOp WordVec 8 W32) = 1191+primOpTag (VecWriteScalarByteArrayOp WordVec 4 W64) = 1192+primOpTag (VecWriteScalarByteArrayOp WordVec 64 W8) = 1193+primOpTag (VecWriteScalarByteArrayOp WordVec 32 W16) = 1194+primOpTag (VecWriteScalarByteArrayOp WordVec 16 W32) = 1195+primOpTag (VecWriteScalarByteArrayOp WordVec 8 W64) = 1196+primOpTag (VecWriteScalarByteArrayOp FloatVec 4 W32) = 1197+primOpTag (VecWriteScalarByteArrayOp FloatVec 2 W64) = 1198+primOpTag (VecWriteScalarByteArrayOp FloatVec 8 W32) = 1199+primOpTag (VecWriteScalarByteArrayOp FloatVec 4 W64) = 1200+primOpTag (VecWriteScalarByteArrayOp FloatVec 16 W32) = 1201+primOpTag (VecWriteScalarByteArrayOp FloatVec 8 W64) = 1202+primOpTag (VecIndexScalarOffAddrOp IntVec 16 W8) = 1203+primOpTag (VecIndexScalarOffAddrOp IntVec 8 W16) = 1204+primOpTag (VecIndexScalarOffAddrOp IntVec 4 W32) = 1205+primOpTag (VecIndexScalarOffAddrOp IntVec 2 W64) = 1206+primOpTag (VecIndexScalarOffAddrOp IntVec 32 W8) = 1207+primOpTag (VecIndexScalarOffAddrOp IntVec 16 W16) = 1208+primOpTag (VecIndexScalarOffAddrOp IntVec 8 W32) = 1209+primOpTag (VecIndexScalarOffAddrOp IntVec 4 W64) = 1210+primOpTag (VecIndexScalarOffAddrOp IntVec 64 W8) = 1211+primOpTag (VecIndexScalarOffAddrOp IntVec 32 W16) = 1212+primOpTag (VecIndexScalarOffAddrOp IntVec 16 W32) = 1213+primOpTag (VecIndexScalarOffAddrOp IntVec 8 W64) = 1214+primOpTag (VecIndexScalarOffAddrOp WordVec 16 W8) = 1215+primOpTag (VecIndexScalarOffAddrOp WordVec 8 W16) = 1216+primOpTag (VecIndexScalarOffAddrOp WordVec 4 W32) = 1217+primOpTag (VecIndexScalarOffAddrOp WordVec 2 W64) = 1218+primOpTag (VecIndexScalarOffAddrOp WordVec 32 W8) = 1219+primOpTag (VecIndexScalarOffAddrOp WordVec 16 W16) = 1220+primOpTag (VecIndexScalarOffAddrOp WordVec 8 W32) = 1221+primOpTag (VecIndexScalarOffAddrOp WordVec 4 W64) = 1222+primOpTag (VecIndexScalarOffAddrOp WordVec 64 W8) = 1223+primOpTag (VecIndexScalarOffAddrOp WordVec 32 W16) = 1224+primOpTag (VecIndexScalarOffAddrOp WordVec 16 W32) = 1225+primOpTag (VecIndexScalarOffAddrOp WordVec 8 W64) = 1226+primOpTag (VecIndexScalarOffAddrOp FloatVec 4 W32) = 1227+primOpTag (VecIndexScalarOffAddrOp FloatVec 2 W64) = 1228+primOpTag (VecIndexScalarOffAddrOp FloatVec 8 W32) = 1229+primOpTag (VecIndexScalarOffAddrOp FloatVec 4 W64) = 1230+primOpTag (VecIndexScalarOffAddrOp FloatVec 16 W32) = 1231+primOpTag (VecIndexScalarOffAddrOp FloatVec 8 W64) = 1232+primOpTag (VecReadScalarOffAddrOp IntVec 16 W8) = 1233+primOpTag (VecReadScalarOffAddrOp IntVec 8 W16) = 1234+primOpTag (VecReadScalarOffAddrOp IntVec 4 W32) = 1235+primOpTag (VecReadScalarOffAddrOp IntVec 2 W64) = 1236+primOpTag (VecReadScalarOffAddrOp IntVec 32 W8) = 1237+primOpTag (VecReadScalarOffAddrOp IntVec 16 W16) = 1238+primOpTag (VecReadScalarOffAddrOp IntVec 8 W32) = 1239+primOpTag (VecReadScalarOffAddrOp IntVec 4 W64) = 1240+primOpTag (VecReadScalarOffAddrOp IntVec 64 W8) = 1241+primOpTag (VecReadScalarOffAddrOp IntVec 32 W16) = 1242+primOpTag (VecReadScalarOffAddrOp IntVec 16 W32) = 1243+primOpTag (VecReadScalarOffAddrOp IntVec 8 W64) = 1244+primOpTag (VecReadScalarOffAddrOp WordVec 16 W8) = 1245+primOpTag (VecReadScalarOffAddrOp WordVec 8 W16) = 1246+primOpTag (VecReadScalarOffAddrOp WordVec 4 W32) = 1247+primOpTag (VecReadScalarOffAddrOp WordVec 2 W64) = 1248+primOpTag (VecReadScalarOffAddrOp WordVec 32 W8) = 1249+primOpTag (VecReadScalarOffAddrOp WordVec 16 W16) = 1250+primOpTag (VecReadScalarOffAddrOp WordVec 8 W32) = 1251+primOpTag (VecReadScalarOffAddrOp WordVec 4 W64) = 1252+primOpTag (VecReadScalarOffAddrOp WordVec 64 W8) = 1253+primOpTag (VecReadScalarOffAddrOp WordVec 32 W16) = 1254+primOpTag (VecReadScalarOffAddrOp WordVec 16 W32) = 1255+primOpTag (VecReadScalarOffAddrOp WordVec 8 W64) = 1256+primOpTag (VecReadScalarOffAddrOp FloatVec 4 W32) = 1257+primOpTag (VecReadScalarOffAddrOp FloatVec 2 W64) = 1258+primOpTag (VecReadScalarOffAddrOp FloatVec 8 W32) = 1259+primOpTag (VecReadScalarOffAddrOp FloatVec 4 W64) = 1260+primOpTag (VecReadScalarOffAddrOp FloatVec 16 W32) = 1261+primOpTag (VecReadScalarOffAddrOp FloatVec 8 W64) = 1262+primOpTag (VecWriteScalarOffAddrOp IntVec 16 W8) = 1263+primOpTag (VecWriteScalarOffAddrOp IntVec 8 W16) = 1264+primOpTag (VecWriteScalarOffAddrOp IntVec 4 W32) = 1265+primOpTag (VecWriteScalarOffAddrOp IntVec 2 W64) = 1266+primOpTag (VecWriteScalarOffAddrOp IntVec 32 W8) = 1267+primOpTag (VecWriteScalarOffAddrOp IntVec 16 W16) = 1268+primOpTag (VecWriteScalarOffAddrOp IntVec 8 W32) = 1269+primOpTag (VecWriteScalarOffAddrOp IntVec 4 W64) = 1270+primOpTag (VecWriteScalarOffAddrOp IntVec 64 W8) = 1271+primOpTag (VecWriteScalarOffAddrOp IntVec 32 W16) = 1272+primOpTag (VecWriteScalarOffAddrOp IntVec 16 W32) = 1273+primOpTag (VecWriteScalarOffAddrOp IntVec 8 W64) = 1274+primOpTag (VecWriteScalarOffAddrOp WordVec 16 W8) = 1275+primOpTag (VecWriteScalarOffAddrOp WordVec 8 W16) = 1276+primOpTag (VecWriteScalarOffAddrOp WordVec 4 W32) = 1277+primOpTag (VecWriteScalarOffAddrOp WordVec 2 W64) = 1278+primOpTag (VecWriteScalarOffAddrOp WordVec 32 W8) = 1279+primOpTag (VecWriteScalarOffAddrOp WordVec 16 W16) = 1280+primOpTag (VecWriteScalarOffAddrOp WordVec 8 W32) = 1281+primOpTag (VecWriteScalarOffAddrOp WordVec 4 W64) = 1282+primOpTag (VecWriteScalarOffAddrOp WordVec 64 W8) = 1283+primOpTag (VecWriteScalarOffAddrOp WordVec 32 W16) = 1284+primOpTag (VecWriteScalarOffAddrOp WordVec 16 W32) = 1285+primOpTag (VecWriteScalarOffAddrOp WordVec 8 W64) = 1286+primOpTag (VecWriteScalarOffAddrOp FloatVec 4 W32) = 1287+primOpTag (VecWriteScalarOffAddrOp FloatVec 2 W64) = 1288+primOpTag (VecWriteScalarOffAddrOp FloatVec 8 W32) = 1289+primOpTag (VecWriteScalarOffAddrOp FloatVec 4 W64) = 1290+primOpTag (VecWriteScalarOffAddrOp FloatVec 16 W32) = 1291+primOpTag (VecWriteScalarOffAddrOp FloatVec 8 W64) = 1292+primOpTag PrefetchByteArrayOp3 = 1293+primOpTag PrefetchMutableByteArrayOp3 = 1294+primOpTag PrefetchAddrOp3 = 1295+primOpTag PrefetchValueOp3 = 1296+primOpTag PrefetchByteArrayOp2 = 1297+primOpTag PrefetchMutableByteArrayOp2 = 1298+primOpTag PrefetchAddrOp2 = 1299+primOpTag PrefetchValueOp2 = 1300+primOpTag PrefetchByteArrayOp1 = 1301+primOpTag PrefetchMutableByteArrayOp1 = 1302+primOpTag PrefetchAddrOp1 = 1303+primOpTag PrefetchValueOp1 = 1304+primOpTag PrefetchByteArrayOp0 = 1305+primOpTag PrefetchMutableByteArrayOp0 = 1306+primOpTag PrefetchAddrOp0 = 1307+primOpTag PrefetchValueOp0 = 1308
ghc-lib/stage0/rts/build/include/GhclibDerivedConstants.h view
@@ -301,6 +301,19 @@ #define StgAP_STACK_fun(__ptr__) REP_StgAP_STACK_fun[__ptr__+SIZEOF_StgHeader+OFFSET_StgAP_STACK_fun] #define OFFSET_StgAP_STACK_payload 24 #define StgAP_STACK_payload(__ptr__,__ix__) W_[__ptr__+SIZEOF_StgHeader+OFFSET_StgAP_STACK_payload + WDS(__ix__)]+#define SIZEOF_StgContinuation_NoHdr 24+#define SIZEOF_StgContinuation (SIZEOF_StgHeader+24)+#define OFFSET_StgContinuation_apply_mask_frame 0+#define REP_StgContinuation_apply_mask_frame b64+#define StgContinuation_apply_mask_frame(__ptr__) REP_StgContinuation_apply_mask_frame[__ptr__+SIZEOF_StgHeader+OFFSET_StgContinuation_apply_mask_frame]+#define OFFSET_StgContinuation_mask_frame_offset 8+#define REP_StgContinuation_mask_frame_offset b64+#define StgContinuation_mask_frame_offset(__ptr__) REP_StgContinuation_mask_frame_offset[__ptr__+SIZEOF_StgHeader+OFFSET_StgContinuation_mask_frame_offset]+#define OFFSET_StgContinuation_stack_size 16+#define REP_StgContinuation_stack_size b64+#define StgContinuation_stack_size(__ptr__) REP_StgContinuation_stack_size[__ptr__+SIZEOF_StgHeader+OFFSET_StgContinuation_stack_size]+#define OFFSET_StgContinuation_stack 24+#define StgContinuation_stack(__ptr__,__ix__) W_[__ptr__+SIZEOF_StgHeader+OFFSET_StgContinuation_stack + WDS(__ix__)] #define SIZEOF_StgSelector_NoThunkHdr 8 #define SIZEOF_StgSelector_NoHdr 16 #define SIZEOF_StgSelector (SIZEOF_StgHeader+16)