diff --git a/compiler/GHC/Builtin/Names.hs b/compiler/GHC/Builtin/Names.hs --- a/compiler/GHC/Builtin/Names.hs +++ b/compiler/GHC/Builtin/Names.hs @@ -517,7 +517,7 @@ k1TyConName, m1TyConName, sumTyConName, prodTyConName, compTyConName, rTyConName, dTyConName, cTyConName, sTyConName, rec0TyConName, - d1TyConName, c1TyConName, s1TyConName, noSelTyConName, + d1TyConName, c1TyConName, s1TyConName, repTyConName, rep1TyConName, uRecTyConName, uAddrTyConName, uCharTyConName, uDoubleTyConName, uFloatTyConName, uIntTyConName, uWordTyConName, @@ -550,16 +550,16 @@ gHC_GHCI, gHC_GHCI_HELPERS, gHC_CSTRING, gHC_SHOW, gHC_READ, gHC_NUM, gHC_MAYBE, gHC_NUM_INTEGER, gHC_NUM_NATURAL, gHC_NUM_BIGNAT, - gHC_LIST, gHC_TUPLE, dATA_TUPLE, dATA_EITHER, dATA_LIST, dATA_STRING, + gHC_LIST, gHC_TUPLE, dATA_EITHER, dATA_LIST, dATA_STRING, dATA_FOLDABLE, dATA_TRAVERSABLE, gHC_CONC, gHC_IO, gHC_IO_Exception, gHC_ST, gHC_IX, gHC_STABLE, gHC_PTR, gHC_ERR, gHC_REAL, gHC_FLOAT, gHC_TOP_HANDLER, sYSTEM_IO, dYNAMIC, tYPEABLE, tYPEABLE_INTERNAL, gENERICS, rEAD_PREC, lEX, gHC_INT, gHC_WORD, mONAD, mONAD_FIX, mONAD_ZIP, mONAD_FAIL, - aRROW, cONTROL_APPLICATIVE, gHC_DESUGAR, rANDOM, gHC_EXTS, + aRROW, gHC_DESUGAR, rANDOM, gHC_EXTS, cONTROL_EXCEPTION_BASE, gHC_TYPELITS, gHC_TYPELITS_INTERNAL, - gHC_TYPENATS, gHC_TYPENATS_INTERNAL, dATA_TYPE_EQUALITY, + gHC_TYPENATS, gHC_TYPENATS_INTERNAL, dATA_COERCE, dEBUG_TRACE, uNSAFE_COERCE :: Module gHC_PRIM = mkPrimModule (fsLit "GHC.Prim") -- Primitive types and values @@ -585,7 +585,6 @@ gHC_NUM_BIGNAT = mkBignumModule (fsLit "GHC.Num.BigNat") gHC_LIST = mkBaseModule (fsLit "GHC.List") gHC_TUPLE = mkPrimModule (fsLit "GHC.Tuple") -dATA_TUPLE = mkBaseModule (fsLit "Data.Tuple") dATA_EITHER = mkBaseModule (fsLit "Data.Either") dATA_LIST = mkBaseModule (fsLit "Data.List") dATA_STRING = mkBaseModule (fsLit "Data.String") @@ -616,7 +615,6 @@ mONAD_ZIP = mkBaseModule (fsLit "Control.Monad.Zip") mONAD_FAIL = mkBaseModule (fsLit "Control.Monad.Fail") aRROW = mkBaseModule (fsLit "Control.Arrow") -cONTROL_APPLICATIVE = mkBaseModule (fsLit "Control.Applicative") gHC_DESUGAR = mkBaseModule (fsLit "GHC.Desugar") rANDOM = mkBaseModule (fsLit "System.Random") gHC_EXTS = mkBaseModule (fsLit "GHC.Exts") @@ -626,7 +624,6 @@ gHC_TYPELITS_INTERNAL = mkBaseModule (fsLit "GHC.TypeLits.Internal") gHC_TYPENATS = mkBaseModule (fsLit "GHC.TypeNats") gHC_TYPENATS_INTERNAL = mkBaseModule (fsLit "GHC.TypeNats.Internal") -dATA_TYPE_EQUALITY = mkBaseModule (fsLit "Data.Type.Equality") dATA_COERCE = mkBaseModule (fsLit "Data.Coerce") dEBUG_TRACE = mkBaseModule (fsLit "Debug.Trace") uNSAFE_COERCE = mkBaseModule (fsLit "Unsafe.Coerce") @@ -664,10 +661,6 @@ pRELUDE_NAME = mkModuleNameFS (fsLit "Prelude") mAIN_NAME = mkModuleNameFS (fsLit "Main") -dATA_ARRAY_PARALLEL_NAME, dATA_ARRAY_PARALLEL_PRIM_NAME :: ModuleName -dATA_ARRAY_PARALLEL_NAME = mkModuleNameFS (fsLit "Data.Array.Parallel") -dATA_ARRAY_PARALLEL_PRIM_NAME = mkModuleNameFS (fsLit "Data.Array.Parallel.Prim") - mkPrimModule :: FastString -> Module mkPrimModule m = mkModule primUnit (mkModuleNameFS m) @@ -984,7 +977,7 @@ k1TyConName, m1TyConName, sumTyConName, prodTyConName, compTyConName, rTyConName, dTyConName, cTyConName, sTyConName, rec0TyConName, - d1TyConName, c1TyConName, s1TyConName, noSelTyConName, + d1TyConName, c1TyConName, s1TyConName, repTyConName, rep1TyConName, uRecTyConName, uAddrTyConName, uCharTyConName, uDoubleTyConName, uFloatTyConName, uIntTyConName, uWordTyConName, @@ -1016,7 +1009,6 @@ d1TyConName = tcQual gHC_GENERICS (fsLit "D1") d1TyConKey c1TyConName = tcQual gHC_GENERICS (fsLit "C1") c1TyConKey s1TyConName = tcQual gHC_GENERICS (fsLit "S1") s1TyConKey -noSelTyConName = tcQual gHC_GENERICS (fsLit "NoSelector") noSelTyConKey repTyConName = tcQual gHC_GENERICS (fsLit "Rep") repTyConKey rep1TyConName = tcQual gHC_GENERICS (fsLit "Rep1") rep1TyConKey @@ -1889,7 +1881,7 @@ wordPrimTyConKey, wordTyConKey, word8PrimTyConKey, word8TyConKey, word16PrimTyConKey, word16TyConKey, word32PrimTyConKey, word32TyConKey, word64PrimTyConKey, word64TyConKey, - anyBoxConKey, kindConKey, boxityConKey, + kindConKey, boxityConKey, typeConKey, threadIdPrimTyConKey, bcoPrimTyConKey, ptrTyConKey, funPtrTyConKey, tVarPrimTyConKey, eqPrimTyConKey, eqReprPrimTyConKey, eqPhantPrimTyConKey, @@ -1912,7 +1904,6 @@ word32TyConKey = mkPreludeTyConUnique 66 word64PrimTyConKey = mkPreludeTyConUnique 67 word64TyConKey = mkPreludeTyConUnique 68 -anyBoxConKey = mkPreludeTyConUnique 71 kindConKey = mkPreludeTyConUnique 72 boxityConKey = mkPreludeTyConUnique 73 typeConKey = mkPreludeTyConUnique 74 @@ -1951,7 +1942,7 @@ k1TyConKey, m1TyConKey, sumTyConKey, prodTyConKey, compTyConKey, rTyConKey, dTyConKey, cTyConKey, sTyConKey, rec0TyConKey, - d1TyConKey, c1TyConKey, s1TyConKey, noSelTyConKey, + d1TyConKey, c1TyConKey, s1TyConKey, repTyConKey, rep1TyConKey, uRecTyConKey, uAddrTyConKey, uCharTyConKey, uDoubleTyConKey, uFloatTyConKey, uIntTyConKey, uWordTyConKey :: Unique @@ -1976,7 +1967,6 @@ d1TyConKey = mkPreludeTyConUnique 151 c1TyConKey = mkPreludeTyConUnique 152 s1TyConKey = mkPreludeTyConUnique 153 -noSelTyConKey = mkPreludeTyConUnique 154 repTyConKey = mkPreludeTyConUnique 155 rep1TyConKey = mkPreludeTyConUnique 156 @@ -2277,7 +2267,7 @@ -} wildCardKey, absentErrorIdKey, augmentIdKey, appendIdKey, - buildIdKey, errorIdKey, foldrIdKey, recSelErrorIdKey, + buildIdKey, foldrIdKey, recSelErrorIdKey, seqIdKey, eqStringIdKey, noMethodBindingErrorIdKey, nonExhaustiveGuardsErrorIdKey, runtimeErrorIdKey, patErrorIdKey, voidPrimIdKey, @@ -2295,7 +2285,6 @@ augmentIdKey = mkPreludeMiscIdUnique 2 appendIdKey = mkPreludeMiscIdUnique 3 buildIdKey = mkPreludeMiscIdUnique 4 -errorIdKey = mkPreludeMiscIdUnique 5 foldrIdKey = mkPreludeMiscIdUnique 6 recSelErrorIdKey = mkPreludeMiscIdUnique 7 seqIdKey = mkPreludeMiscIdUnique 8 diff --git a/compiler/GHC/Builtin/Types/Prim.hs b/compiler/GHC/Builtin/Types/Prim.hs --- a/compiler/GHC/Builtin/Types/Prim.hs +++ b/compiler/GHC/Builtin/Types/Prim.hs @@ -28,13 +28,17 @@ runtimeRep1TyVar, runtimeRep2TyVar, runtimeRep3TyVar, runtimeRep1TyVarInf, runtimeRep2TyVarInf, runtimeRep1Ty, runtimeRep2Ty, runtimeRep3Ty, - levity1TyVar, levity1TyVarInf, levity1Ty, + levity1TyVar, levity2TyVar, + levity1TyVarInf, levity2TyVarInf, + levity1Ty, levity2Ty, openAlphaTyVar, openBetaTyVar, openGammaTyVar, openAlphaTyVarSpec, openBetaTyVarSpec, openGammaTyVarSpec, openAlphaTy, openBetaTy, openGammaTy, - levPolyTyVar1, levPolyTyVar1Spec, levPolyTy1, + levPolyAlphaTyVar, levPolyBetaTyVar, + levPolyAlphaTyVarSpec, levPolyBetaTyVarSpec, + levPolyAlphaTy, levPolyBetaTy, multiplicityTyVar1, multiplicityTyVar2, @@ -422,25 +426,35 @@ openBetaTy = mkTyVarTy openBetaTyVar openGammaTy = mkTyVarTy openGammaTyVar -levity1TyVar :: TyVar -(levity1TyVar : _) - = drop 11 (mkTemplateTyVars (repeat levityTy)) -- selects 'l' +levity1TyVar, levity2TyVar :: TyVar +(levity2TyVar : levity1TyVar : _) -- NB: levity2TyVar before levity1TyVar + = drop 10 (mkTemplateTyVars (repeat levityTy)) -- selects 'k', 'l' +-- The ordering of levity2TyVar before levity1TyVar is chosen so that +-- the more common levity1TyVar uses the levity variable 'l'. -levity1TyVarInf :: TyVarBinder +levity1TyVarInf, levity2TyVarInf :: TyVarBinder levity1TyVarInf = mkTyVarBinder Inferred levity1TyVar +levity2TyVarInf = mkTyVarBinder Inferred levity2TyVar -levity1Ty :: Type +levity1Ty, levity2Ty :: Type levity1Ty = mkTyVarTy levity1TyVar +levity2Ty = mkTyVarTy levity2TyVar -levPolyTyVar1 :: TyVar -[levPolyTyVar1] = mkTemplateTyVars [tYPE (mkTyConApp boxedRepDataConTyCon [levity1Ty])] --- tv :: TYPE ('BoxedRep l) +levPolyAlphaTyVar, levPolyBetaTyVar :: TyVar +[levPolyAlphaTyVar, levPolyBetaTyVar] = + mkTemplateTyVars + [tYPE (mkTyConApp boxedRepDataConTyCon [levity1Ty]) + ,tYPE (mkTyConApp boxedRepDataConTyCon [levity2Ty])] +-- alpha :: TYPE ('BoxedRep l) +-- beta :: TYPE ('BoxedRep k) -levPolyTyVar1Spec :: TyVarBinder -levPolyTyVar1Spec = mkTyVarBinder Specified levPolyTyVar1 +levPolyAlphaTyVarSpec, levPolyBetaTyVarSpec :: TyVarBinder +levPolyAlphaTyVarSpec = mkTyVarBinder Specified levPolyAlphaTyVar +levPolyBetaTyVarSpec = mkTyVarBinder Specified levPolyBetaTyVar -levPolyTy1 :: Type -levPolyTy1 = mkTyVarTy levPolyTyVar1 +levPolyAlphaTy, levPolyBetaTy :: Type +levPolyAlphaTy = mkTyVarTy levPolyAlphaTyVar +levPolyBetaTy = mkTyVarTy levPolyBetaTyVar multiplicityTyVar1, multiplicityTyVar2 :: TyVar (multiplicityTyVar1 : multiplicityTyVar2 : _) diff --git a/compiler/GHC/Cmm/MachOp.hs b/compiler/GHC/Cmm/MachOp.hs --- a/compiler/GHC/Cmm/MachOp.hs +++ b/compiler/GHC/Cmm/MachOp.hs @@ -586,6 +586,41 @@ | MO_F32_Fabs | MO_F32_Sqrt + -- 64-bit int/word ops for when they exceed the native word size + -- (i.e. on 32-bit architectures) + | MO_I64_ToI + | MO_I64_FromI + | MO_W64_ToW + | MO_W64_FromW + + | MO_x64_Neg + | MO_x64_Add + | MO_x64_Sub + | MO_x64_Mul + | MO_I64_Quot + | MO_I64_Rem + | MO_W64_Quot + | MO_W64_Rem + + | MO_x64_And + | MO_x64_Or + | MO_x64_Xor + | MO_x64_Not + | MO_x64_Shl + | MO_I64_Shr + | MO_W64_Shr + + | MO_x64_Eq + | MO_x64_Ne + | MO_I64_Ge + | MO_I64_Gt + | MO_I64_Le + | MO_I64_Lt + | MO_W64_Ge + | MO_W64_Gt + | MO_W64_Le + | MO_W64_Lt + | MO_UF_Conv Width | MO_S_Mul2 Width diff --git a/compiler/GHC/Core/Coercion.hs b/compiler/GHC/Core/Coercion.hs --- a/compiler/GHC/Core/Coercion.hs +++ b/compiler/GHC/Core/Coercion.hs @@ -34,7 +34,7 @@ mkPiCo, mkPiCos, mkCoCast, mkSymCo, mkTransCo, mkNthCo, mkNthCoFunCo, nthCoRole, mkLRCo, - mkInstCo, mkAppCo, mkAppCos, mkTyConAppCo, mkFunCo, + mkInstCo, mkAppCo, mkAppCos, mkTyConAppCo, mkFunCo, mkFunResCo, mkForAllCo, mkForAllCos, mkHomoForAllCos, mkPhantomCo, mkHoleCo, mkUnivCo, mkSubCo, @@ -71,7 +71,9 @@ isReflCoVar_maybe, isGReflMCo, mkGReflLeftMCo, mkGReflRightMCo, mkCoherenceRightMCo, - coToMCo, mkTransMCo, mkTransMCoL, mkCastTyMCo, mkSymMCo, isReflMCo, + coToMCo, mkTransMCo, mkTransMCoL, mkTransMCoR, mkCastTyMCo, mkSymMCo, + mkHomoForAllMCo, mkFunResMCo, mkPiMCos, + isReflMCo, checkReflexiveMCo, -- ** Coercion variables mkCoVar, isCoVar, coVarName, setCoVarName, setCoVarUnique, @@ -309,6 +311,11 @@ coToMCo co | isReflCo co = MRefl | otherwise = MCo co +checkReflexiveMCo :: MCoercion -> MCoercion +checkReflexiveMCo MRefl = MRefl +checkReflexiveMCo (MCo co) | isReflexiveCo co = MRefl + | otherwise = MCo co + -- | Tests if this MCoercion is obviously generalized reflexive -- Guaranteed to work very quickly. isGReflMCo :: MCoercion -> Bool @@ -333,6 +340,10 @@ mkTransMCoL MRefl co2 = MCo co2 mkTransMCoL (MCo co1) co2 = MCo (mkTransCo co1 co2) +mkTransMCoR :: Coercion -> MCoercion -> MCoercion +mkTransMCoR co1 MRefl = coToMCo co1 +mkTransMCoR co1 (MCo co2) = MCo (mkTransCo co1 co2) + -- | Get the reverse of an 'MCoercion' mkSymMCo :: MCoercion -> MCoercion mkSymMCo MRefl = MRefl @@ -343,6 +354,18 @@ mkCastTyMCo ty MRefl = ty mkCastTyMCo ty (MCo co) = ty `mkCastTy` co +mkHomoForAllMCo :: TyCoVar -> MCoercion -> MCoercion +mkHomoForAllMCo _ MRefl = MRefl +mkHomoForAllMCo tcv (MCo co) = MCo (mkHomoForAllCos [tcv] co) + +mkPiMCos :: [Var] -> MCoercion -> MCoercion +mkPiMCos _ MRefl = MRefl +mkPiMCos vs (MCo co) = MCo (mkPiCos Representational vs co) + +mkFunResMCo :: Scaled Type -> MCoercionR -> MCoercionR +mkFunResMCo _ MRefl = MRefl +mkFunResMCo arg_ty (MCo co) = MCo (mkFunResCo Representational arg_ty co) + mkGReflLeftMCo :: Role -> Type -> MCoercionN -> Coercion mkGReflLeftMCo r ty MRefl = mkReflCo r ty mkGReflLeftMCo r ty (MCo co) = mkGReflLeftCo r ty co @@ -402,6 +425,10 @@ -- Expects co :: (s1 -> t1) ~ (s2 -> t2) -- Returns (co1 :: s1~s2, co2 :: t1~t2) -- See Note [Function coercions] for the "3" and "4" + +decomposeFunCo _ (FunCo _ w co1 co2) = (w, co1, co2) + -- Short-circuits the calls to mkNthCo + decomposeFunCo r co = assertPpr all_ok (ppr co) (mkNthCo Nominal 0 co, mkNthCo r 3 co, mkNthCo r 4 co) where @@ -1051,18 +1078,18 @@ -> Coercion mkNthCo r n co = assertPpr good_call bad_call_msg $ - go r n co + go n co where Pair ty1 ty2 = coercionKind co - go r 0 co + go 0 co | Just (ty, _) <- isReflCo_maybe co , Just (tv, _) <- splitForAllTyCoVar_maybe ty = -- works for both tyvar and covar assert (r == Nominal) $ mkNomReflCo (varType tv) - go r n co + go n co | Just (ty, r0) <- isReflCo_maybe co , let tc = tyConAppTyCon ty = assertPpr (ok_tc_app ty n) (ppr n $$ ppr ty) $ @@ -1077,7 +1104,7 @@ | otherwise = False - go r 0 (ForAllCo _ kind_co _) + go 0 (ForAllCo _ kind_co _) = assert (r == Nominal) kind_co -- If co :: (forall a1:k1. t1) ~ (forall a2:k2. t2) @@ -1085,10 +1112,10 @@ -- If co :: (forall a1:t1 ~ t2. t1) ~ (forall a2:t3 ~ t4. t2) -- then (nth 0 co :: (t1 ~ t2) ~N (t3 ~ t4)) - go _ n (FunCo _ w arg res) + go n (FunCo _ w arg res) = mkNthCoFunCo n w arg res - go r n (TyConAppCo r0 tc arg_cos) = assertPpr (r == nthRole r0 tc n) + go n (TyConAppCo r0 tc arg_cos) = assertPpr (r == nthRole r0 tc n) (vcat [ ppr tc , ppr arg_cos , ppr r0 @@ -1096,9 +1123,12 @@ , ppr r ]) $ arg_cos `getNth` n - go r n co = - NthCo r n co + go n (SymCo co) -- Recurse, hoping to get to a TyConAppCo or FunCo + = mkSymCo (go n co) + go n co + = NthCo r n co + -- Assertion checking bad_call_msg = vcat [ text "Coercion =" <+> ppr co , text "LHS ty =" <+> ppr ty1 @@ -1619,9 +1649,18 @@ -- want it to be r. It is only called in 'mkPiCos', which is -- only used in GHC.Core.Opt.Simplify.Utils, where we are sure for -- now (Aug 2018) v won't occur in co. - mkFunCo r (multToCo (varMult v)) (mkReflCo r (varType v)) co - | otherwise = mkFunCo r (multToCo (varMult v)) (mkReflCo r (varType v)) co + mkFunResCo r scaled_ty co + | otherwise = mkFunResCo r scaled_ty co + where + scaled_ty = Scaled (varMult v) (varType v) +mkFunResCo :: Role -> Scaled Type -> Coercion -> Coercion +-- Given res_co :: res1 -> res2, +-- mkFunResCo r m arg res_co :: (arg -> res1) ~r (arg -> res2) +-- Reflexive in the multiplicity argument +mkFunResCo role (Scaled mult arg_ty) res_co + = mkFunCo role (multToCo mult) (mkReflCo role arg_ty) res_co + -- mkCoCast (c :: s1 ~?r t1) (g :: (s1 ~?r t1) ~#R (s2 ~?r t2)) :: s2 ~?r t2 -- The first coercion might be lifted or unlifted; thus the ~? above -- Lifted and unlifted equalities take different numbers of arguments, @@ -1777,7 +1816,7 @@ -- -- > topNormaliseNewType_maybe rec_nts ty = Just (co, ty') -- --- then (a) @co : ty0 ~ ty'@. +-- then (a) @co : ty ~ ty'@. -- (b) ty' is not a newtype. -- -- The function returns @Nothing@ for non-@newtypes@, diff --git a/compiler/GHC/Core/Make.hs b/compiler/GHC/Core/Make.hs --- a/compiler/GHC/Core/Make.hs +++ b/compiler/GHC/Core/Make.hs @@ -99,12 +99,13 @@ * * ************************************************************************ -} -sortQuantVars :: [Var] -> [Var] --- Sort the variables, putting type and covars first, in scoped order, +-- | Sort the variables, putting type and covars first, in scoped order, -- and then other Ids +-- -- It is a deterministic sort, meaining it doesn't look at the values of -- Uniques. For explanation why it's important See Note [Unique Determinism] -- in GHC.Types.Unique. +sortQuantVars :: [Var] -> [Var] sortQuantVars vs = sorted_tcvs ++ ids where (tcvs, ids) = partition (isTyVar <||> isCoVar) vs @@ -137,9 +138,12 @@ -- | Construct an expression which represents the application of a number of -- expressions to another. The leftmost expression in the list is applied first +-- -- Respects the let/app invariant by building a case expression where necessary -- See Note [Core let/app invariant] in "GHC.Core" -mkCoreApps :: CoreExpr -> [CoreExpr] -> CoreExpr +mkCoreApps :: CoreExpr -- ^ function + -> [CoreExpr] -- ^ arguments + -> CoreExpr mkCoreApps fun args = fst $ foldl' (mkCoreAppTyped doc_string) (fun, fun_ty) args @@ -149,9 +153,13 @@ -- | Construct an expression which represents the application of one expression -- to the other +-- -- Respects the let/app invariant by building a case expression where necessary -- See Note [Core let/app invariant] in "GHC.Core" -mkCoreApp :: SDoc -> CoreExpr -> CoreExpr -> CoreExpr +mkCoreApp :: SDoc + -> CoreExpr -- ^ function + -> CoreExpr -- ^ argument + -> CoreExpr mkCoreApp s fun arg = fst $ mkCoreAppTyped s (fun, exprType fun) arg @@ -159,6 +167,7 @@ -- paired with its type to an argument. The result is paired with its type. This -- function is not exported and used in the definition of 'mkCoreApp' and -- 'mkCoreApps'. +-- -- Respects the let/app invariant by building a case expression where necessary -- See Note [Core let/app invariant] in "GHC.Core" mkCoreAppTyped :: SDoc -> (CoreExpr, Type) -> CoreExpr -> (CoreExpr, Type) @@ -172,11 +181,11 @@ where (mult, arg_ty, res_ty) = splitFunTy fun_ty -mkValApp :: CoreExpr -> CoreExpr -> Scaled Type -> Type -> CoreExpr --- Build an application (e1 e2), +-- | Build an application (e1 e2), -- or a strict binding (case e2 of x -> e1 x) -- using the latter when necessary to respect the let/app invariant -- See Note [Core let/app invariant] in GHC.Core +mkValApp :: CoreExpr -> CoreExpr -> Scaled Type -> Type -> CoreExpr mkValApp fun arg (Scaled w arg_ty) res_ty | not (needsCaseBinding arg_ty arg) = App fun arg -- The vastly common case @@ -196,20 +205,25 @@ -- that you expect to use only at a *binding* site. Do not use it at -- occurrence sites because it has a single, fixed unique, and it's very -- easy to get into difficulties with shadowing. That's why it is used so little. +-- -- See Note [WildCard binders] in "GHC.Core.Opt.Simplify.Env" mkWildValBinder :: Mult -> Type -> Id mkWildValBinder w ty = mkLocalIdOrCoVar wildCardName w ty -- "OrCoVar" since a coercion can be a scrutinee with -fdefer-type-errors -- (e.g. see test T15695). Ticket #17291 covers fixing this problem. -mkWildCase :: CoreExpr -> Scaled Type -> Type -> [CoreAlt] -> CoreExpr --- Make a case expression whose case binder is unused +-- | Make a case expression whose case binder is unused -- The alts and res_ty should not have any occurrences of WildId +mkWildCase :: CoreExpr -- ^ scrutinee + -> Scaled Type + -> Type -- ^ res_ty + -> [CoreAlt] -- ^ alts + -> CoreExpr mkWildCase scrut (Scaled w scrut_ty) res_ty alts = Case scrut (mkWildValBinder w scrut_ty) res_ty alts +-- | Build a strict application (case e2 of x -> e1 x) mkStrictApp :: CoreExpr -> CoreExpr -> Scaled Type -> Type -> CoreExpr --- Build a strict application (case e2 of x -> e1 x) mkStrictApp fun arg (Scaled w arg_ty) res_ty = Case arg arg_id res_ty [Alt DEFAULT [] (App fun (Var arg_id))] -- mkDefaultCase looks attractive here, and would be sound. @@ -227,7 +241,10 @@ -- expression that uses mkWildValBinder, of which there are not -- many), and pass a fragment of it as the fun part of a 'mkStrictApp'. -mkIfThenElse :: CoreExpr -> CoreExpr -> CoreExpr -> CoreExpr +mkIfThenElse :: CoreExpr -- ^ guard + -> CoreExpr -- ^ then + -> CoreExpr -- ^ else + -> CoreExpr mkIfThenElse guard then_expr else_expr -- Not going to be refining, so okay to take the type of the "then" clause = mkWildCase guard (linear boolTy) (exprType then_expr) @@ -756,10 +773,6 @@ well shouldn't be yanked on, but if one is, then you will get a friendly message from @absentErr@ (rather than a totally random crash). - -@parError@ is a special version of @error@ which the compiler does -not know to be a bottoming Id. It is used in the @_par_@ and @_seq_@ -templates, but we don't ever expect to generate code for it. -} errorIds :: [Id] diff --git a/compiler/GHC/Core/Opt/Arity.hs b/compiler/GHC/Core/Opt/Arity.hs --- a/compiler/GHC/Core/Opt/Arity.hs +++ b/compiler/GHC/Core/Opt/Arity.hs @@ -39,7 +39,7 @@ import GHC.Core.DataCon import GHC.Core.TyCon ( tyConArity ) import GHC.Core.TyCon.RecWalk ( initRecTc, checkRecTc ) -import GHC.Core.Predicate ( isDictTy ) +import GHC.Core.Predicate ( isDictTy, isCallStackPredTy ) import GHC.Core.Multiplicity -- We have two sorts of substitution: @@ -592,7 +592,7 @@ -- | True <=> eta-expansion will add at least one lambda expandableArityType :: ArityType -> Bool -expandableArityType at = arityTypeArity at /= 0 +expandableArityType at = arityTypeArity at > 0 -- | See Note [Dead ends] in "GHC.Types.Demand". -- Bottom implies a dead end. @@ -667,6 +667,7 @@ where env = extendSigEnv (findRhsArityEnv dflags) bndr at + {- Note [Arity analysis] ~~~~~~~~~~~~~~~~~~~~~ @@ -835,6 +836,17 @@ Historical note: long ago, we unconditionally switched to topDiv when we encountered a cast, but that is far too conservative: see #5475 + +Note [Eta expanding through CallStacks] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Just as it's good to eta-expand through dictionaries, so it is good to +do so through CallStacks. #20103 is a case in point, where we got + foo :: HasCallStack => Int -> Int + foo = \(d::CallStack). let d2 = pushCallStack blah d in + \(x:Int). blah + +We really want to eta-expand this! #20103 is quite convincing! +We do this regardless of -fdicts-cheap; it's not really a dictionary. -} --------------------------- @@ -866,6 +878,7 @@ , am_sigs :: !(IdEnv ArityType) } -- ^ Used for regular, fixed-point arity analysis ('findRhsArity'). -- See Note [Arity analysis] for details about fixed-point iteration. + -- INVARIANT: Disjoint with 'ae_joins'. data ArityEnv = AE @@ -873,6 +886,7 @@ -- ^ The analysis mode. See 'AnalysisMode'. , ae_joins :: !IdSet -- ^ In-scope join points. See Note [Eta-expansion and join points] + -- INVARIANT: Disjoint with the domain of 'am_sigs' (if present). } -- | The @ArityEnv@ used by 'exprBotStrictness_maybe'. Pedantic about bottoms @@ -895,15 +909,50 @@ , am_sigs = emptyVarEnv } , ae_joins = emptyVarSet } +-- First some internal functions in snake_case for deleting in certain VarEnvs +-- of the ArityType. Don't call these; call delInScope* instead! + +modifySigEnv :: (IdEnv ArityType -> IdEnv ArityType) -> ArityEnv -> ArityEnv +modifySigEnv f env@AE { ae_mode = am@FindRhsArity{am_sigs = sigs} } = + env { ae_mode = am { am_sigs = f sigs } } +modifySigEnv _ env = env +{-# INLINE modifySigEnv #-} + +del_sig_env :: Id -> ArityEnv -> ArityEnv -- internal! +del_sig_env id = modifySigEnv (\sigs -> delVarEnv sigs id) +{-# INLINE del_sig_env #-} + +del_sig_env_list :: [Id] -> ArityEnv -> ArityEnv -- internal! +del_sig_env_list ids = modifySigEnv (\sigs -> delVarEnvList sigs ids) +{-# INLINE del_sig_env_list #-} + +del_join_env :: JoinId -> ArityEnv -> ArityEnv -- internal! +del_join_env id env@(AE { ae_joins = joins }) + = env { ae_joins = delVarSet joins id } +{-# INLINE del_join_env #-} + +del_join_env_list :: [JoinId] -> ArityEnv -> ArityEnv -- internal! +del_join_env_list ids env@(AE { ae_joins = joins }) + = env { ae_joins = delVarSetList joins ids } +{-# INLINE del_join_env_list #-} + +-- end of internal deletion functions + extendJoinEnv :: ArityEnv -> [JoinId] -> ArityEnv extendJoinEnv env@(AE { ae_joins = joins }) join_ids - = env { ae_joins = joins `extendVarSetList` join_ids } + = del_sig_env_list join_ids + $ env { ae_joins = joins `extendVarSetList` join_ids } extendSigEnv :: ArityEnv -> Id -> ArityType -> ArityEnv -extendSigEnv env@AE { ae_mode = am@FindRhsArity{am_sigs = sigs} } id ar_ty = - env { ae_mode = am { am_sigs = extendVarEnv sigs id ar_ty } } -extendSigEnv env _ _ = env +extendSigEnv env id ar_ty + = del_join_env id (modifySigEnv (\sigs -> extendVarEnv sigs id ar_ty) env) +delInScope :: ArityEnv -> Id -> ArityEnv +delInScope env id = del_join_env id $ del_sig_env id env + +delInScopeList :: ArityEnv -> [Id] -> ArityEnv +delInScopeList env ids = del_join_env_list ids $ del_sig_env_list ids env + lookupSigEnv :: ArityEnv -> Id -> Maybe ArityType lookupSigEnv AE{ ae_mode = mode } id = case mode of BotStrictness -> Nothing @@ -926,7 +975,13 @@ BotStrictness -> False _ -> cheap_dict || cheap_fun e where - cheap_dict = am_dicts_cheap mode && fmap isDictTy mb_ty == Just True + cheap_dict = case mb_ty of + Nothing -> False + Just ty -> (am_dicts_cheap mode && isDictTy ty) + || isCallStackPredTy ty + -- See Note [Eta expanding through dictionaries] + -- See Note [Eta expanding through CallStacks] + cheap_fun e = case mode of #if __GLASGOW_HASKELL__ <= 900 BotStrictness -> panic "impossible" @@ -971,8 +1026,10 @@ -- Lambdas; increase arity arityType env (Lam x e) - | isId x = arityLam x (arityType env e) - | otherwise = arityType env e + | isId x = arityLam x (arityType env' e) + | otherwise = arityType env' e + where + env' = delInScope env x -- Applications; decrease arity, except for types arityType env (App fun (Type _)) @@ -1000,7 +1057,9 @@ | otherwise -- In the remaining cases we may not push = takeWhileOneShot alts_type -- evaluation of the scrutinee in where - alts_type = foldr1 andArityType [arityType env rhs | Alt _ _ rhs <- alts] + env' = delInScope env bndr + arity_type_alt (Alt _con bndrs rhs) = arityType (delInScopeList env' bndrs) rhs + alts_type = foldr1 andArityType (map arity_type_alt alts) arityType env (Let (NonRec j rhs) body) | Just join_arity <- isJoinId_maybe j @@ -1031,9 +1090,10 @@ env' = extendSigEnv env b (arityType env r) arityType env (Let (Rec prs) e) - = floatIn (all is_cheap prs) (arityType env e) + = floatIn (all is_cheap prs) (arityType env' e) where - is_cheap (b,e) = myExprIsCheap env e (Just (idType b)) + env' = delInScopeList env (map fst prs) + is_cheap (b,e) = myExprIsCheap env' e (Just (idType b)) arityType env (Tick t e) | not (tickishIsCode t) = arityType env e @@ -1234,15 +1294,26 @@ -- We should have that: -- -- > ty = exprType e = exprType e' -etaExpand :: Arity -> CoreExpr -> CoreExpr -etaExpandAT :: ArityType -> CoreExpr -> CoreExpr -etaExpand n orig_expr = eta_expand (replicate n NoOneShotInfo) orig_expr -etaExpandAT (AT oss _) orig_expr = eta_expand oss orig_expr - -- See Note [Eta expansion with ArityType] +etaExpand :: Arity -> CoreExpr -> CoreExpr +etaExpand n orig_expr + = eta_expand in_scope (replicate n NoOneShotInfo) orig_expr + where + in_scope = {-#SCC "eta_expand:in-scopeX" #-} + mkInScopeSet (exprFreeVars orig_expr) +etaExpandAT :: InScopeSet -> ArityType -> CoreExpr -> CoreExpr +-- See Note [Eta expansion with ArityType] +-- +-- We pass in the InScopeSet from the simplifier to avoid recomputing +-- it here, which can be jolly expensive if the casts are big +-- In #18223 it took 10% of compile time just to do the exprFreeVars! +etaExpandAT in_scope (AT oss _) orig_expr + = eta_expand in_scope oss orig_expr + -- etaExpand arity e = res -- Then 'res' has at least 'arity' lambdas at the top +-- possibly with a cast wrapped around the outside -- See Note [Eta expansion with ArityType] -- -- etaExpand deals with for-alls. For example: @@ -1250,33 +1321,43 @@ -- where E :: forall a. a -> a -- would return -- (/\b. \y::a -> E b y) --- --- It deals with coerces too, though they are now rare --- so perhaps the extra code isn't worth it -eta_expand :: [OneShotInfo] -> CoreExpr -> CoreExpr -eta_expand one_shots orig_expr - = go one_shots orig_expr +eta_expand :: InScopeSet -> [OneShotInfo] -> CoreExpr -> CoreExpr +eta_expand in_scope one_shots (Cast expr co) + = Cast (eta_expand in_scope one_shots expr) co + +eta_expand in_scope one_shots orig_expr + = go in_scope one_shots [] orig_expr where -- Strip off existing lambdas and casts before handing off to mkEtaWW + -- This is mainly to avoid spending time cloning binders and substituting + -- when there is actually nothing to do. It's slightly awkward to deal + -- with casts here, apart from the topmost one, and they are rare, so + -- if we find one we just hand off to mkEtaWW anyway -- Note [Eta expansion and SCCs] - go [] expr = expr - go oss@(_:oss1) (Lam v body) | isTyVar v = Lam v (go oss body) - | otherwise = Lam v (go oss1 body) - go oss (Cast expr co) = Cast (go oss expr) co + go _ [] _ _ = orig_expr -- Already has the specified arity; no-op - go oss expr - = -- pprTrace "ee" (vcat [ppr orig_expr, ppr expr, pprEtaInfos etas]) $ - retick $ etaInfoAbs etas (etaInfoApp in_scope' sexpr etas) + go in_scope oss@(_:oss1) vs (Lam v body) + | isTyVar v = go (in_scope `extendInScopeSet` v) oss (v:vs) body + | otherwise = go (in_scope `extendInScopeSet` v) oss1 (v:vs) body + + go in_scope oss rev_vs expr + = -- pprTrace "ee" (vcat [ppr in_scope', ppr top_bndrs, ppr eis]) $ + retick $ + etaInfoAbs top_eis $ + etaInfoApp in_scope' sexpr eis where - in_scope = mkInScopeSet (exprFreeVars expr) - (in_scope', etas) = mkEtaWW oss (ppr orig_expr) in_scope (exprType expr) + (in_scope', eis@(EI eta_bndrs mco)) + = mkEtaWW oss (ppr orig_expr) in_scope (exprType expr) + top_bndrs = reverse rev_vs + top_eis = EI (top_bndrs ++ eta_bndrs) (mkPiMCos top_bndrs mco) -- Find ticks behind type apps. -- See Note [Eta expansion and source notes] + -- I don't really understand this code SLPJ May 21 (expr', args) = collectArgs expr (ticks, expr'') = stripTicksTop tickishFloatable expr' - sexpr = foldl' App expr'' args + sexpr = mkApps expr'' args retick expr = foldr mkTick expr ticks {- ********************************************************************* @@ -1291,44 +1372,50 @@ Suppose we have (e :: ty) and we want to eta-expand it to arity N. This what eta_expand does. We do it in two steps: -1. mkEtaWW: from 'ty' and 'N' build a [EtaInfo] which describes +1. mkEtaWW: from 'ty' and 'N' build a EtaInfo which describes the shape of the expansion necessary to expand to arity N. 2. Build the term \ v1..vn. e v1 .. vn where those abstractions and applications are described by - the same [EtaInfo]. Specifically we build the term + the same EtaInfo. Specifically we build the term etaInfoAbs etas (etaInfoApp in_scope e etas) - where etas :: [EtaInfo]# + where etas :: EtaInfo etaInfoAbs builds the lambdas etaInfoApp builds the applictions - Note that the /same/ [EtaInfo] drives both etaInfoAbs and etaInfoApp + Note that the /same/ EtaInfo drives both etaInfoAbs and etaInfoApp -To a first approximation [EtaInfo] is just [Var]. But +To a first approximation EtaInfo is just [Var]. But casts complicate the question. If we have newtype N a = MkN (S -> a) + axN :: N a ~ S -> a and - ty = N (N Int) -then the eta-expansion must look like - (\x (\y. ((e |> co1) x) |> co2) y) - |> sym co2) - |> sym co1 + e :: N (N Int) +then the eta-expansion should look like + (\(x::S) (y::S) -> e |> co x y) |> sym co where - co1 :: N (N Int) ~ S -> N Int - co2 :: N Int ~ S -> Int + co :: N (N Int) ~ S -> S -> Int + co = axN @(N Int) ; (S -> axN @Int) -Blimey! Look at all those casts. Moreover, if the type -is very deeply nested (as happens in #18223), the repetition +We want to get one cast, at the top, to account for all those +nested newtypes. This is expressed by the EtaInfo type: + + data EtaInfo = EI [Var] MCoercionR + +Note [Check for reflexive casts in eta expansion] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +It turns out that the casts created by teh above mechanism are often Refl. +When casts are very deeply nested (as happens in #18223), the repetition of types can make the overall term very large. So there is a big payoff in cancelling out casts aggressively wherever possible. (See also Note [No crap in eta-expanded code].) -This matters a lot in etaEInfoApp, where we +This matters particularly in etaInfoApp, where we * Do beta-reduction on the fly -* Use getARg_mabye to get a cast out of the way, +* Use getArg_maybe to get a cast out of the way, so that we can do beta reduction Together this makes a big difference. Consider when e is case x of @@ -1343,105 +1430,73 @@ #18223 was a dramatic example in which the intermediate term was grotesquely huge, even though the next Simplifier iteration squashed it. Better to kill it at birth. --} --------------- -data EtaInfo -- Abstraction Application - = EtaVar Var -- /\a. [] [] a - -- (\x. []) [] x - | EtaCo CoercionR -- [] |> sym co [] |> co - -instance Outputable EtaInfo where - ppr (EtaVar v) = text "EtaVar" <+> ppr v <+> dcolon <+> ppr (idType v) - ppr (EtaCo co) = text "EtaCo" <+> hang (ppr co) 2 (dcolon <+> ppr (coercionType co)) - --- Used in debug-printing --- pprEtaInfos :: [EtaInfo] -> SDoc --- pprEtaInfos eis = brackets $ vcat $ punctuate comma $ map ppr eis +The crucial spots in etaInfoApp are: +* `checkReflexiveMCo` in the (Cast e co) case of `go` +* `checkReflexiveMCo` in `pushCoArg` +* Less important: checkReflexiveMCo in the final case of `go` +Collectively these make a factor-of-5 difference to the total +allocation of T18223, so take care if you change this stuff! -pushCoercion :: Coercion -> [EtaInfo] -> [EtaInfo] --- Puts a EtaCo on the front of a [EtaInfo], but combining --- with an existing EtaCo if possible --- A minor improvement -pushCoercion co1 (EtaCo co2 : eis) - | isReflCo co = eis - | otherwise = EtaCo co : eis - where - co = co1 `mkTransCo` co2 +Example: + newtype N = MkN (Y->Z) + f :: X -> N + f = \(x::X). ((\(y::Y). blah) |> fco) -pushCoercion co eis - = EtaCo co : eis +where fco :: (Y->Z) ~ N -getArg_maybe :: [EtaInfo] -> Maybe (CoreArg, [EtaInfo]) --- Get an argument to the front of the [EtaInfo], if possible, --- by pushing any EtaCo through the argument -getArg_maybe eis = go MRefl eis +mkEtaWW makes an EtaInfo of (EI [(eta1:X), (eta2:Y)] eta_co where - go :: MCoercion -> [EtaInfo] -> Maybe (CoreArg, [EtaInfo]) - go _ [] = Nothing - go mco (EtaCo co2 : eis) = go (mkTransMCoL mco co2) eis - go MRefl (EtaVar v : eis) = Just (varToCoreExpr v, eis) - go (MCo co) (EtaVar v : eis) - | Just (arg, mco) <- pushCoArg co (varToCoreExpr v) - = case mco of - MRefl -> Just (arg, eis) - MCo co -> Just (arg, pushCoercion co eis) - | otherwise - = Nothing + eta_co :: (X->N) ~ (X->Y->Z) + eta_co = ( -> nco) + nco :: N ~ (Y->Z) -- Comes from topNormaliseNewType_maybe -mkCastMCo :: CoreExpr -> MCoercionR -> CoreExpr -mkCastMCo e MRefl = e -mkCastMCo e (MCo co) = Cast e co - -- We are careful to use (MCo co) only when co is not reflexive - -- Hence (Cast e co) rather than (mkCast e co) +Now, when we push that eta_co inward in etaInfoApp: +* In the (Cast e co) case, the 'fco' and 'nco' will meet, and + should cancel. +* When we meet the (\y.e) we want no cast on the y. -mkPiMCo :: Var -> MCoercionR -> MCoercionR -mkPiMCo _ MRefl = MRefl -mkPiMCo v (MCo co) = MCo (mkPiCo Representational v co) +-} -------------- -etaInfoAbs :: [EtaInfo] -> CoreExpr -> CoreExpr --- See Note [The EtaInfo mechanism] -etaInfoAbs eis expr - | null eis = expr - | otherwise = case final_mco of - MRefl -> expr' - MCo co -> mkCast expr' co - where - (expr', final_mco) = foldr do_one (split_cast expr) eis +data EtaInfo = EI [Var] MCoercionR - do_one :: EtaInfo -> (CoreExpr, MCoercion) -> (CoreExpr, MCoercion) - -- Implements the "Abstraction" column in the comments for data EtaInfo - -- In both argument and result the pair (e,mco) denotes (e |> mco) - do_one (EtaVar v) (expr, mco) = (Lam v expr, mkPiMCo v mco) - do_one (EtaCo co) (expr, mco) = (expr, mco `mkTransMCoL` mkSymCo co) +-- (EI bs co) describes a particular eta-expansion, as follows: +-- Abstraction: (\b1 b2 .. bn. []) |> sym co +-- Application: ([] |> co) b1 b2 .. bn +-- +-- e :: T co :: T ~ (t1 -> t2 -> .. -> tn -> tr) +-- e = (\b1 b2 ... bn. (e |> co) b1 b2 .. bn) |> sym co - split_cast :: CoreExpr -> (CoreExpr, MCoercion) - split_cast (Cast e co) = (e, MCo co) - split_cast e = (e, MRefl) - -- We could look in the body of lets, and the branches of a case - -- But then we would have to worry about whether the cast mentioned - -- any of the bound variables, which is tiresome. Later maybe. - -- Result: we may end up with - -- (\(x::Int). case x of { DEFAULT -> e1 |> co }) |> sym (->co) - -- and fail to optimise it away +instance Outputable EtaInfo where + ppr (EI vs mco) = text "EI" <+> ppr vs <+> parens (ppr mco) --------------- -etaInfoApp :: InScopeSet -> CoreExpr -> [EtaInfo] -> CoreExpr --- (etaInfoApp s e eis) returns something equivalent to --- (substExpr s e `appliedto` eis) + +etaInfoApp :: InScopeSet -> CoreExpr -> EtaInfo -> CoreExpr +-- (etaInfoApp s e (EI bs mco) returns something equivalent to +-- ((substExpr s e) |> mco b1 .. bn) -- See Note [The EtaInfo mechanism] +-- +-- NB: With very deeply nested casts, this function can be expensive +-- In T18223, this function alone costs 15% of allocation, all +-- spent in the calls to substExprSC and substBindSC etaInfoApp in_scope expr eis = go (mkEmptySubst in_scope) expr eis where - go :: Subst -> CoreExpr -> [EtaInfo] -> CoreExpr + go :: Subst -> CoreExpr -> EtaInfo -> CoreExpr -- 'go' pushed down the eta-infos into the branch of a case -- and the body of a let; and does beta-reduction if possible + -- go subst fun co [b1,..,bn] returns (subst(fun) |> co) b1 .. bn go subst (Tick t e) eis = Tick (substTickish subst t) (go subst e eis) - go subst (Cast e co) eis - = go subst e (pushCoercion (Core.substCo subst co) eis) + + go subst (Cast e co) (EI bs mco) + = go subst e (EI bs mco') + where + mco' = checkReflexiveMCo (Core.substCo subst co `mkTransMCoR` mco) + -- See Note [Check for reflexive casts in eta-expansion] + go subst (Case e b ty alts) eis = Case (Core.substExprSC subst e) b1 ty' alts' where @@ -1450,37 +1505,43 @@ ty' = etaInfoAppTy (Core.substTy subst ty) eis subst_alt (Alt con bs rhs) = Alt con bs' (go subst2 rhs eis) where - (subst2,bs') = Core.substBndrs subst1 bs + (subst2,bs') = Core.substBndrs subst1 bs + go subst (Let b e) eis | not (isJoinBind b) -- See Note [Eta expansion for join points] = Let b' (go subst' e eis) where (subst', b') = Core.substBindSC subst b - -- Beta-reduction if possible, using getArg_maybe to push - -- any intervening casts past the argument - -- See Note [The EtaInfo mechansim] - go subst (Lam v e) eis - | Just (arg, eis') <- getArg_maybe eis - = go (Core.extendSubst subst v arg) e eis' + -- Beta-reduction if possible, pushing any intervening casts past + -- the argument. See Note [The EtaInfo mechansim] + go subst (Lam v e) (EI (b:bs) mco) + | Just (arg,mco') <- pushMCoArg mco (varToCoreExpr b) + = go (Core.extendSubst subst v arg) e (EI bs mco') -- Stop pushing down; just wrap the expression up - go subst e eis = wrap (Core.substExprSC subst e) eis - - wrap e [] = e - wrap e (EtaVar v : eis) = wrap (App e (varToCoreExpr v)) eis - wrap e (EtaCo co : eis) = wrap (Cast e co) eis - + -- See Note [Check for reflexive casts in eta expansion] + go subst e (EI bs mco) = Core.substExprSC subst e + `mkCastMCo` checkReflexiveMCo mco + `mkVarApps` bs -------------- -etaInfoAppTy :: Type -> [EtaInfo] -> Type +etaInfoAppTy :: Type -> EtaInfo -> Type -- If e :: ty -- then etaInfoApp e eis :: etaInfoApp ty eis -etaInfoAppTy ty [] = ty -etaInfoAppTy ty (EtaVar v : eis) = etaInfoAppTy (applyTypeToArg ty (varToCoreExpr v)) eis -etaInfoAppTy _ (EtaCo co : eis) = etaInfoAppTy (coercionRKind co) eis +etaInfoAppTy ty (EI bs mco) + = applyTypeToArgs (text "etaInfoAppTy") ty1 (map varToCoreExpr bs) + where + ty1 = case mco of + MRefl -> ty + MCo co -> coercionRKind co -------------- +etaInfoAbs :: EtaInfo -> CoreExpr -> CoreExpr +-- See Note [The EtaInfo mechanism] +etaInfoAbs (EI bs mco) expr = (mkLams bs expr) `mkCastMCo` mkSymMCo mco + +-------------- -- | @mkEtaWW n _ fvs ty@ will compute the 'EtaInfo' necessary for eta-expanding -- an expression @e :: ty@ to take @n@ value arguments, where @fvs@ are the -- free variables of @e@. @@ -1496,26 +1557,28 @@ -> InScopeSet -- ^ A super-set of the free vars of the expression to eta-expand. -> Type - -> (InScopeSet, [EtaInfo]) + -> (InScopeSet, EtaInfo) -- ^ The variables in 'EtaInfo' are fresh wrt. to the incoming 'InScopeSet'. -- The outgoing 'InScopeSet' extends the incoming 'InScopeSet' with the -- fresh variables in 'EtaInfo'. mkEtaWW orig_oss ppr_orig_expr in_scope orig_ty - = go 0 orig_oss empty_subst orig_ty [] + = go 0 orig_oss empty_subst orig_ty where empty_subst = mkEmptyTCvSubst in_scope go :: Int -- For fresh names -> [OneShotInfo] -- Number of value args to expand to -> TCvSubst -> Type -- We are really looking at subst(ty) - -> [EtaInfo] -- Accumulating parameter - -> (InScopeSet, [EtaInfo]) - go _ [] subst _ eis -- See Note [exprArity invariant] + -> (InScopeSet, EtaInfo) + -- (go [o1,..,on] subst ty) = (in_scope, EI [b1,..,bn] co) + -- co :: subst(ty) ~ b1_ty -> ... -> bn_ty -> tr + + go _ [] subst _ -- See Note [exprArity invariant] ----------- Done! No more expansion needed - = (getTCvInScope subst, reverse eis) + = (getTCvInScope subst, EI [] MRefl) - go n oss@(one_shot:oss1) subst ty eis -- See Note [exprArity invariant] + go n oss@(one_shot:oss1) subst ty -- See Note [exprArity invariant] ----------- Forall types (forall a. ty) | Just (tcv,ty') <- splitForAllTyCoVar_maybe ty , (subst', tcv') <- Type.substVarBndr subst tcv @@ -1523,7 +1586,8 @@ | otherwise = oss1 -- A forall can bind a CoVar, in which case -- we consume one of the [OneShotInfo] - = go n oss' subst' ty' (EtaVar tcv' : eis) + , (in_scope, EI bs mco) <- go n oss' subst' ty' + = (in_scope, EI (tcv' : bs) (mkHomoForAllMCo tcv' mco)) ----------- Function types (t1 -> t2) | Just (mult, arg_ty, res_ty) <- splitFunTy_maybe ty @@ -1535,7 +1599,8 @@ -- Avoid free vars of the original expression , let eta_id' = eta_id `setIdOneShotInfo` one_shot - = go (n+1) oss1 subst' res_ty (EtaVar eta_id' : eis) + , (in_scope, EI bs mco) <- go (n+1) oss1 subst' res_ty + = (in_scope, EI (eta_id' : bs) (mkFunResMCo (idScaledType eta_id') mco)) ----------- Newtypes -- Given this: @@ -1545,17 +1610,20 @@ -- We want to get -- coerce T (\x::[T] -> (coerce ([T]->Int) e) x) | Just (co, ty') <- topNormaliseNewType_maybe ty - , let co' = Type.substCo subst co + , -- co :: ty ~ ty' + let co' = Type.substCo subst co -- Remember to apply the substitution to co (#16979) -- (or we could have applied to ty, but then -- we'd have had to zap it for the recursive call) - = go n oss subst ty' (pushCoercion co' eis) + , (in_scope, EI bs mco) <- go n oss subst ty' + -- mco :: subst(ty') ~ b1_ty -> ... -> bn_ty -> tr + = (in_scope, EI bs (mkTransMCoR co' mco)) | otherwise -- We have an expression of arity > 0, -- but its type isn't a function, or a binder -- is representation-polymorphic = warnPprTrace True ((ppr orig_oss <+> ppr orig_ty) $$ ppr_orig_expr) - (getTCvInScope subst, reverse eis) + (getTCvInScope subst, EI [] MRefl) -- This *can* legitimately happen: -- e.g. coerce Int (\x. x) Essentially the programmer is -- playing fast and loose with types (Happy does this a lot). @@ -1593,17 +1661,27 @@ ; return (arg':args', m_co2) } MRefl -> return (arg':args, MRefl) } +pushMCoArg :: MCoercionR -> CoreArg -> Maybe (CoreArg, MCoercion) +pushMCoArg MRefl arg = Just (arg, MRefl) +pushMCoArg (MCo co) arg = pushCoArg co arg + pushCoArg :: CoercionR -> CoreArg -> Maybe (CoreArg, MCoercion) -- We have (fun |> co) arg, and we want to transform it to -- (fun arg) |> co -- This may fail, e.g. if (fun :: N) where N is a newtype -- C.f. simplCast in GHC.Core.Opt.Simplify -- 'co' is always Representational --- If the returned coercion is Nothing, then it would have been reflexive -pushCoArg co (Type ty) = do { (ty', m_co') <- pushCoTyArg co ty - ; return (Type ty', m_co') } -pushCoArg co val_arg = do { (arg_co, m_co') <- pushCoValArg co - ; return (val_arg `mkCastMCo` arg_co, m_co') } +pushCoArg co arg + | Type ty <- arg + = do { (ty', m_co') <- pushCoTyArg co ty + ; return (Type ty', m_co') } + | otherwise + = do { (arg_mco, m_co') <- pushCoValArg co + ; let arg_mco' = checkReflexiveMCo arg_mco + -- checkReflexiveMCo: see Note [Check for reflexive casts in eta expansion] + -- The coercion is very often (arg_co -> res_co), but without + -- the argument coercion actually being ReflCo + ; return (arg `mkCastMCo` arg_mco', m_co') } pushCoTyArg :: CoercionR -> Type -> Maybe (Type, MCoercionR) -- We have (fun |> co) @ty diff --git a/compiler/GHC/Core/Opt/ConstantFold.hs b/compiler/GHC/Core/Opt/ConstantFold.hs --- a/compiler/GHC/Core/Opt/ConstantFold.hs +++ b/compiler/GHC/Core/Opt/ConstantFold.hs @@ -10,6 +10,7 @@ (i1 + i2) only if it results in a valid Float. -} +{-# LANGUAGE CPP #-} {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE LambdaCase #-} @@ -30,6 +31,8 @@ ) where +#include "MachDeps.h" + import GHC.Prelude import GHC.Platform @@ -156,10 +159,14 @@ , equalArgs $> Lit zeroW8 ] Word8AndOp -> mkPrimOpRule nm 2 [ binaryLit (word8Op2 (.&.)) , idempotent - , zeroElem ] + , zeroElem + , sameArgIdempotentCommut Word8AndOp + ] Word8OrOp -> mkPrimOpRule nm 2 [ binaryLit (word8Op2 (.|.)) , idempotent - , identity zeroW8 ] + , identity zeroW8 + , sameArgIdempotentCommut Word8OrOp + ] Word8XorOp -> mkPrimOpRule nm 2 [ binaryLit (word8Op2 xor) , identity zeroW8 , equalArgs $> Lit zeroW8 ] @@ -223,10 +230,14 @@ , equalArgs $> Lit zeroW16 ] Word16AndOp -> mkPrimOpRule nm 2 [ binaryLit (word16Op2 (.&.)) , idempotent - , zeroElem ] + , zeroElem + , sameArgIdempotentCommut Word16AndOp + ] Word16OrOp -> mkPrimOpRule nm 2 [ binaryLit (word16Op2 (.|.)) , idempotent - , identity zeroW16 ] + , identity zeroW16 + , sameArgIdempotentCommut Word16OrOp + ] Word16XorOp -> mkPrimOpRule nm 2 [ binaryLit (word16Op2 xor) , identity zeroW16 , equalArgs $> Lit zeroW16 ] @@ -290,10 +301,14 @@ , equalArgs $> Lit zeroW32 ] Word32AndOp -> mkPrimOpRule nm 2 [ binaryLit (word32Op2 (.&.)) , idempotent - , zeroElem ] + , zeroElem + , sameArgIdempotentCommut Word32AndOp + ] Word32OrOp -> mkPrimOpRule nm 2 [ binaryLit (word32Op2 (.|.)) , idempotent - , identity zeroW32 ] + , identity zeroW32 + , sameArgIdempotentCommut Word32OrOp + ] Word32XorOp -> mkPrimOpRule nm 2 [ binaryLit (word32Op2 xor) , identity zeroW32 , equalArgs $> Lit zeroW32 ] @@ -302,7 +317,78 @@ Word32SllOp -> mkPrimOpRule nm 2 [ shiftRule LitNumWord32 (const shiftL) ] Word32SrlOp -> mkPrimOpRule nm 2 [ shiftRule LitNumWord32 $ const $ shiftRightLogical @Word32 ] +#if WORD_SIZE_IN_BITS < 64 + -- Int64 operations + Int64AddOp -> mkPrimOpRule nm 2 [ binaryLit (int64Op2 (+)) + , identity zeroI64 + , addFoldingRules Int64AddOp int64Ops + ] + Int64SubOp -> mkPrimOpRule nm 2 [ binaryLit (int64Op2 (-)) + , rightIdentity zeroI64 + , equalArgs $> Lit zeroI64 + , subFoldingRules Int64SubOp int64Ops + ] + Int64MulOp -> mkPrimOpRule nm 2 [ binaryLit (int64Op2 (*)) + , zeroElem + , identity oneI64 + , mulFoldingRules Int64MulOp int64Ops + ] + Int64QuotOp -> mkPrimOpRule nm 2 [ nonZeroLit 1 >> binaryLit (int64Op2 quot) + , leftZero + , rightIdentity oneI64 + , equalArgs $> Lit oneI64 ] + Int64RemOp -> mkPrimOpRule nm 2 [ nonZeroLit 1 >> binaryLit (int64Op2 rem) + , leftZero + , oneLit 1 $> Lit zeroI64 + , equalArgs $> Lit zeroI64 ] + Int64NegOp -> mkPrimOpRule nm 1 [ unaryLit negOp + , semiInversePrimOp Int64NegOp ] + Int64SllOp -> mkPrimOpRule nm 2 [ shiftRule LitNumInt64 (const shiftL) + , rightIdentity zeroI64 ] + Int64SraOp -> mkPrimOpRule nm 2 [ shiftRule LitNumInt64 (const shiftR) + , rightIdentity zeroI64 ] + Int64SrlOp -> mkPrimOpRule nm 2 [ shiftRule LitNumInt64 $ const $ shiftRightLogical @Word64 + , rightIdentity zeroI64 ] + -- Word64 operations + Word64AddOp -> mkPrimOpRule nm 2 [ binaryLit (word64Op2 (+)) + , identity zeroW64 + , addFoldingRules Word64AddOp word64Ops + ] + Word64SubOp -> mkPrimOpRule nm 2 [ binaryLit (word64Op2 (-)) + , rightIdentity zeroW64 + , equalArgs $> Lit zeroW64 + , subFoldingRules Word64SubOp word64Ops + ] + Word64MulOp -> mkPrimOpRule nm 2 [ binaryLit (word64Op2 (*)) + , identity oneW64 + , mulFoldingRules Word64MulOp word64Ops + ] + Word64QuotOp-> mkPrimOpRule nm 2 [ nonZeroLit 1 >> binaryLit (word64Op2 quot) + , rightIdentity oneW64 ] + Word64RemOp -> mkPrimOpRule nm 2 [ nonZeroLit 1 >> binaryLit (word64Op2 rem) + , leftZero + , oneLit 1 $> Lit zeroW64 + , equalArgs $> Lit zeroW64 ] + Word64AndOp -> mkPrimOpRule nm 2 [ binaryLit (word64Op2 (.&.)) + , idempotent + , zeroElem + , sameArgIdempotentCommut Word64AndOp + ] + Word64OrOp -> mkPrimOpRule nm 2 [ binaryLit (word64Op2 (.|.)) + , idempotent + , identity zeroW64 + , sameArgIdempotentCommut Word64OrOp + ] + Word64XorOp -> mkPrimOpRule nm 2 [ binaryLit (word64Op2 xor) + , identity zeroW64 + , equalArgs $> Lit zeroW64 ] + Word64NotOp -> mkPrimOpRule nm 1 [ unaryLit complementOp + , semiInversePrimOp Word64NotOp ] + Word64SllOp -> mkPrimOpRule nm 2 [ shiftRule LitNumWord64 (const shiftL) ] + Word64SrlOp -> mkPrimOpRule nm 2 [ shiftRule LitNumWord64 $ const $ shiftRightLogical @Word64 ] +#endif + -- Int operations IntAddOp -> mkPrimOpRule nm 2 [ binaryLit (intOp2 (+)) , identityPlatform zeroi @@ -333,10 +419,14 @@ , equalArgs >> retLit zeroi ] IntAndOp -> mkPrimOpRule nm 2 [ binaryLit (intOp2 (.&.)) , idempotent - , zeroElem ] + , zeroElem + , sameArgIdempotentCommut IntAndOp + ] IntOrOp -> mkPrimOpRule nm 2 [ binaryLit (intOp2 (.|.)) , idempotent - , identityPlatform zeroi ] + , identityPlatform zeroi + , sameArgIdempotentCommut IntOrOp + ] IntXorOp -> mkPrimOpRule nm 2 [ binaryLit (intOp2 xor) , identityPlatform zeroi , equalArgs >> retLit zeroi ] @@ -378,10 +468,14 @@ , equalArgs >> retLit zerow ] WordAndOp -> mkPrimOpRule nm 2 [ binaryLit (wordOp2 (.&.)) , idempotent - , zeroElem ] + , zeroElem + , sameArgIdempotentCommut WordAndOp + ] WordOrOp -> mkPrimOpRule nm 2 [ binaryLit (wordOp2 (.|.)) , idempotent - , identityPlatform zerow ] + , identityPlatform zerow + , sameArgIdempotentCommut WordOrOp + ] WordXorOp -> mkPrimOpRule nm 2 [ binaryLit (wordOp2 xor) , identityPlatform zerow , equalArgs >> retLit zerow ] @@ -395,6 +489,9 @@ Int8ToIntOp -> mkPrimOpRule nm 1 [ liftLitPlatform extendIntLit ] Int16ToIntOp -> mkPrimOpRule nm 1 [ liftLitPlatform extendIntLit ] Int32ToIntOp -> mkPrimOpRule nm 1 [ liftLitPlatform extendIntLit ] +#if WORD_SIZE_IN_BITS < 64 + Int64ToIntOp -> mkPrimOpRule nm 1 [ liftLitPlatform extendIntLit ] +#endif IntToInt8Op -> mkPrimOpRule nm 1 [ liftLit narrowInt8Lit , semiInversePrimOp Int8ToIntOp , narrowSubsumesAnd IntAndOp IntToInt8Op 8 ] @@ -404,6 +501,9 @@ IntToInt32Op -> mkPrimOpRule nm 1 [ liftLit narrowInt32Lit , semiInversePrimOp Int32ToIntOp , narrowSubsumesAnd IntAndOp IntToInt32Op 32 ] +#if WORD_SIZE_IN_BITS < 64 + IntToInt64Op -> mkPrimOpRule nm 1 [ liftLit narrowInt64Lit ] +#endif Word8ToWordOp -> mkPrimOpRule nm 1 [ liftLitPlatform extendWordLit , extendNarrowPassthrough WordToWord8Op 0xFF @@ -414,6 +514,10 @@ Word32ToWordOp -> mkPrimOpRule nm 1 [ liftLitPlatform extendWordLit , extendNarrowPassthrough WordToWord32Op 0xFFFFFFFF ] +#if WORD_SIZE_IN_BITS < 64 + Word64ToWordOp -> mkPrimOpRule nm 1 [ liftLitPlatform extendWordLit ] +#endif + WordToWord8Op -> mkPrimOpRule nm 1 [ liftLit narrowWord8Lit , semiInversePrimOp Word8ToWordOp , narrowSubsumesAnd WordAndOp WordToWord8Op 8 ] @@ -423,7 +527,9 @@ WordToWord32Op -> mkPrimOpRule nm 1 [ liftLit narrowWord32Lit , semiInversePrimOp Word32ToWordOp , narrowSubsumesAnd WordAndOp WordToWord32Op 32 ] - +#if WORD_SIZE_IN_BITS < 64 + WordToWord64Op -> mkPrimOpRule nm 1 [ liftLit narrowWord64Lit ] +#endif Word8ToInt8Op -> mkPrimOpRule nm 1 [ liftLitPlatform (litNumCoerce LitNumInt8) , semiInversePrimOp Int8ToWord8Op ] @@ -437,6 +543,13 @@ , semiInversePrimOp Int32ToWord32Op ] Int32ToWord32Op-> mkPrimOpRule nm 1 [ liftLitPlatform (litNumCoerce LitNumWord32) , semiInversePrimOp Word32ToInt32Op ] +#if WORD_SIZE_IN_BITS < 64 + Word64ToInt64Op-> mkPrimOpRule nm 1 [ liftLitPlatform (litNumCoerce LitNumInt64) + , semiInversePrimOp Int64ToWord64Op ] + Int64ToWord64Op-> mkPrimOpRule nm 1 [ liftLitPlatform (litNumCoerce LitNumWord64) + , semiInversePrimOp Word64ToInt64Op ] +#endif + WordToIntOp -> mkPrimOpRule nm 1 [ liftLitPlatform (litNumCoerce LitNumInt) , semiInversePrimOp IntToWordOp ] IntToWordOp -> mkPrimOpRule nm 1 [ liftLitPlatform (litNumCoerce LitNumWord) @@ -704,6 +817,14 @@ zeroW32 = mkLitWord32 0 oneW32 = mkLitWord32 1 +#if WORD_SIZE_IN_BITS < 64 +zeroI64, oneI64, zeroW64, oneW64 :: Literal +zeroI64 = mkLitInt64 0 +oneI64 = mkLitInt64 1 +zeroW64 = mkLitWord64 0 +oneW64 = mkLitWord64 1 +#endif + zerof, onef, twof, zerod, oned, twod :: Literal zerof = mkLitFloat 0.0 onef = mkLitFloat 1.0 @@ -769,6 +890,16 @@ int32Result (fromInteger i1 `op` fromInteger i2) int32Op2 _ _ _ _ = Nothing +#if WORD_SIZE_IN_BITS < 64 +int64Op2 + :: (Integral a, Integral b) + => (a -> b -> Integer) + -> RuleOpts -> Literal -> Literal -> Maybe CoreExpr +int64Op2 op _ (LitNumber LitNumInt64 i1) (LitNumber LitNumInt64 i2) = + int64Result (fromInteger i1 `op` fromInteger i2) +int64Op2 _ _ _ _ = Nothing +#endif + intOp2 :: (Integral a, Integral b) => (a -> b -> Integer) -> RuleOpts -> Literal -> Literal -> Maybe CoreExpr @@ -819,7 +950,7 @@ -> RuleOpts -> Literal -> Literal -> Maybe CoreExpr word8Op2 op _ (LitNumber LitNumWord8 i1) (LitNumber LitNumWord8 i2) = word8Result (fromInteger i1 `op` fromInteger i2) -word8Op2 _ _ _ _ = Nothing -- Could find LitLit +word8Op2 _ _ _ _ = Nothing word16Op2 :: (Integral a, Integral b) @@ -827,7 +958,7 @@ -> RuleOpts -> Literal -> Literal -> Maybe CoreExpr word16Op2 op _ (LitNumber LitNumWord16 i1) (LitNumber LitNumWord16 i2) = word16Result (fromInteger i1 `op` fromInteger i2) -word16Op2 _ _ _ _ = Nothing -- Could find LitLit +word16Op2 _ _ _ _ = Nothing word32Op2 :: (Integral a, Integral b) @@ -835,8 +966,18 @@ -> RuleOpts -> Literal -> Literal -> Maybe CoreExpr word32Op2 op _ (LitNumber LitNumWord32 i1) (LitNumber LitNumWord32 i2) = word32Result (fromInteger i1 `op` fromInteger i2) -word32Op2 _ _ _ _ = Nothing -- Could find LitLit +word32Op2 _ _ _ _ = Nothing +#if WORD_SIZE_IN_BITS < 64 +word64Op2 + :: (Integral a, Integral b) + => (a -> b -> Integer) + -> RuleOpts -> Literal -> Literal -> Maybe CoreExpr +word64Op2 op _ (LitNumber LitNumWord64 i1) (LitNumber LitNumWord64 i2) = + word64Result (fromInteger i1 `op` fromInteger i2) +word64Op2 _ _ _ _ = Nothing +#endif + wordOp2 :: (Integral a, Integral b) => (a -> b -> Integer) -> RuleOpts -> Literal -> Literal -> Maybe CoreExpr @@ -851,35 +992,42 @@ wordCResult (roPlatform env) (fromInteger w1 `op` fromInteger w2) wordOpC2 _ _ _ _ = Nothing -shiftRule :: LitNumType -- Type of the result, either LitNumInt or LitNumWord +shiftRule :: LitNumType -> (Platform -> Integer -> Int -> Integer) -> RuleM CoreExpr -- Shifts take an Int; hence third arg of op is Int -- Used for shift primops -- IntSllOp, IntSraOp, IntSrlOp :: Int# -> Int# -> Int# -- SllOp, SrlOp :: Word# -> Int# -> Word# -shiftRule lit_num_ty shift_op - = do { platform <- getPlatform - ; [e1, Lit (LitNumber LitNumInt shift_len)] <- getArgs - ; case e1 of - _ | shift_len == 0 - -> return e1 - -- See Note [Guarding against silly shifts] - | shift_len < 0 || shift_len > toInteger (platformWordSizeInBits platform) - -> return $ Lit $ mkLitNumberWrap platform lit_num_ty 0 - -- Be sure to use lit_num_ty here, so we get a correctly typed zero - -- of type Int# or Word# resp. See #18589 +shiftRule lit_num_ty shift_op = do + platform <- getPlatform + [e1, Lit (LitNumber LitNumInt shift_len)] <- getArgs - -- Do the shift at type Integer, but shift length is Int - Lit (LitNumber nt x) - | 0 < shift_len - , shift_len <= toInteger (platformWordSizeInBits platform) - -> let op = shift_op platform - y = x `op` fromInteger shift_len - in liftMaybe $ Just (Lit (mkLitNumberWrap platform nt y)) + bit_size <- case litNumBitSize platform lit_num_ty of + Nothing -> mzero + Just bs -> pure (toInteger bs) - _ -> mzero } + case e1 of + _ | shift_len == 0 -> pure e1 + -- See Note [Guarding against silly shifts] + _ | shift_len < 0 || shift_len > bit_size + -> pure $ Lit $ mkLitNumberWrap platform lit_num_ty 0 + -- Be sure to use lit_num_ty here, so we get a correctly typed zero. + -- See #18589 + + Lit (LitNumber nt x) + | 0 < shift_len && shift_len <= bit_size + -> assert (nt == lit_num_ty) $ + let op = shift_op platform + -- Do the shift at type Integer, but shift length is Int. + -- Using host's Int is ok even if target's Int has a different size + -- because we test that shift_len <= bit_size (which is at most 64) + y = x `op` fromInteger shift_len + in pure $ Lit $ mkLitNumberWrap platform nt y + + _ -> mzero + -------------------------- floatOp2 :: (Rational -> Rational -> Rational) -> RuleOpts -> Literal -> Literal @@ -1070,6 +1218,21 @@ (lit, b) = mkLitWordWrapC platform result c = if b then onei platform else zeroi platform +#if WORD_SIZE_IN_BITS < 64 +int64Result :: Integer -> Maybe CoreExpr +int64Result result = Just (int64Result' result) + +int64Result' :: Integer -> CoreExpr +int64Result' result = Lit (mkLitInt64Wrap result) + +word64Result :: Integer -> Maybe CoreExpr +word64Result result = Just (word64Result' result) + +word64Result' :: Integer -> CoreExpr +word64Result' result = Lit (mkLitWord64Wrap result) +#endif + + -- | 'ambiant (primop x) = x', but not nececesarily 'primop (ambient x) = x'. semiInversePrimOp :: PrimOp -> RuleM CoreExpr semiInversePrimOp primop = do @@ -1121,6 +1284,27 @@ guard $ cheapEqExpr e1 e2 return e1 +-- | Match +-- (op (op v e) e) +-- or (op e (op v e)) +-- or (op (op e v) e) +-- or (op e (op e v)) +-- and return the innermost (op v e) or (op e v). +sameArgIdempotentCommut :: PrimOp -> RuleM CoreExpr +sameArgIdempotentCommut op = do + let is_op = \case + BinOpApp v op' e | op == op' -> Just (v,e) + _ -> Nothing + [a,b] <- getArgs + case (a,b) of + (is_op -> Just (e1,e2), e3) + | cheapEqExpr e2 e3 -> return a + | cheapEqExpr e1 e3 -> return a + (e3, is_op -> Just (e1,e2)) + | cheapEqExpr e2 e3 -> return b + | cheapEqExpr e1 e3 -> return b + _ -> mzero + {- Note [Guarding against silly shifts] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1878,7 +2062,9 @@ , id_passthrough "Word# -> Natural -> Word# (clamp)" naturalToWordClampName naturalNSName - -- identity passthrough with a conversion that can be done directly instead + -- passthrough bignum small constructors with a conversion that can be done + -- directly instead + , small_passthrough "Int# -> Integer -> Word#" integerISName integerToWordName (mkPrimOpId IntToWordOp) , small_passthrough "Int# -> Integer -> Float#" @@ -1895,6 +2081,27 @@ , small_passthrough "Word# -> Natural -> Double#" naturalNSName naturalToDoubleName (mkPrimOpId WordToDoubleOp) +#if WORD_SIZE_IN_BITS < 64 + , id_passthrough "Int64# -> Integer -> Int64#" + integerToInt64Name integerFromInt64Name + , id_passthrough "Word64# -> Integer -> Word64#" + integerToWord64Name integerFromWord64Name + + , small_passthrough "Int64# -> Integer -> Word64#" + integerFromInt64Name integerToWord64Name (mkPrimOpId Int64ToWord64Op) + , small_passthrough "Word64# -> Integer -> Int64#" + integerFromWord64Name integerToInt64Name (mkPrimOpId Word64ToInt64Op) + + , small_passthrough "Word# -> Integer -> Word64#" + integerFromWordName integerToWord64Name (mkPrimOpId WordToWord64Op) + , small_passthrough "Word64# -> Integer -> Word#" + integerFromWord64Name integerToWordName (mkPrimOpId Word64ToWordOp) + , small_passthrough "Int# -> Integer -> Int64#" + integerISName integerToInt64Name (mkPrimOpId IntToInt64Op) + , small_passthrough "Int64# -> Integer -> Int#" + integerFromInt64Name integerToIntName (mkPrimOpId Int64ToIntOp) +#endif + -- Bits.bit , bignum_bit "integerBit" integerBitName mkLitInteger , bignum_bit "naturalBit" naturalBitName mkLitNatural @@ -2744,6 +2951,24 @@ , numMul = Word32MulOp , numLitType = LitNumWord32 } + +#if WORD_SIZE_IN_BITS < 64 +int64Ops :: NumOps +int64Ops = NumOps + { numAdd = Int64AddOp + , numSub = Int64SubOp + , numMul = Int64MulOp + , numLitType = LitNumInt64 + } + +word64Ops :: NumOps +word64Ops = NumOps + { numAdd = Word64AddOp + , numSub = Word64SubOp + , numMul = Word64MulOp + , numLitType = LitNumWord64 + } +#endif intOps :: NumOps intOps = NumOps diff --git a/compiler/GHC/Core/Opt/OccurAnal.hs b/compiler/GHC/Core/Opt/OccurAnal.hs --- a/compiler/GHC/Core/Opt/OccurAnal.hs +++ b/compiler/GHC/Core/Opt/OccurAnal.hs @@ -66,10 +66,11 @@ Here's the externally-callable interface: -} +-- | Do occurrence analysis, and discard occurrence info returned occurAnalyseExpr :: CoreExpr -> CoreExpr --- Do occurrence analysis, and discard occurrence info returned -occurAnalyseExpr expr - = snd (occAnal initOccEnv expr) +occurAnalyseExpr expr = expr' + where + (WithUsageDetails _ expr') = occAnal initOccEnv expr occurAnalysePgm :: Module -- Used only in debug output -> (Id -> Bool) -- Active unfoldings @@ -88,8 +89,8 @@ init_env = initOccEnv { occ_rule_act = active_rule , occ_unf_act = active_unf } - (final_usage, occ_anald_binds) = go init_env binds - (_, occ_anald_glommed_binds) = occAnalRecBind init_env TopLevel + (WithUsageDetails final_usage occ_anald_binds) = go init_env binds + (WithUsageDetails _ occ_anald_glommed_binds) = occAnalRecBind init_env TopLevel imp_rule_edges (flattenBinds binds) initial_uds @@ -121,15 +122,14 @@ -- Not BuiltinRules; see Note [Plugin rules] , let rhs_fvs = exprFreeIds rhs `delVarSetList` bndrs ] - go :: OccEnv -> [CoreBind] -> (UsageDetails, [CoreBind]) - go _ [] - = (initial_uds, []) + go :: OccEnv -> [CoreBind] -> WithUsageDetails [CoreBind] + go !_ [] + = WithUsageDetails initial_uds [] go env (bind:binds) - = (final_usage, bind' ++ binds') + = WithUsageDetails final_usage (bind' ++ binds') where - (bs_usage, binds') = go env binds - (final_usage, bind') = occAnalBind env TopLevel imp_rule_edges bind - bs_usage + (WithUsageDetails bs_usage binds') = go env binds + (WithUsageDetails final_usage bind') = occAnalBind env TopLevel imp_rule_edges bind bs_usage {- ********************************************************************* * * @@ -707,6 +707,9 @@ 'occAnalRec'.) -} + +data WithUsageDetails a = WithUsageDetails !UsageDetails !a + ------------------------------------------------------------------ -- occAnalBind ------------------------------------------------------------------ @@ -716,26 +719,25 @@ -> ImpRuleEdges -> CoreBind -> UsageDetails -- Usage details of scope - -> (UsageDetails, -- Of the whole let(rec) - [CoreBind]) + -> WithUsageDetails [CoreBind] -- Of the whole let(rec) -occAnalBind env lvl top_env (NonRec binder rhs) body_usage +occAnalBind !env lvl top_env (NonRec binder rhs) body_usage = occAnalNonRecBind env lvl top_env binder rhs body_usage occAnalBind env lvl top_env (Rec pairs) body_usage = occAnalRecBind env lvl top_env pairs body_usage ----------------- occAnalNonRecBind :: OccEnv -> TopLevelFlag -> ImpRuleEdges -> Var -> CoreExpr - -> UsageDetails -> (UsageDetails, [CoreBind]) -occAnalNonRecBind env lvl imp_rule_edges bndr rhs body_usage + -> UsageDetails -> WithUsageDetails [CoreBind] +occAnalNonRecBind !env lvl imp_rule_edges bndr rhs body_usage | isTyVar bndr -- A type let; we don't gather usage info - = (body_usage, [NonRec bndr rhs]) + = WithUsageDetails body_usage [NonRec bndr rhs] | not (bndr `usedIn` body_usage) -- It's not mentioned - = (body_usage, []) + = WithUsageDetails body_usage [] | otherwise -- It's mentioned in the body - = (body_usage' `andUDs` rhs_usage, [NonRec final_bndr rhs']) + = WithUsageDetails (body_usage' `andUDs` rhs_usage) [NonRec final_bndr rhs'] where (body_usage', tagged_bndr) = tagNonRecBinder lvl body_usage bndr final_bndr = tagged_bndr `setIdUnfolding` unf' @@ -754,12 +756,13 @@ -- See Note [Sources of one-shot information] rhs_env = env1 { occ_one_shots = argOneShots dmd } - (rhs_uds, rhs') = occAnalRhs rhs_env NonRecursive mb_join_arity rhs + (WithUsageDetails rhs_uds rhs') = occAnalRhs rhs_env NonRecursive mb_join_arity rhs --------- Unfolding --------- -- See Note [Unfoldings and join points] - unf = idUnfolding bndr - (unf_uds, unf') = occAnalUnfolding rhs_env NonRecursive mb_join_arity unf + unf | isId bndr = idUnfolding bndr + | otherwise = NoUnfolding + (WithUsageDetails unf_uds unf') = occAnalUnfolding rhs_env NonRecursive mb_join_arity unf --------- Rules --------- -- See Note [Rules are extra RHSs] and Note [Rule dependency info] @@ -791,14 +794,14 @@ ----------------- occAnalRecBind :: OccEnv -> TopLevelFlag -> ImpRuleEdges -> [(Var,CoreExpr)] - -> UsageDetails -> (UsageDetails, [CoreBind]) + -> UsageDetails -> WithUsageDetails [CoreBind] -- For a recursive group, we -- * occ-analyse all the RHSs -- * compute strongly-connected components -- * feed those components to occAnalRec -- See Note [Recursive bindings: the grand plan] -occAnalRecBind env lvl imp_rule_edges pairs body_usage - = foldr (occAnalRec rhs_env lvl) (body_usage, []) sccs +occAnalRecBind !env lvl imp_rule_edges pairs body_usage + = foldr (occAnalRec rhs_env lvl) (WithUsageDetails body_usage []) sccs where sccs :: [SCC Details] sccs = {-# SCC "occAnalBind.scc" #-} @@ -816,19 +819,19 @@ ----------------------------- occAnalRec :: OccEnv -> TopLevelFlag -> SCC Details - -> (UsageDetails, [CoreBind]) - -> (UsageDetails, [CoreBind]) + -> WithUsageDetails [CoreBind] + -> WithUsageDetails [CoreBind] -- The NonRec case is just like a Let (NonRec ...) above -occAnalRec _ lvl (AcyclicSCC (ND { nd_bndr = bndr, nd_rhs = rhs +occAnalRec !_ lvl (AcyclicSCC (ND { nd_bndr = bndr, nd_rhs = rhs , nd_uds = rhs_uds, nd_rhs_bndrs = rhs_bndrs })) - (body_uds, binds) + (WithUsageDetails body_uds binds) | not (bndr `usedIn` body_uds) - = (body_uds, binds) -- See Note [Dead code] + = WithUsageDetails body_uds binds -- See Note [Dead code] | otherwise -- It's mentioned in the body - = (body_uds' `andUDs` rhs_uds', - NonRec tagged_bndr rhs : binds) + = WithUsageDetails (body_uds' `andUDs` rhs_uds') + (NonRec tagged_bndr rhs : binds) where (body_uds', tagged_bndr) = tagNonRecBinder lvl body_uds bndr rhs_uds' = adjustRhsUsage NonRecursive (willBeJoinId_maybe tagged_bndr) @@ -837,13 +840,13 @@ -- The Rec case is the interesting one -- See Note [Recursive bindings: the grand plan] -- See Note [Loop breaking] -occAnalRec env lvl (CyclicSCC details_s) (body_uds, binds) +occAnalRec env lvl (CyclicSCC details_s) (WithUsageDetails body_uds binds) | not (any (`usedIn` body_uds) bndrs) -- NB: look at body_uds, not total_uds - = (body_uds, binds) -- See Note [Dead code] + = WithUsageDetails body_uds binds -- See Note [Dead code] | otherwise -- At this point we always build a single Rec = -- pprTrace "occAnalRec" (ppr loop_breaker_nodes) - (final_uds, Rec pairs : binds) + WithUsageDetails final_uds (Rec pairs : binds) where bndrs = map nd_bndr details_s @@ -854,7 +857,7 @@ -- See Note [Choosing loop breakers] for loop_breaker_nodes final_uds :: UsageDetails loop_breaker_nodes :: [LetrecNode] - (final_uds, loop_breaker_nodes) = mkLoopBreakerNodes env lvl body_uds details_s + (WithUsageDetails final_uds loop_breaker_nodes) = mkLoopBreakerNodes env lvl body_uds details_s ------------------------------ active_rule_fvs :: VarSet @@ -1354,7 +1357,7 @@ makeNode :: OccEnv -> ImpRuleEdges -> VarSet -> (Var, CoreExpr) -> LetrecNode -- See Note [Recursive bindings: the grand plan] -makeNode env imp_rule_edges bndr_set (bndr, rhs) +makeNode !env imp_rule_edges bndr_set (bndr, rhs) = DigraphNode { node_payload = details , node_key = varUnique bndr , node_dependencies = nonDetKeysUniqSet scope_fvs } @@ -1402,14 +1405,14 @@ -- the final answer for mb_join_arity (bndrs, body) = collectBinders rhs rhs_env = rhsCtxt env - (rhs_uds, bndrs', body') = occAnalLamOrRhs rhs_env bndrs body + (WithUsageDetails rhs_uds (bndrs', body')) = occAnalLamOrRhs rhs_env bndrs body rhs' = mkLams bndrs' body' --------- Unfolding --------- -- See Note [Unfoldings and join points] unf = realIdUnfolding bndr -- realIdUnfolding: Ignore loop-breaker-ness -- here because that is what we are setting! - (unf_uds, unf') = occAnalUnfolding rhs_env Recursive mb_join_arity unf + (WithUsageDetails unf_uds unf') = occAnalUnfolding rhs_env Recursive mb_join_arity unf --------- IMP-RULES -------- is_active = occ_rule_act env :: Activation -> Bool @@ -1436,8 +1439,7 @@ mkLoopBreakerNodes :: OccEnv -> TopLevelFlag -> UsageDetails -- for BODY of let -> [Details] - -> (UsageDetails, -- adjusted - [LetrecNode]) + -> WithUsageDetails [LetrecNode] -- adjusted -- See Note [Choosing loop breakers] -- This function primarily creates the Nodes for the -- loop-breaker SCC analysis. More specifically: @@ -1447,8 +1449,8 @@ -- the loop-breaker SCC analysis -- d) adjust each RHS's usage details according to -- the binder's (new) shotness and join-point-hood -mkLoopBreakerNodes env lvl body_uds details_s - = (final_uds, zipWithEqual "mkLoopBreakerNodes" mk_lb_node details_s bndrs') +mkLoopBreakerNodes !env lvl body_uds details_s + = WithUsageDetails final_uds (zipWithEqual "mkLoopBreakerNodes" mk_lb_node details_s bndrs') where (final_uds, bndrs') = tagRecBinders lvl body_uds @@ -1503,7 +1505,7 @@ -> VarSet -- Loop-breaker dependencies -> Details -> NodeScore -nodeScore env new_bndr lb_deps +nodeScore !env new_bndr lb_deps (ND { nd_bndr = old_bndr, nd_rhs = bind_rhs }) | not (isId old_bndr) -- A type or coercion variable is never a loop breaker @@ -1709,54 +1711,55 @@ occAnalRhs :: OccEnv -> RecFlag -> Maybe JoinArity -> CoreExpr -- RHS - -> (UsageDetails, CoreExpr) -occAnalRhs env is_rec mb_join_arity rhs - = case occAnalLamOrRhs env bndrs body of { (body_usage, bndrs', body') -> - let final_bndrs | isRec is_rec = bndrs' - | otherwise = markJoinOneShots mb_join_arity bndrs' - -- For a /non-recursive/ join point we can mark all - -- its join-lambda as one-shot; and it's a good idea to do so - - -- Final adjustment - rhs_usage = adjustRhsUsage is_rec mb_join_arity final_bndrs body_usage + -> WithUsageDetails CoreExpr +occAnalRhs !env is_rec mb_join_arity rhs + = let + (bndrs, body) = collectBinders rhs + (WithUsageDetails body_usage (bndrs',body')) = occAnalLamOrRhs env bndrs body + final_bndrs | isRec is_rec = bndrs' + | otherwise = markJoinOneShots mb_join_arity bndrs' + -- For a /non-recursive/ join point we can mark all + -- its join-lambda as one-shot; and it's a good idea to do so - in (rhs_usage, mkLams final_bndrs body') } - where - (bndrs, body) = collectBinders rhs + -- Final adjustment + rhs_usage = adjustRhsUsage is_rec mb_join_arity final_bndrs body_usage + in WithUsageDetails rhs_usage (mkLams final_bndrs body') occAnalUnfolding :: OccEnv -> RecFlag -> Maybe JoinArity -- See Note [Join points and unfoldings/rules] -> Unfolding - -> (UsageDetails, Unfolding) + -> WithUsageDetails Unfolding -- Occurrence-analyse a stable unfolding; -- discard a non-stable one altogether. -occAnalUnfolding env is_rec mb_join_arity unf +occAnalUnfolding !env is_rec mb_join_arity unf = case unf of unf@(CoreUnfolding { uf_tmpl = rhs, uf_src = src }) - | isStableSource src -> (markAllMany usage, unf') + | isStableSource src -> + let + (WithUsageDetails usage rhs') = occAnalRhs env is_rec mb_join_arity rhs + + unf' | noBinderSwaps env = unf -- Note [Unfoldings and rules] + | otherwise = unf { uf_tmpl = rhs' } + in WithUsageDetails (markAllMany usage) unf' -- markAllMany: see Note [Occurrences in stable unfoldings] - | otherwise -> (emptyDetails, unf) + | otherwise -> WithUsageDetails emptyDetails unf -- For non-Stable unfoldings we leave them undisturbed, but -- don't count their usage because the simplifier will discard them. -- We leave them undisturbed because nodeScore uses their size info -- to guide its decisions. It's ok to leave un-substituted -- expressions in the tree because all the variables that were in -- scope remain in scope; there is no cloning etc. - where - (usage, rhs') = occAnalRhs env is_rec mb_join_arity rhs - unf' | noBinderSwaps env = unf -- Note [Unfoldings and rules] - | otherwise = unf { uf_tmpl = rhs' } - unf@(DFunUnfolding { df_bndrs = bndrs, df_args = args }) - -> ( final_usage, unf { df_args = args' } ) + -> WithUsageDetails final_usage (unf { df_args = args' }) where env' = env `addInScope` bndrs - (usage, args') = occAnalList env' args + (WithUsageDetails usage args') = occAnalList env' args final_usage = markAllManyNonTail (delDetailsList usage bndrs) + `addLamCoVarOccs` bndrs - unf -> (emptyDetails, unf) + unf -> WithUsageDetails emptyDetails unf occAnalRules :: OccEnv -> Maybe JoinArity -- See Note [Join points and unfoldings/rules] @@ -1764,7 +1767,7 @@ -> [(CoreRule, -- Each (non-built-in) rule UsageDetails, -- Usage details for LHS UsageDetails)] -- Usage details for RHS -occAnalRules env mb_join_arity bndr +occAnalRules !env mb_join_arity bndr = map occ_anal_rule (idCoreRules bndr) where occ_anal_rule rule@(Rule { ru_bndrs = bndrs, ru_args = args, ru_rhs = rhs }) @@ -1774,11 +1777,11 @@ rule' | noBinderSwaps env = rule -- Note [Unfoldings and rules] | otherwise = rule { ru_args = args', ru_rhs = rhs' } - (lhs_uds, args') = occAnalList env' args - lhs_uds' = markAllManyNonTail $ - lhs_uds `delDetailsList` bndrs + (WithUsageDetails lhs_uds args') = occAnalList env' args + lhs_uds' = markAllManyNonTail (lhs_uds `delDetailsList` bndrs) + `addLamCoVarOccs` bndrs - (rhs_uds, rhs') = occAnal env' rhs + (WithUsageDetails rhs_uds rhs') = occAnal env' rhs -- Note [Rules are extra RHSs] -- Note [Rule dependency info] rhs_uds' = markAllNonTailIf (not exact_join) $ @@ -1889,20 +1892,20 @@ ************************************************************************ -} -occAnalList :: OccEnv -> [CoreExpr] -> (UsageDetails, [CoreExpr]) -occAnalList _ [] = (emptyDetails, []) -occAnalList env (e:es) = case occAnal env e of { (uds1, e') -> - case occAnalList env es of { (uds2, es') -> - (uds1 `andUDs` uds2, e' : es') } } +occAnalList :: OccEnv -> [CoreExpr] -> WithUsageDetails [CoreExpr] +occAnalList !_ [] = WithUsageDetails emptyDetails [] +occAnalList env (e:es) = let + (WithUsageDetails uds1 e') = occAnal env e + (WithUsageDetails uds2 es') = occAnalList env es + in WithUsageDetails (uds1 `andUDs` uds2) (e' : es') occAnal :: OccEnv -> CoreExpr - -> (UsageDetails, -- Gives info only about the "interesting" Ids - CoreExpr) + -> WithUsageDetails CoreExpr -- Gives info only about the "interesting" Ids -occAnal _ expr@(Type _) = (emptyDetails, expr) -occAnal _ expr@(Lit _) = (emptyDetails, expr) -occAnal env expr@(Var _) = occAnalApp env (expr, [], []) +occAnal !_ expr@(Lit _) = WithUsageDetails emptyDetails expr + +occAnal env expr@(Var _) = occAnalApp env (expr, [], []) -- At one stage, I gathered the idRuleVars for the variable here too, -- which in a way is the right thing to do. -- But that went wrong right after specialisation, when @@ -1910,35 +1913,74 @@ -- rules in them, so the *specialised* versions looked as if they -- weren't used at all. -occAnal _ (Coercion co) - = (addManyOccs emptyDetails (coVarsOfCo co), Coercion co) +occAnal _ expr@(Type ty) + = WithUsageDetails (addManyOccs emptyDetails (coVarsOfType ty)) expr +occAnal _ expr@(Coercion co) + = WithUsageDetails (addManyOccs emptyDetails (coVarsOfCo co)) expr -- See Note [Gather occurrences of coercion variables] -{- -Note [Gather occurrences of coercion variables] +{- Note [Gather occurrences of coercion variables] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We need to gather info about what coercion variables appear, so that -we can sort them into the right place when doing dependency analysis. +We need to gather info about what coercion variables appear, for two reasons: + +1. So that we can sort them into the right place when doing dependency analysis. + +2. So that we know when they are surely dead. + +It is useful to know when they a coercion variable is surely dead, +when we want to discard a case-expression, in GHC.Core.Opt.Simplify.rebuildCase. +For example (#20143): + + case unsafeEqualityProof @blah of + UnsafeRefl cv -> ...no use of cv... + +Here we can discard the case, since unsafeEqualityProof always terminates. +But only if the coercion variable 'cv' is unused. + +Another example from #15696: we had something like + case eq_sel d of co -> ...(typeError @(...co...) "urk")... +Then 'd' was substituted by a dictionary, so the expression +simpified to + case (Coercion ) of cv -> ...(typeError @(...cv...) "urk")... + +We can only drop the case altogether if 'cv' is unused, which is not +the case here. + +Conclusion: we need accurate dead-ness info for CoVars. +We gather CoVar occurrences from: + + * The (Type ty) and (Coercion co) cases of occAnal + + * The type 'ty' of a lambda-binder (\(x:ty). blah) + See addLamCoVarOccs + +But it is not necessary to gather CoVars from the types of other binders. + +* For let-binders, if the type mentions a CoVar, so will the RHS (since + it has the same type) + +* For case-alt binders, if the type mentions a CoVar, so will the scrutinee + (since it has the same type) -} occAnal env (Tick tickish body) | SourceNote{} <- tickish - = (usage, Tick tickish body') + = WithUsageDetails usage (Tick tickish body') -- SourceNotes are best-effort; so we just proceed as usual. -- If we drop a tick due to the issues described below it's -- not the end of the world. | tickish `tickishScopesLike` SoftScope - = (markAllNonTail usage, Tick tickish body') + = WithUsageDetails (markAllNonTail usage) (Tick tickish body') | Breakpoint _ _ ids <- tickish - = (usage_lam `andUDs` foldr addManyOcc emptyDetails ids, Tick tickish body') + = WithUsageDetails (usage_lam `andUDs` foldr addManyOcc emptyDetails ids) (Tick tickish body') -- never substitute for any of the Ids in a Breakpoint | otherwise - = (usage_lam, Tick tickish body') + = WithUsageDetails usage_lam (Tick tickish body') where - !(usage,body') = occAnal env body + (WithUsageDetails usage body') = occAnal env body -- for a non-soft tick scope, we can inline lambdas only usage_lam = markAllNonTail (markAllInsideLam usage) -- TODO There may be ways to make ticks and join points play @@ -1950,15 +1992,15 @@ -- See #14242. occAnal env (Cast expr co) - = case occAnal env expr of { (usage, expr') -> - let usage1 = markAllManyNonTailIf (isRhsEnv env) usage + = let + (WithUsageDetails usage expr') = occAnal env expr + usage1 = markAllManyNonTailIf (isRhsEnv env) usage -- usage1: if we see let x = y `cast` co -- then mark y as 'Many' so that we don't -- immediately inline y again. - usage2 = addManyOccs usage1 (coVarsOfCo co) + usage2 = addManyOccs usage1 (coVarsOfCo co) -- usage2: see Note [Gather occurrences of coercion variables] - in (markAllNonTail usage2, Cast expr' co) - } + in WithUsageDetails (markAllNonTail usage2) (Cast expr' co) occAnal env app@(App _ _) = occAnalApp env (collectArgsTicks tickishFloatable app) @@ -1969,9 +2011,9 @@ occAnal env (Lam x body) | isTyVar x - = case occAnal env body of { (body_usage, body') -> - (markAllNonTail body_usage, Lam x body') - } + = let + (WithUsageDetails body_usage body') = occAnal env body + in WithUsageDetails (markAllNonTail body_usage) (Lam x body') {- Note [Occurrence analysis for lambda binders] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1991,53 +2033,49 @@ occAnal env expr@(Lam _ _) = -- See Note [Occurrence analysis for lambda binders] - case occAnalLamOrRhs env bndrs body of { (usage, tagged_bndrs, body') -> let - expr' = mkLams tagged_bndrs body' - usage1 = markAllNonTail usage - one_shot_gp = all isOneShotBndr tagged_bndrs - final_usage = markAllInsideLamIf (not one_shot_gp) usage1 - in - (final_usage, expr') } - where - (bndrs, body) = collectBinders expr + (bndrs, body) = collectBinders expr + (WithUsageDetails usage (tagged_bndrs, body')) = occAnalLamOrRhs env bndrs body + expr' = mkLams tagged_bndrs body' + usage1 = markAllNonTail usage + one_shot_gp = all isOneShotBndr tagged_bndrs + final_usage = markAllInsideLamIf (not one_shot_gp) usage1 + `addLamCoVarOccs` bndrs + -- See Note [Gather occurrences of coercion variables] + in WithUsageDetails final_usage expr' occAnal env (Case scrut bndr ty alts) - = case occAnal (scrutCtxt env alts) scrut of { (scrut_usage, scrut') -> - let alt_env = addBndrSwap scrut' bndr $ - env { occ_encl = OccVanilla } `addInScope` [bndr] - in - case mapAndUnzip (occAnalAlt alt_env) alts of { (alts_usage_s, alts') -> - let - alts_usage = foldr orUDs emptyDetails alts_usage_s - (alts_usage1, tagged_bndr) = tagLamBinder alts_usage bndr - total_usage = markAllNonTail scrut_usage `andUDs` alts_usage1 - -- Alts can have tail calls, but the scrutinee can't - in - total_usage `seq` (total_usage, Case scrut' tagged_bndr ty alts') }} + = let + (WithUsageDetails scrut_usage scrut') = occAnal (scrutCtxt env alts) scrut + alt_env = addBndrSwap scrut' bndr $ env { occ_encl = OccVanilla } `addInScope` [bndr] + (alts_usage_s, alts') = mapAndUnzip ((\(WithUsageDetails uds a) -> (uds,a)) . occAnalAlt alt_env) alts + alts_usage = foldr orUDs emptyDetails alts_usage_s + (alts_usage1, tagged_bndr) = tagLamBinder alts_usage bndr + total_usage = markAllNonTail scrut_usage `andUDs` alts_usage1 + -- Alts can have tail calls, but the scrutinee can't + in WithUsageDetails total_usage (Case scrut' tagged_bndr ty alts') occAnal env (Let bind body) - = case occAnal (env `addInScope` bindersOf bind) - body of { (body_usage, body') -> - case occAnalBind env NotTopLevel - noImpRuleEdges bind - body_usage of { (final_usage, new_binds) -> - (final_usage, mkLets new_binds body') }} - -occAnalArgs :: OccEnv -> [CoreExpr] -> [OneShots] -> (UsageDetails, [CoreExpr]) -occAnalArgs _ [] _ - = (emptyDetails, []) - -occAnalArgs env (arg:args) one_shots - | isTypeArg arg - = case occAnalArgs env args one_shots of { (uds, args') -> - (uds, arg:args') } + = let + (WithUsageDetails body_usage body') = occAnal (env `addInScope` bindersOf bind) body + (WithUsageDetails final_usage new_binds) = occAnalBind env NotTopLevel + noImpRuleEdges bind body_usage + in WithUsageDetails final_usage (mkLets new_binds body') - | otherwise - = case argCtxt env one_shots of { (arg_env, one_shots') -> - case occAnal arg_env arg of { (uds1, arg') -> - case occAnalArgs env args one_shots' of { (uds2, args') -> - (uds1 `andUDs` uds2, arg':args') }}} +occAnalArgs :: OccEnv -> CoreExpr -> [CoreExpr] -> [OneShots] -> WithUsageDetails CoreExpr +-- The `fun` argument is just an accumulating parameter, +-- the base for building the application we return +occAnalArgs !env fun args !one_shots + = go emptyDetails fun args one_shots + where + go uds fun [] _ = WithUsageDetails uds fun + go uds fun (arg:args) one_shots + = go (uds `andUDs` arg_uds) (fun `App` arg') args one_shots' + where + !(WithUsageDetails arg_uds arg') = occAnal arg_env arg + !(arg_env, one_shots') + | isTypeArg arg = (env, one_shots) + | otherwise = valArgCtxt env one_shots {- Applications are dealt with specially because we want @@ -2058,9 +2096,9 @@ occAnalApp :: OccEnv -> (Expr CoreBndr, [Arg CoreBndr], [CoreTickish]) - -> (UsageDetails, Expr CoreBndr) + -> WithUsageDetails (Expr CoreBndr) -- Naked variables (not applied) end up here too -occAnalApp env (Var fun, args, ticks) +occAnalApp !env (Var fun, args, ticks) -- Account for join arity of runRW# continuation -- See Note [Simplification of runRW#] -- @@ -2071,13 +2109,17 @@ -- This caused #18296 | fun `hasKey` runRWKey , [t1, t2, arg] <- args - , let (usage, arg') = occAnalRhs env NonRecursive (Just 1) arg - = (usage, mkTicks ticks $ mkApps (Var fun) [t1, t2, arg']) + , let (WithUsageDetails usage arg') = occAnalRhs env NonRecursive (Just 1) arg + = WithUsageDetails usage (mkTicks ticks $ mkApps (Var fun) [t1, t2, arg']) occAnalApp env (Var fun_id, args, ticks) - = (all_uds, mkTicks ticks $ mkApps fun' args') + = WithUsageDetails all_uds (mkTicks ticks app') where - (fun', fun_id') = lookupBndrSwap env fun_id + -- Lots of banged bindings: this is a very heavily bit of code, + -- so it pays not to make lots of thunks here, all of which + -- will ultimately be forced. + !(fun', fun_id') = lookupBndrSwap env fun_id + !(WithUsageDetails args_uds app') = occAnalArgs env fun' args one_shots fun_uds = mkOneOcc fun_id' int_cxt n_args -- NB: fun_uds is computed for fun_id', not fun_id @@ -2085,8 +2127,7 @@ all_uds = fun_uds `andUDs` final_args_uds - !(args_uds, args') = occAnalArgs env args one_shots - !final_args_uds = markAllNonTail $ + !final_args_uds = markAllNonTail $ markAllInsideLamIf (isRhsEnv env && is_exp) $ args_uds -- We mark the free vars of the argument of a constructor or PAP @@ -2099,14 +2140,14 @@ -- This is the *whole point* of the isRhsEnv predicate -- See Note [Arguments of let-bound constructors] - n_val_args = valArgCount args - n_args = length args - int_cxt = case occ_encl env of + !n_val_args = valArgCount args + !n_args = length args + !int_cxt = case occ_encl env of OccScrut -> IsInteresting _other | n_val_args > 0 -> IsInteresting | otherwise -> NotInteresting - is_exp = isExpandableApp fun_id n_val_args + !is_exp = isExpandableApp fun_id n_val_args -- See Note [CONLIKE pragma] in GHC.Types.Basic -- The definition of is_exp should match that in GHC.Core.Opt.Simplify.prepareRhs @@ -2116,17 +2157,17 @@ -- See Note [Sources of one-shot information], bullet point A'] occAnalApp env (fun, args, ticks) - = (markAllNonTail (fun_uds `andUDs` args_uds), - mkTicks ticks $ mkApps fun' args') + = WithUsageDetails (markAllNonTail (fun_uds `andUDs` args_uds)) + (mkTicks ticks app') where - !(fun_uds, fun') = occAnal (addAppCtxt env args) fun + !(WithUsageDetails args_uds app') = occAnalArgs env fun' args [] + !(WithUsageDetails fun_uds fun') = occAnal (addAppCtxt env args) fun -- The addAppCtxt is a bit cunning. One iteration of the simplifier -- often leaves behind beta redexs like -- (\x y -> e) a1 a2 -- Here we would like to mark x,y as one-shot, and treat the whole -- thing much like a let. We do this by pushing some OneShotLam items -- onto the context stack. - !(args_uds, args') = occAnalArgs env args [] addAppCtxt :: OccEnv -> [Arg CoreBndr] -> OccEnv addAppCtxt env@(OccEnv { occ_one_shots = ctxt }) args @@ -2230,11 +2271,12 @@ -} occAnalLamOrRhs :: OccEnv -> [CoreBndr] -> CoreExpr - -> (UsageDetails, [CoreBndr], CoreExpr) + -> WithUsageDetails ([CoreBndr], CoreExpr) -- Tags the returned binders with their OccInfo, but does -- not do any markInsideLam to the returned usage details -occAnalLamOrRhs env [] body - = case occAnal env body of (body_usage, body') -> (body_usage, [], body') +occAnalLamOrRhs !env [] body + = let (WithUsageDetails body_usage body') = occAnal env body + in WithUsageDetails body_usage ([], body') -- RHS of thunk or nullary join point occAnalLamOrRhs env (bndr:bndrs) body @@ -2242,28 +2284,29 @@ = -- Important: Keep the environment so that we don't inline into an RHS like -- \(@ x) -> C @x (f @x) -- (see the beginning of Note [Cascading inlines]). - case occAnalLamOrRhs env bndrs body of - (body_usage, bndrs', body') -> (body_usage, bndr:bndrs', body') + let + (WithUsageDetails body_usage (bndrs',body')) = occAnalLamOrRhs env bndrs body + in WithUsageDetails body_usage (bndr:bndrs', body') occAnalLamOrRhs env binders body - = case occAnal env_body body of { (body_usage, body') -> - let - (final_usage, tagged_binders) = tagLamBinders body_usage binders' + = let + (WithUsageDetails body_usage body') = occAnal env_body body + (final_usage, tagged_binders) = tagLamBinders body_usage binders' -- Use binders' to put one-shot info on the lambdas in - (final_usage, tagged_binders, body') } + WithUsageDetails final_usage (tagged_binders, body') where env1 = env `addInScope` binders (env_body, binders') = oneShotGroup env1 binders occAnalAlt :: OccEnv - -> CoreAlt -> (UsageDetails, Alt IdWithOccInfo) -occAnalAlt env (Alt con bndrs rhs) - = case occAnal (env `addInScope` bndrs) rhs of { (rhs_usage1, rhs1) -> - let + -> CoreAlt -> WithUsageDetails (Alt IdWithOccInfo) +occAnalAlt !env (Alt con bndrs rhs) + = let + (WithUsageDetails rhs_usage1 rhs1) = occAnal (env `addInScope` bndrs) rhs (alt_usg, tagged_bndrs) = tagLamBinders rhs_usage1 bndrs in -- See Note [Binders in case alternatives] - (alt_usg, Alt con tagged_bndrs rhs1) } + WithUsageDetails alt_usg (Alt con tagged_bndrs rhs1) {- ************************************************************************ @@ -2284,8 +2327,8 @@ -- If x :-> (y, co) is in the env, -- then please replace x by (y |> sym mco) -- Invariant of course: idType x = exprType (y |> sym mco) - , occ_bs_env :: VarEnv (OutId, MCoercion) - , occ_bs_rng :: VarSet -- Vars free in the range of occ_bs_env + , occ_bs_env :: !(VarEnv (OutId, MCoercion)) + , occ_bs_rng :: !VarSet -- Vars free in the range of occ_bs_env -- Domain is Global and Local Ids -- Range is just Local Ids } @@ -2337,7 +2380,7 @@ noBinderSwaps (OccEnv { occ_bs_env = bs_env }) = isEmptyVarEnv bs_env scrutCtxt :: OccEnv -> [CoreAlt] -> OccEnv -scrutCtxt env alts +scrutCtxt !env alts | interesting_alts = env { occ_encl = OccScrut, occ_one_shots = [] } | otherwise = env { occ_encl = OccVanilla, occ_one_shots = [] } where @@ -2350,12 +2393,12 @@ -- pre/postInlineUnconditionally. Grep for "occ_int_cxt"! rhsCtxt :: OccEnv -> OccEnv -rhsCtxt env = env { occ_encl = OccRhs, occ_one_shots = [] } +rhsCtxt !env = env { occ_encl = OccRhs, occ_one_shots = [] } -argCtxt :: OccEnv -> [OneShots] -> (OccEnv, [OneShots]) -argCtxt env [] +valArgCtxt :: OccEnv -> [OneShots] -> (OccEnv, [OneShots]) +valArgCtxt !env [] = (env { occ_encl = OccVanilla, occ_one_shots = [] }, []) -argCtxt env (one_shots:one_shots_s) +valArgCtxt env (one_shots:one_shots_s) = (env { occ_encl = OccVanilla, occ_one_shots = one_shots }, one_shots_s) isRhsEnv :: OccEnv -> Bool @@ -2783,9 +2826,9 @@ data UsageDetails = UD { ud_env :: !OccInfoEnv - , ud_z_many :: ZappedSet -- apply 'markMany' to these - , ud_z_in_lam :: ZappedSet -- apply 'markInsideLam' to these - , ud_z_no_tail :: ZappedSet } -- apply 'markNonTail' to these + , ud_z_many :: !ZappedSet -- apply 'markMany' to these + , ud_z_in_lam :: !ZappedSet -- apply 'markInsideLam' to these + , ud_z_no_tail :: !ZappedSet } -- apply 'markNonTail' to these -- INVARIANT: All three zapped sets are subsets of the OccInfoEnv instance Outputable UsageDetails where @@ -2829,6 +2872,12 @@ addManyOccs usage id_set = nonDetStrictFoldUniqSet addManyOcc usage id_set -- It's OK to use nonDetStrictFoldUniqSet here because addManyOcc commutes +addLamCoVarOccs :: UsageDetails -> [Var] -> UsageDetails +-- Add any CoVars free in the type of a lambda-binder +-- See Note [Gather occurrences of coercion variables] +addLamCoVarOccs uds bndrs + = uds `addManyOccs` coVarsOfTypes (map varType bndrs) + delDetails :: UsageDetails -> Id -> UsageDetails delDetails ud bndr = ud `alterUsageDetails` (`delVarEnv` bndr) @@ -2871,10 +2920,6 @@ lookupDetails :: UsageDetails -> Id -> OccInfo lookupDetails ud id - | isCoVar id -- We do not currently gather occurrence info (from types) - = noOccInfo -- for CoVars, so we must conservatively mark them as used - -- See Note [DoO not mark CoVars as dead] - | otherwise = case lookupVarEnv (ud_env ud) id of Just occ -> doZapping ud id occ Nothing -> IAmDead @@ -2889,25 +2934,6 @@ restrictFreeVars :: VarSet -> OccInfoEnv -> VarSet restrictFreeVars bndrs fvs = restrictUniqSetToUFM bndrs fvs -{- Note [Do not mark CoVars as dead] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -It's obviously wrong to mark CoVars as dead if they are used. -Currently we don't traverse types to gather usage info for CoVars, -so we had better treat them as having noOccInfo. - -This showed up in #15696 we had something like - case eq_sel d of co -> ...(typeError @(...co...) "urk")... - -Then 'd' was substituted by a dictionary, so the expression -simpified to - case (Coercion ) of co -> ...(typeError @(...co...) "urk")... - -But then the "drop the case altogether" equation of rebuildCase -thought that 'co' was dead, and discarded the entire case. Urk! - -I have no idea how we managed to avoid this pitfall for so long! --} - ------------------- -- Auxiliary functions for UsageDetails implementation @@ -2939,20 +2965,19 @@ occ2 | uniq `elemVarEnvByKey` no_tail = markNonTail occ1 | otherwise = occ1 -alterZappedSets :: UsageDetails -> (ZappedSet -> ZappedSet) -> UsageDetails -alterZappedSets ud f - = ud { ud_z_many = f (ud_z_many ud) +alterUsageDetails :: UsageDetails -> (OccInfoEnv -> OccInfoEnv) -> UsageDetails +alterUsageDetails !ud f + = UD { ud_env = f (ud_env ud) + , ud_z_many = f (ud_z_many ud) , ud_z_in_lam = f (ud_z_in_lam ud) , ud_z_no_tail = f (ud_z_no_tail ud) } -alterUsageDetails :: UsageDetails -> (OccInfoEnv -> OccInfoEnv) -> UsageDetails -alterUsageDetails ud f - = ud { ud_env = f (ud_env ud) } `alterZappedSets` f - flattenUsageDetails :: UsageDetails -> UsageDetails -flattenUsageDetails ud - = ud { ud_env = mapUFM_Directly (doZappingByUnique ud) (ud_env ud) } - `alterZappedSets` const emptyVarEnv +flattenUsageDetails ud@(UD { ud_env = env }) + = UD { ud_env = mapUFM_Directly (doZappingByUnique ud) env + , ud_z_many = emptyVarEnv + , ud_z_in_lam = emptyVarEnv + , ud_z_no_tail = emptyVarEnv } ------------------- -- See Note [Adjusting right-hand sides] @@ -3150,9 +3175,11 @@ willBeJoinId_maybe :: CoreBndr -> Maybe JoinArity willBeJoinId_maybe bndr - = case tailCallInfo (idOccInfo bndr) of - AlwaysTailCalled arity -> Just arity - _ -> isJoinId_maybe bndr + | isId bndr + , AlwaysTailCalled arity <- tailCallInfo (idOccInfo bndr) + = Just arity + | otherwise + = isJoinId_maybe bndr {- Note [Join points and INLINE pragmas] diff --git a/compiler/GHC/Core/Predicate.hs b/compiler/GHC/Core/Predicate.hs --- a/compiler/GHC/Core/Predicate.hs +++ b/compiler/GHC/Core/Predicate.hs @@ -24,6 +24,7 @@ -- Implicit parameters isIPLikePred, hasIPSuperClasses, isIPTyCon, isIPClass, + isCallStackTy, isCallStackPred, isCallStackPredTy, -- Evidence variables DictId, isEvVar, isDictId @@ -44,6 +45,7 @@ import GHC.Utils.Outputable import GHC.Utils.Misc import GHC.Utils.Panic +import GHC.Data.FastString( FastString ) -- | A predicate in the solver. The solver tries to prove Wanted predicates @@ -256,6 +258,39 @@ initIPRecTc :: RecTcChecker initIPRecTc = setRecTcMaxBound 1 initRecTc + +-- --------------------- CallStack predicates --------------------------------- + +isCallStackPredTy :: Type -> Bool +-- True of HasCallStack, or IP "blah" CallStack +isCallStackPredTy ty + | Just (tc, tys) <- splitTyConApp_maybe ty + , Just cls <- tyConClass_maybe tc + , Just {} <- isCallStackPred cls tys + = True + | otherwise + = False + +-- | Is a 'PredType' a 'CallStack' implicit parameter? +-- +-- If so, return the name of the parameter. +isCallStackPred :: Class -> [Type] -> Maybe FastString +isCallStackPred cls tys + | [ty1, ty2] <- tys + , isIPClass cls + , isCallStackTy ty2 + = isStrLitTy ty1 + | otherwise + = Nothing + +-- | Is a type a 'CallStack'? +isCallStackTy :: Type -> Bool +isCallStackTy ty + | Just tc <- tyConAppTyCon_maybe ty + = tc `hasKey` callStackTyConKey + | otherwise + = False + {- Note [Local implicit parameters] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ diff --git a/compiler/GHC/Core/SimpleOpt.hs b/compiler/GHC/Core/SimpleOpt.hs --- a/compiler/GHC/Core/SimpleOpt.hs +++ b/compiler/GHC/Core/SimpleOpt.hs @@ -1174,7 +1174,12 @@ -- Look through dictionary functions; see Note [Unfolding DFuns] | DFunUnfolding { df_bndrs = bndrs, df_con = con, df_args = dfun_args } <- unfolding , bndrs `equalLength` args -- See Note [DFun arity check] - , let subst = mkOpenSubst in_scope (bndrs `zip` args) + , let in_scope' = extend_in_scope (exprsFreeVars dfun_args) + subst = mkOpenSubst in_scope' (bndrs `zip` args) + -- We extend the in-scope set here to silence warnings from + -- substExpr when it finds not-in-scope Ids in dfun_args. + -- simplOptExpr initialises the in-scope set with exprFreeVars, + -- but that doesn't account for DFun unfoldings = succeedWith in_scope floats $ pushCoDataCon con (map (substExpr subst) dfun_args) co @@ -1185,7 +1190,7 @@ -- CPR'd workers getting inlined back into their wrappers, | idArity fun == 0 , Just rhs <- expandUnfolding_maybe unfolding - , let in_scope' = extendInScopeSetSet in_scope (exprFreeVars rhs) + , let in_scope' = extend_in_scope (exprFreeVars rhs) = go (Left in_scope') floats rhs cont -- See Note [exprIsConApp_maybe on literal strings] @@ -1197,6 +1202,11 @@ dealWithStringLiteral fun str co where unfolding = id_unf fun + extend_in_scope unf_fvs + | isLocalId fun = in_scope `extendInScopeSetSet` unf_fvs + | otherwise = in_scope + -- A GlobalId has no (LocalId) free variables; and the + -- in-scope set tracks only LocalIds go _ _ _ _ = Nothing diff --git a/compiler/GHC/Core/Unfold.hs b/compiler/GHC/Core/Unfold.hs --- a/compiler/GHC/Core/Unfold.hs +++ b/compiler/GHC/Core/Unfold.hs @@ -954,8 +954,11 @@ ---------------- smallEnoughToInline :: UnfoldingOpts -> Unfolding -> Bool -smallEnoughToInline opts (CoreUnfolding {uf_guidance = UnfIfGoodArgs {ug_size = size}}) - = size <= unfoldingUseThreshold opts +smallEnoughToInline opts (CoreUnfolding {uf_guidance = guidance}) + = case guidance of + UnfIfGoodArgs {ug_size = size} -> size <= unfoldingUseThreshold opts + UnfWhen {} -> True + UnfNever -> False smallEnoughToInline _ _ = False diff --git a/compiler/GHC/Core/Unfold/Make.hs b/compiler/GHC/Core/Unfold/Make.hs --- a/compiler/GHC/Core/Unfold/Make.hs +++ b/compiler/GHC/Core/Unfold/Make.hs @@ -169,14 +169,14 @@ , uf_is_top = top_lvl , uf_guidance = old_guidance }) | isStableSource src -- See Note [Specialising unfoldings] - , UnfWhen { ug_arity = old_arity } <- old_guidance + , UnfWhen { ug_arity = old_arity } <- old_guidance = mkCoreUnfolding src top_lvl new_tmpl (old_guidance { ug_arity = old_arity - arity_decrease }) where new_tmpl = simpleOptExpr opts $ - mkLams spec_bndrs $ + mkLams spec_bndrs $ spec_app tmpl -- The beta-redexes created by spec_app - -- will besimplified away by simplOptExpr + -- will be simplified away by simplOptExpr arity_decrease = count isValArg rule_lhs_args - count isId spec_bndrs diff --git a/compiler/GHC/Core/Unify.hs b/compiler/GHC/Core/Unify.hs --- a/compiler/GHC/Core/Unify.hs +++ b/compiler/GHC/Core/Unify.hs @@ -1393,6 +1393,8 @@ (<*>) = ap instance Monad UM where + {-# INLINE (>>=) #-} + -- See Note [INLINE pragmas and (>>)] in GHC.Utils.Monad m >>= k = UM (\state -> do { (state', v) <- unUM m state ; unUM (k v) state' }) diff --git a/compiler/GHC/Core/Utils.hs b/compiler/GHC/Core/Utils.hs --- a/compiler/GHC/Core/Utils.hs +++ b/compiler/GHC/Core/Utils.hs @@ -9,7 +9,7 @@ -- | Commonly useful utilities for manipulating the Core language module GHC.Core.Utils ( -- * Constructing expressions - mkCast, + mkCast, mkCastMCo, mkPiMCo, mkTick, mkTicks, mkTickNoHNF, tickHNFArgs, bindNonRec, needsCaseBinding, mkAltExpr, mkDefaultCase, mkSingleAltCase, @@ -79,7 +79,7 @@ import GHC.Core.TyCon import GHC.Core.Multiplicity -import GHC.Builtin.Names (makeStaticName, unsafeEqualityProofName) +import GHC.Builtin.Names ( makeStaticName, unsafeEqualityProofIdKey ) import GHC.Builtin.PrimOps import GHC.Types.Var @@ -139,7 +139,7 @@ exprType (Lam binder expr) = mkLamType binder (exprType expr) exprType e@(App _ _) = case collectArgs e of - (fun, args) -> applyTypeToArgs e (exprType fun) args + (fun, args) -> applyTypeToArgs (pprCoreExpr e) (exprType fun) args exprType other = pprPanic "exprType" (pprCoreExpr other) @@ -268,10 +268,10 @@ -} -- Not defined with applyTypeToArg because you can't print from GHC.Core. -applyTypeToArgs :: CoreExpr -> Type -> [CoreExpr] -> Type +applyTypeToArgs :: SDoc -> Type -> [CoreExpr] -> Type -- ^ A more efficient version of 'applyTypeToArg' when we have several arguments. -- The first argument is just for debugging, and gives some context -applyTypeToArgs e op_ty args +applyTypeToArgs pp_e op_ty args = go op_ty args where go op_ty [] = op_ty @@ -290,12 +290,21 @@ go_ty_args op_ty rev_tys args = go (piResultTys op_ty (reverse rev_tys)) args - panic_msg as = vcat [ text "Expression:" <+> pprCoreExpr e - , text "Type:" <+> ppr op_ty - , text "Args:" <+> ppr args - , text "Args':" <+> ppr as ] + panic_msg as = vcat [ text "Expression:" <+> pp_e + , text "Type:" <+> ppr op_ty + , text "Args:" <+> ppr args + , text "Args':" <+> ppr as ] +mkCastMCo :: CoreExpr -> MCoercionR -> CoreExpr +mkCastMCo e MRefl = e +mkCastMCo e (MCo co) = Cast e co + -- We are careful to use (MCo co) only when co is not reflexive + -- Hence (Cast e co) rather than (mkCast e co) +mkPiMCo :: Var -> MCoercionR -> MCoercionR +mkPiMCo _ MRefl = MRefl +mkPiMCo v (MCo co) = MCo (mkPiCo Representational v co) + {- ************************************************************************ * * @@ -1661,14 +1670,28 @@ -> primop_ok op -- Check the primop itself && and (zipWith primop_arg_ok arg_tys args) -- Check the arguments - _other -> isUnliftedType (idType fun) -- c.f. the Var case of exprIsHNF - || idArity fun > n_val_args -- Partial apps + _ -- Unlifted types + -- c.f. the Var case of exprIsHNF + | isUnliftedType (idType fun) + -> assertPpr (n_val_args == 0) (ppr fun $$ ppr args) + True -- Our only unlifted types are Int# etc, so will have + -- no value args. The assert is just to check this. + -- If we added unlifted function types this would change, + -- and we'd need to actually test n_val_args == 0. + + -- Partial applications + | idArity fun > n_val_args -> True + + -- Functions that terminate fast without raising exceptions etc + -- See Note [Discarding unnecessary unsafeEqualityProofs] + | fun `hasKey` unsafeEqualityProofIdKey -> True + + | otherwise -> False -- NB: even in the nullary case, do /not/ check -- for evaluated-ness of the fun; -- see Note [exprOkForSpeculation and evaluated variables] - where - n_val_args = valArgCount args where + n_val_args = valArgCount args (arg_tys, _) = splitPiTys (idType fun) primop_arg_ok :: TyBinder -> CoreExpr -> Bool @@ -1841,6 +1864,20 @@ Note that exprIsHNF /can/ and does take advantage of evaluated-ness; it doesn't have the trickiness of the let/app invariant to worry about. +Note [Discarding unnecessary unsafeEqualityProofs] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +In #20143 we found + case unsafeEqualityProof @t1 @t2 of UnsafeRefl cv[dead] -> blah +where 'blah' didn't mention 'cv'. We'd like to discard this +redundant use of unsafeEqualityProof, via GHC.Core.Opt.Simplify.rebuildCase. +To do this we need to know + (a) that cv is unused (done by OccAnal), and + (b) that unsafeEqualityProof terminates rapidly without side effects. + +At the moment we check that explicitly here in exprOkForSideEffects, +but one might imagine a more systematic check in future. + + ************************************************************************ * * exprIsHNF, exprIsConLike @@ -2494,8 +2531,7 @@ , let mult = idMult bndr , Just (fun_mult, _, _) <- splitFunTy_maybe fun_ty , mult `eqType` fun_mult -- There is no change in multiplicity, otherwise we must abort - = let reflCo = mkRepReflCo (idType bndr) - in Just (mkFunCo Representational (multToCo mult) reflCo co, []) + = Just (mkFunResCo Representational (idScaledType bndr) co, []) ok_arg bndr (Cast e co_arg) co fun_ty | (ticks, Var v) <- stripTicksTop tickishFloatable e , Just (fun_mult, _, _) <- splitFunTy_maybe fun_ty @@ -2656,6 +2692,6 @@ -- Note [Implementing unsafeCoerce] in base:Unsafe.Coerce isUnsafeEqualityProof e | Var v `App` Type _ `App` Type _ `App` Type _ <- e - = idName v == unsafeEqualityProofName + = v `hasKey` unsafeEqualityProofIdKey | otherwise = False diff --git a/compiler/GHC/Driver/Config/Finder.hs b/compiler/GHC/Driver/Config/Finder.hs new file mode 100644 --- /dev/null +++ b/compiler/GHC/Driver/Config/Finder.hs @@ -0,0 +1,26 @@ +module GHC.Driver.Config.Finder ( + FinderOpts(..), + initFinderOpts + ) where + +import GHC.Prelude + +import GHC.Driver.Session +import GHC.Unit.Finder + +-- | Create a new 'FinderOpts' from DynFlags. +initFinderOpts :: DynFlags -> FinderOpts +initFinderOpts flags = FinderOpts + { finder_importPaths = importPaths flags + , finder_lookupHomeInterfaces = isOneShot (ghcMode flags) + , finder_bypassHiFileCheck = MkDepend == (ghcMode flags) + , finder_ways = ways flags + , finder_enableSuggestions = gopt Opt_HelpfulErrors flags + , finder_hieDir = hieDir flags + , finder_hieSuf = hieSuf flags + , finder_hiDir = hiDir flags + , finder_hiSuf = hiSuf flags + , finder_objectDir = objectDir flags + , finder_objectSuf = objectSuf flags + , finder_stubDir = stubDir flags + } diff --git a/compiler/GHC/Driver/Errors/Ppr.hs b/compiler/GHC/Driver/Errors/Ppr.hs --- a/compiler/GHC/Driver/Errors/Ppr.hs +++ b/compiler/GHC/Driver/Errors/Ppr.hs @@ -16,8 +16,12 @@ import GHC.Unit.Types import GHC.Utils.Outputable import GHC.Unit.Module +import GHC.Unit.State import GHC.Types.Hint +import GHC.Types.SrcLoc +import Language.Haskell.Syntax.Decls (RuleDecl(..)) + -- -- Suggestions -- @@ -121,6 +125,52 @@ -> mkSimpleDecorated (text "StaticPointers is not supported in GHCi interactive expressions.") DriverBackpackModuleNotFound modname -> mkSimpleDecorated (text "module" <+> ppr modname <+> text "was not found") + DriverUserDefinedRuleIgnored (HsRule { rd_name = n }) + -> mkSimpleDecorated $ + text "Rule \"" <> ftext (snd $ unLoc n) <> text "\" ignored" $+$ + text "User defined rules are disabled under Safe Haskell" + DriverMixedSafetyImport modName + -> mkSimpleDecorated $ + text "Module" <+> ppr modName <+> text ("is imported both as a safe and unsafe import!") + DriverCannotLoadInterfaceFile m + -> mkSimpleDecorated $ + text "Can't load the interface file for" <+> ppr m + <> text ", to check that it can be safely imported" + DriverInferredSafeModule m + -> mkSimpleDecorated $ + quotes (ppr $ moduleName m) <+> text "has been inferred as safe!" + DriverInferredSafeImport m + -> mkSimpleDecorated $ + sep + [ text "Importing Safe-Inferred module " + <> ppr (moduleName m) + <> text " from explicitly Safe module" + ] + DriverMarkedTrustworthyButInferredSafe m + -> mkSimpleDecorated $ + quotes (ppr $ moduleName m) <+> text "is marked as Trustworthy but has been inferred as safe!" + DriverCannotImportUnsafeModule m + -> mkSimpleDecorated $ + sep [ ppr (moduleName m) + <> text ": Can't be safely imported!" + , text "The module itself isn't safe." ] + DriverMissingSafeHaskellMode modName + -> mkSimpleDecorated $ + ppr modName <+> text "is missing Safe Haskell mode" + DriverPackageNotTrusted state pkg + -> mkSimpleDecorated $ + pprWithUnitState state + $ text "The package (" + <> ppr pkg + <> text ") is required to be trusted but it isn't!" + DriverCannotImportFromUntrustedPackage state m + -> mkSimpleDecorated $ + sep [ ppr (moduleName m) + <> text ": Can't be safely imported!" + , text "The package (" + <> (pprWithUnitState state $ ppr (moduleUnit m)) + <> text ") the module resides in isn't trusted." + ] diagnosticReason = \case DriverUnknownMessage m @@ -147,6 +197,26 @@ -> WarningWithoutFlag DriverBackpackModuleNotFound{} -> ErrorWithoutFlag + DriverUserDefinedRuleIgnored{} + -> WarningWithoutFlag + DriverMixedSafetyImport{} + -> ErrorWithoutFlag + DriverCannotLoadInterfaceFile{} + -> ErrorWithoutFlag + DriverInferredSafeModule{} + -> WarningWithFlag Opt_WarnSafe + DriverMarkedTrustworthyButInferredSafe{} + ->WarningWithFlag Opt_WarnTrustworthySafe + DriverInferredSafeImport{} + -> WarningWithFlag Opt_WarnInferredSafeImports + DriverCannotImportUnsafeModule{} + -> ErrorWithoutFlag + DriverMissingSafeHaskellMode{} + -> WarningWithFlag Opt_WarnMissingSafeHaskellMode + DriverPackageNotTrusted{} + -> ErrorWithoutFlag + DriverCannotImportFromUntrustedPackage{} + -> ErrorWithoutFlag diagnosticHints = \case DriverUnknownMessage m @@ -174,4 +244,24 @@ DriverStaticPointersNotSupported -> noHints DriverBackpackModuleNotFound{} + -> noHints + DriverUserDefinedRuleIgnored{} + -> noHints + DriverMixedSafetyImport{} + -> noHints + DriverCannotLoadInterfaceFile{} + -> noHints + DriverInferredSafeModule{} + -> noHints + DriverInferredSafeImport{} + -> noHints + DriverCannotImportUnsafeModule{} + -> noHints + DriverMissingSafeHaskellMode{} + -> noHints + DriverPackageNotTrusted{} + -> noHints + DriverMarkedTrustworthyButInferredSafe{} + -> noHints + DriverCannotImportFromUntrustedPackage{} -> noHints diff --git a/compiler/GHC/Driver/Errors/Types.hs b/compiler/GHC/Driver/Errors/Types.hs --- a/compiler/GHC/Driver/Errors/Types.hs +++ b/compiler/GHC/Driver/Errors/Types.hs @@ -23,11 +23,15 @@ import GHC.Driver.Session import GHC.Types.Error import GHC.Unit.Module +import GHC.Unit.State import GHC.Parser.Errors.Types ( PsMessage(PsHeaderMessage) ) import GHC.Tc.Errors.Types ( TcRnMessage ) import GHC.HsToCore.Errors.Types ( DsMessage ) +import GHC.Hs.Extension (GhcTc) +import Language.Haskell.Syntax.Decls (RuleDecl) + -- | A collection of warning messages. -- /INVARIANT/: Each 'GhcMessage' in the collection should have 'SevWarning' severity. type WarningMessages = Messages GhcMessage @@ -198,6 +202,140 @@ Test cases: - -} DriverBackpackModuleNotFound :: !ModuleName -> DriverMessage + + {-| DriverUserDefinedRuleIgnored is a warning that occurs when user-defined rules + are ignored. This typically happens when Safe Haskell. + + Test cases: + + tests/safeHaskell/safeInfered/UnsafeWarn05 + tests/safeHaskell/safeInfered/UnsafeWarn06 + tests/safeHaskell/safeInfered/UnsafeWarn07 + tests/safeHaskell/safeInfered/UnsafeInfered11 + tests/safeHaskell/safeLanguage/SafeLang03 + -} + DriverUserDefinedRuleIgnored :: !(RuleDecl GhcTc) -> DriverMessage + + {-| DriverMixedSafetyImport is an error that occurs when a module is imported + both as safe and unsafe. + + Test cases: + + tests/safeHaskell/safeInfered/Mixed03 + tests/safeHaskell/safeInfered/Mixed02 + + -} + DriverMixedSafetyImport :: !ModuleName -> DriverMessage + + {-| DriverCannotLoadInterfaceFile is an error that occurs when we cannot load the interface + file for a particular module. This can happen for example in the context of Safe Haskell, + when we have to load a module to check if it can be safely imported. + + Test cases: None. + + -} + DriverCannotLoadInterfaceFile :: !Module -> DriverMessage + + {-| DriverInferredSafeImport is a warning (controlled by the Opt_WarnSafe flag) + that occurs when a module is inferred safe. + + Test cases: None. + + -} + DriverInferredSafeModule :: !Module -> DriverMessage + + {-| DriverMarkedTrustworthyButInferredSafe is a warning (controlled by the Opt_WarnTrustworthySafe flag) + that occurs when a module is marked trustworthy in SafeHaskell but it has been inferred safe. + + Test cases: + tests/safeHaskell/safeInfered/TrustworthySafe02 + tests/safeHaskell/safeInfered/TrustworthySafe03 + + -} + DriverMarkedTrustworthyButInferredSafe :: !Module -> DriverMessage + + {-| DriverInferredSafeImport is a warning (controlled by the Opt_WarnInferredSafeImports flag) + that occurs when a safe-inferred module is imported from a safe module. + + Test cases: None. + + -} + DriverInferredSafeImport :: !Module -> DriverMessage + + {-| DriverCannotImportUnsafeModule is an error that occurs when an usafe module + is being imported from a safe one. + + Test cases: None. + + -} + DriverCannotImportUnsafeModule :: !Module -> DriverMessage + + {-| DriverMissingSafeHaskellMode is a warning (controlled by the Opt_WarnMissingSafeHaskellMode flag) + that occurs when a module is using SafeHaskell features but SafeHaskell mode is not enabled. + + Test cases: None. + + -} + DriverMissingSafeHaskellMode :: !Module -> DriverMessage + + {-| DriverPackageNotTrusted is an error that occurs when a package is required to be trusted + but it isn't. + + Test cases: + tests/safeHaskell/check/Check01 + tests/safeHaskell/check/Check08 + tests/safeHaskell/check/Check06 + tests/safeHaskell/check/pkg01/ImpSafeOnly09 + tests/safeHaskell/check/pkg01/ImpSafe03 + tests/safeHaskell/check/pkg01/ImpSafeOnly07 + tests/safeHaskell/check/pkg01/ImpSafeOnly08 + + -} + DriverPackageNotTrusted :: !UnitState -> !UnitId -> DriverMessage + + {-| DriverCannotImportFromUntrustedPackage is an error that occurs in the context of + Safe Haskell when trying to import a module coming from an untrusted package. + + Test cases: + tests/safeHaskell/check/Check09 + tests/safeHaskell/check/pkg01/ImpSafe01 + tests/safeHaskell/check/pkg01/ImpSafe04 + tests/safeHaskell/check/pkg01/ImpSafeOnly03 + tests/safeHaskell/check/pkg01/ImpSafeOnly05 + tests/safeHaskell/flags/SafeFlags17 + tests/safeHaskell/flags/SafeFlags22 + tests/safeHaskell/flags/SafeFlags23 + tests/safeHaskell/ghci/p11 + tests/safeHaskell/ghci/p12 + tests/safeHaskell/ghci/p17 + tests/safeHaskell/ghci/p3 + tests/safeHaskell/safeInfered/UnsafeInfered01 + tests/safeHaskell/safeInfered/UnsafeInfered02 + tests/safeHaskell/safeInfered/UnsafeInfered02 + tests/safeHaskell/safeInfered/UnsafeInfered03 + tests/safeHaskell/safeInfered/UnsafeInfered05 + tests/safeHaskell/safeInfered/UnsafeInfered06 + tests/safeHaskell/safeInfered/UnsafeInfered09 + tests/safeHaskell/safeInfered/UnsafeInfered10 + tests/safeHaskell/safeInfered/UnsafeInfered11 + tests/safeHaskell/safeInfered/UnsafeWarn01 + tests/safeHaskell/safeInfered/UnsafeWarn03 + tests/safeHaskell/safeInfered/UnsafeWarn04 + tests/safeHaskell/safeInfered/UnsafeWarn05 + tests/safeHaskell/unsafeLibs/BadImport01 + tests/safeHaskell/unsafeLibs/BadImport06 + tests/safeHaskell/unsafeLibs/BadImport07 + tests/safeHaskell/unsafeLibs/BadImport08 + tests/safeHaskell/unsafeLibs/BadImport09 + tests/safeHaskell/unsafeLibs/Dep05 + tests/safeHaskell/unsafeLibs/Dep06 + tests/safeHaskell/unsafeLibs/Dep07 + tests/safeHaskell/unsafeLibs/Dep08 + tests/safeHaskell/unsafeLibs/Dep09 + tests/safeHaskell/unsafeLibs/Dep10 + + -} + DriverCannotImportFromUntrustedPackage :: !UnitState -> !Module -> DriverMessage -- | Pass to a 'DriverMessage' the information whether or not the -- '-fbuilding-cabal-package' flag is set. diff --git a/compiler/GHC/Driver/Hooks.hs b/compiler/GHC/Driver/Hooks.hs --- a/compiler/GHC/Driver/Hooks.hs +++ b/compiler/GHC/Driver/Hooks.hs @@ -33,7 +33,7 @@ import GHC.Driver.Env import GHC.Driver.Session -import GHC.Driver.Pipeline.Monad +import GHC.Driver.Pipeline.Phases import GHC.Hs.Decls import GHC.Hs.Binds @@ -137,7 +137,7 @@ , hscCompileCoreExprHook :: !(Maybe (HscEnv -> (SrcSpan, Maybe ModuleNameWithIsBoot) -> CoreExpr -> IO ForeignHValue)) , ghcPrimIfaceHook :: !(Maybe ModIface) - , runPhaseHook :: !(Maybe (PhasePlus -> FilePath -> CompPipeline (PhasePlus, FilePath))) + , runPhaseHook :: !(Maybe PhaseHook) , runMetaHook :: !(Maybe (MetaHook TcM)) , linkHook :: !(Maybe (GhcLink -> DynFlags -> Bool -> HomePackageTable -> IO SuccessFlag)) diff --git a/compiler/GHC/Driver/Phases.hs b/compiler/GHC/Driver/Phases.hs --- a/compiler/GHC/Driver/Phases.hs +++ b/compiler/GHC/Driver/Phases.hs @@ -1,5 +1,3 @@ - - ----------------------------------------------------------------------------- -- -- GHC Driver @@ -10,10 +8,13 @@ module GHC.Driver.Phases ( Phase(..), - happensBefore, eqPhase, anyHsc, isStopLn, + happensBefore, eqPhase, isStopLn, startPhase, phaseInputExt, + StopPhase(..), + stopPhaseToPhase, + isHaskellishSuffix, isHaskellSrcSuffix, isBackpackishSuffix, @@ -67,6 +68,19 @@ linker | other | - | a.out -} +-- Phases we can actually stop after +data StopPhase = StopPreprocess -- -E + | StopC -- -C + | StopAs -- -S + | NoStop -- -c + +stopPhaseToPhase :: StopPhase -> Phase +stopPhaseToPhase StopPreprocess = anyHsc +stopPhaseToPhase StopC = HCc +stopPhaseToPhase StopAs = As False +stopPhaseToPhase NoStop = StopLn + +-- | Untyped Phase description data Phase = Unlit HscSource | Cpp HscSource @@ -86,7 +100,6 @@ | MergeForeign -- merge in the foreign object files -- The final phase is a pseudo-phase that tells the pipeline to stop. - -- There is no runPhase case for it. | StopLn -- Stop, but linking will follow, so generate .o file deriving (Eq, Show) @@ -122,22 +135,8 @@ eqPhase Cobjcxx Cobjcxx = True eqPhase _ _ = False -{- Note [Partial ordering on phases] - -We want to know which phases will occur before which others. This is used for -sanity checking, to ensure that the pipeline will stop at some point (see -GHC.Driver.Pipeline.runPipeline). - -A < B iff A occurs before B in a normal compilation pipeline. - -There is explicitly not a total ordering on phases, because in registerised -builds, the phase `HsC` doesn't happen before nor after any other phase. - -Although we check that a normal user doesn't set the stop_phase to HsC through -use of -C with registerised builds (in Main.checkOptions), it is still -possible for a ghc-api user to do so. So be careful when using the function -happensBefore, and don't think that `not (a <= b)` implies `b < a`. --} +-- MP: happensBefore is only used in preprocessPipeline, that usage should +-- be refactored and this usage removed. happensBefore :: Platform -> Phase -> Phase -> Bool happensBefore platform p1 p2 = p1 `happensBefore'` p2 where StopLn `happensBefore'` _ = False @@ -211,7 +210,7 @@ phaseInputExt (HsPp _) = "hscpp" -- intermediate only phaseInputExt (Hsc _) = "hspp" -- intermediate only -- NB: as things stand, phaseInputExt (Hsc x) must not evaluate x - -- because runPipeline uses the StopBefore phase to pick the + -- because runPhase uses the StopBefore phase to pick the -- output filename. That could be fixed, but watch out. phaseInputExt HCc = "hc" phaseInputExt Ccxx = "cpp" diff --git a/compiler/GHC/Driver/Pipeline/Monad.hs b/compiler/GHC/Driver/Pipeline/Monad.hs --- a/compiler/GHC/Driver/Pipeline/Monad.hs +++ b/compiler/GHC/Driver/Pipeline/Monad.hs @@ -1,116 +1,78 @@ -{-# LANGUAGE DeriveFunctor #-} --- | The CompPipeline monad and associated ops --- --- Defined in separate module so that it can safely be imported from Hooks +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE MultiParamTypeClasses #-} +-- | The 'TPipelineClass' and 'MonadUse' classes and associated types module GHC.Driver.Pipeline.Monad ( - CompPipeline(..), evalP - , PhasePlus(..), HscBackendAction (..) - , PipeEnv(..), PipeState(..), PipelineOutput(..) - , getPipeEnv, getPipeState, getPipeSession - , setDynFlags, setModLocation, setForeignOs, setIface - , pipeStateDynFlags, pipeStateModIface, pipeStateLinkable, setPlugins, setLinkable + TPipelineClass, MonadUse(..) + + , PipeEnv(..) + , PipelineOutput(..) + , getLocation ) where import GHC.Prelude - -import GHC.Utils.Fingerprint -import GHC.Utils.Monad -import GHC.Utils.Outputable -import GHC.Utils.Logger - -import GHC.Driver.Session +import Control.Monad.IO.Class +import qualified Data.Kind as K import GHC.Driver.Phases -import GHC.Driver.Env -import GHC.Driver.Plugins - -import GHC.Linker.Types - -import GHC.Utils.TmpFs (TempFileLifetime) - -import GHC.Types.Error - +import GHC.Driver.Config.Finder +import GHC.Utils.TmpFs +import GHC.Driver.Session +import GHC.Types.SourceFile import GHC.Unit.Module -import GHC.Unit.Module.ModIface -import GHC.Unit.Module.ModSummary -import GHC.Unit.Module.Status - -import GHC.Driver.Errors.Types ( GhcMessage ) - -import GHC.Tc.Types - -import Control.Monad - -newtype CompPipeline a = P { unP :: PipeEnv -> PipeState -> IO (PipeState, a) } - deriving (Functor) - -evalP :: CompPipeline a -> PipeEnv -> PipeState -> IO (PipeState, a) -evalP (P f) env st = f env st - -instance Applicative CompPipeline where - pure a = P $ \_env state -> return (state, a) - (<*>) = ap - -instance Monad CompPipeline where - P m >>= k = P $ \env state -> do (state',a) <- m env state - unP (k a) env state' - -instance MonadIO CompPipeline where - liftIO m = P $ \_env state -> do a <- m; return (state, a) - -data PhasePlus = RealPhase Phase - -- | Runs the pipeline post typechecking, till the end - | HscPostTc ModSummary FrontendResult (Messages GhcMessage) (Maybe Fingerprint) - -- | The backend phase runs the code-gen. This may be run twice in - -- the case of -dynamic-too - | HscBackend ModSummary HscBackendAction - +import GHC.Unit.Finder -instance Outputable PhasePlus where - ppr (RealPhase p) = ppr p - ppr (HscPostTc {}) = text "HscPostTc" - ppr (HscBackend {}) = text "HscBackend" +-- The interface that the pipeline monad must implement. +type TPipelineClass (f :: K.Type -> K.Type) (m :: K.Type -> K.Type) + = (Functor m, MonadIO m, Applicative m, Monad m, MonadUse f m) --- ----------------------------------------------------------------------------- --- The pipeline uses a monad to carry around various bits of information +-- | Lift a `f` action into an `m` action. +class MonadUse f m where + use :: f a -> m a --- PipeEnv: invariant information passed down +-- PipeEnv: invariant information passed down through the pipeline data PipeEnv = PipeEnv { - stop_phase :: Phase, -- ^ Stop just before this phase + stop_phase :: StopPhase, -- ^ Stop just after this phase src_filename :: String, -- ^ basename of original input source src_basename :: String, -- ^ basename of original input source src_suffix :: String, -- ^ its extension output_spec :: PipelineOutput -- ^ says where to put the pipeline output } --- PipeState: information that might change during a pipeline run -data PipeState = PipeState { - hsc_env :: HscEnv, - -- ^ only the DynFlags and the Plugins change in the HscEnv. The - -- DynFlags change at various points, for example when we read the - -- OPTIONS_GHC pragmas in the Cpp phase. - maybe_loc :: Maybe ModLocation, - -- ^ the ModLocation. This is discovered during compilation, - -- in the Hsc phase where we read the module header. - foreign_os :: [FilePath], - -- ^ additional object files resulting from compiling foreign - -- code. They come from two sources: foreign stubs, and - -- add{C,Cxx,Objc,Objcxx}File from template haskell - iface :: Maybe ModIface, - -- ^ Interface generated by HscBackend phase. Only available after the - -- phase runs. - maybe_linkable :: Maybe Linkable - -- ^ Linkable generated by HscBackend phase, for the Interpreter backend. - } +-- | Calculate the ModLocation from the provided DynFlags +getLocation :: PipeEnv -> DynFlags -> HscSource -> ModuleName -> IO ModLocation +getLocation pipe_env dflags src_flavour mod_name = do + let PipeEnv{ src_basename=basename, + src_suffix=suff } = pipe_env + location1 <- mkHomeModLocation2 fopts mod_name basename suff -pipeStateDynFlags :: PipeState -> DynFlags -pipeStateDynFlags = hsc_dflags . hsc_env + -- Boot-ify it if necessary + let location2 + | HsBootFile <- src_flavour = addBootSuffixLocnOut location1 + | otherwise = location1 -pipeStateModIface :: PipeState -> Maybe ModIface -pipeStateModIface = iface -pipeStateLinkable :: PipeState -> Maybe Linkable -pipeStateLinkable = maybe_linkable + -- Take -ohi into account if present + -- This can't be done in mkHomeModuleLocation because + -- it only applies to the module being compiles + let ohi = outputHi dflags + location3 | Just fn <- ohi = location2{ ml_hi_file = fn } + | otherwise = location2 + -- Take -o into account if present + -- Very like -ohi, but we must *only* do this if we aren't linking + -- (If we're linking then the -o applies to the linked thing, not to + -- the object file for one module.) + -- Note the nasty duplication with the same computation in compileFile + -- above + let expl_o_file = outputFile dflags + location4 | Just ofile <- expl_o_file + , isNoLink (ghcLink dflags) + = location3 { ml_obj_file = ofile } + | otherwise = location3 + return location4 + where + fopts = initFinderOpts dflags + data PipelineOutput = Temporary TempFileLifetime -- ^ Output should be to a temporary file: we're going to @@ -126,41 +88,3 @@ | NoOutputFile -- ^ No output should be created, like in Interpreter or NoBackend. deriving Show - -getPipeEnv :: CompPipeline PipeEnv -getPipeEnv = P $ \env state -> return (state, env) - -getPipeState :: CompPipeline PipeState -getPipeState = P $ \_env state -> return (state, state) - -getPipeSession :: CompPipeline HscEnv -getPipeSession = P $ \_env state -> return (state, hsc_env state) - -instance HasDynFlags CompPipeline where - getDynFlags = P $ \_env state -> return (state, hsc_dflags (hsc_env state)) - -instance HasLogger CompPipeline where - getLogger = P $ \_env state -> return (state, hsc_logger (hsc_env state)) - -setDynFlags :: DynFlags -> CompPipeline () -setDynFlags dflags = P $ \_env state -> - return (state{ hsc_env = hscSetFlags dflags (hsc_env state)}, ()) - -setPlugins :: [LoadedPlugin] -> [StaticPlugin] -> CompPipeline () -setPlugins dyn static = P $ \_env state -> - let hsc_env' = (hsc_env state){ hsc_plugins = dyn, hsc_static_plugins = static } - in return (state{hsc_env = hsc_env'}, ()) - -setModLocation :: ModLocation -> CompPipeline () -setModLocation loc = P $ \_env state -> - return (state{ maybe_loc = Just loc }, ()) - -setForeignOs :: [FilePath] -> CompPipeline () -setForeignOs os = P $ \_env state -> - return (state{ foreign_os = os }, ()) - -setIface :: ModIface -> CompPipeline () -setIface iface = P $ \_env state -> return (state{ iface = Just iface }, ()) - -setLinkable :: Linkable -> CompPipeline () -setLinkable l = P $ \_env state -> return (state{ maybe_linkable = Just l }, ()) diff --git a/compiler/GHC/Driver/Pipeline/Phases.hs b/compiler/GHC/Driver/Pipeline/Phases.hs new file mode 100644 --- /dev/null +++ b/compiler/GHC/Driver/Pipeline/Phases.hs @@ -0,0 +1,52 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE RankNTypes #-} + +module GHC.Driver.Pipeline.Phases (TPhase(..), PhaseHook(..)) where + +import GHC.Prelude +import GHC.Driver.Pipeline.Monad +import GHC.Driver.Env.Types +import GHC.Driver.Session +import GHC.Driver.CmdLine +import GHC.Types.SourceFile +import GHC.Unit.Module.ModSummary +import GHC.Unit.Module.Status +import GHC.Tc.Types ( FrontendResult ) +import GHC.Types.Error +import GHC.Driver.Errors.Types +import GHC.Fingerprint.Type +import GHC.Unit.Module.Location ( ModLocation ) +import GHC.Unit.Module.Name ( ModuleName ) +import GHC.Unit.Module.ModIface +import GHC.Linker.Types +import GHC.Driver.Phases + +-- Typed Pipeline Phases +-- MP: TODO: We need to refine the arguments to each of these phases so recompilation +-- can be smarter. For example, rather than passing a whole HscEnv, just pass the options +-- which each phase depends on, then recompilation checking can decide to only rerun each +-- phase if the inputs have been modified. +data TPhase res where + T_Unlit :: PipeEnv -> HscEnv -> FilePath -> TPhase FilePath + T_FileArgs :: HscEnv -> FilePath -> TPhase (DynFlags, [Warn]) + T_Cpp :: PipeEnv -> HscEnv -> FilePath -> TPhase FilePath + T_HsPp :: PipeEnv -> HscEnv -> FilePath -> FilePath -> TPhase FilePath + T_HscRecomp :: PipeEnv -> HscEnv -> FilePath -> HscSource -> TPhase (HscEnv, ModSummary, HscRecompStatus) + T_Hsc :: HscEnv -> ModSummary -> TPhase (FrontendResult, Messages GhcMessage) + T_HscPostTc :: HscEnv -> ModSummary + -> FrontendResult + -> Messages GhcMessage + -> Maybe Fingerprint + -> TPhase HscBackendAction + T_HscBackend :: PipeEnv -> HscEnv -> ModuleName -> HscSource -> ModLocation -> HscBackendAction -> TPhase ([FilePath], ModIface, Maybe Linkable, FilePath) + T_CmmCpp :: PipeEnv -> HscEnv -> FilePath -> TPhase FilePath + T_Cmm :: PipeEnv -> HscEnv -> FilePath -> TPhase ([FilePath], FilePath) + T_Cc :: Phase -> PipeEnv -> HscEnv -> FilePath -> TPhase FilePath + T_As :: Bool -> PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> TPhase FilePath + T_LlvmOpt :: PipeEnv -> HscEnv -> FilePath -> TPhase FilePath + T_LlvmLlc :: PipeEnv -> HscEnv -> FilePath -> TPhase FilePath + T_LlvmMangle :: PipeEnv -> HscEnv -> FilePath -> TPhase FilePath + T_MergeForeign :: PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> [FilePath] -> TPhase FilePath + +-- | A wrapper around the interpretation function for phases. +data PhaseHook = PhaseHook (forall a . TPhase a -> IO a) diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs --- a/compiler/GHC/Driver/Session.hs +++ b/compiler/GHC/Driver/Session.hs @@ -250,6 +250,7 @@ import GHC.Types.Basic ( Alignment, alignmentOf, IntWithInf, treatZeroAsInf ) import qualified GHC.Types.FieldLabel as FieldLabel import GHC.Data.FastString +import GHC.Utils.TmpFs import GHC.Utils.Fingerprint import GHC.Utils.Outputable import GHC.Settings @@ -546,11 +547,11 @@ -- used to query the appropriate fields -- (outputFile/dynOutputFile, ways, etc.) - -- | This is set by 'GHC.Driver.Pipeline.runPipeline' + -- | This is set by 'GHC.Driver.Pipeline.setDumpPrefix' -- or 'ghc.GHCi.UI.runStmt' based on where its output is going. dumpPrefix :: Maybe FilePath, - -- | Override the 'dumpPrefix' set by 'GHC.Driver.Pipeline.runPipeline' + -- | Override the 'dumpPrefix' set by 'GHC.Driver.Pipeline.setDumpPrefix' -- or 'ghc.GHCi.UI.runStmt'. -- Set by @-ddump-file-prefix@ dumpPrefixForce :: Maybe FilePath, @@ -792,8 +793,8 @@ toolDir dflags = fileSettings_toolDir $ fileSettings dflags topDir :: DynFlags -> FilePath topDir dflags = fileSettings_topDir $ fileSettings dflags -tmpDir :: DynFlags -> String -tmpDir dflags = fileSettings_tmpDir $ fileSettings dflags +tmpDir :: DynFlags -> TempDir +tmpDir dflags = TempDir (fileSettings_tmpDir $ fileSettings dflags) extraGccViaCFlags :: DynFlags -> [String] extraGccViaCFlags dflags = toolSettings_extraGccViaCFlags $ toolSettings dflags globalPackageDatabasePath :: DynFlags -> FilePath @@ -1399,7 +1400,7 @@ LangExt.InstanceSigs, LangExt.KindSignatures, LangExt.MultiParamTypeClasses, - LangExt.RecordPuns, + LangExt.NamedFieldPuns, LangExt.NamedWildCards, LangExt.NumericUnderscores, LangExt.PolyKinds, @@ -3595,7 +3596,7 @@ flagSpec "MultiWayIf" LangExt.MultiWayIf, flagSpec "NumericUnderscores" LangExt.NumericUnderscores, flagSpec "NPlusKPatterns" LangExt.NPlusKPatterns, - flagSpec "NamedFieldPuns" LangExt.RecordPuns, + flagSpec "NamedFieldPuns" LangExt.NamedFieldPuns, flagSpec "NamedWildCards" LangExt.NamedWildCards, flagSpec "NegativeLiterals" LangExt.NegativeLiterals, flagSpec "HexFloatLiterals" LangExt.HexFloatLiterals, @@ -3628,7 +3629,7 @@ flagSpec "RebindableSyntax" LangExt.RebindableSyntax, flagSpec "OverloadedRecordDot" LangExt.OverloadedRecordDot, flagSpec "OverloadedRecordUpdate" LangExt.OverloadedRecordUpdate, - depFlagSpec' "RecordPuns" LangExt.RecordPuns + depFlagSpec' "RecordPuns" LangExt.NamedFieldPuns (deprecatedForExtension "NamedFieldPuns"), flagSpec "RecordWildCards" LangExt.RecordWildCards, flagSpec "RecursiveDo" LangExt.RecursiveDo, @@ -4053,7 +4054,7 @@ in dflags3 removeWayDyn :: DynP () -removeWayDyn = upd (\dfs -> dfs { targetWays_ = Set.filter (WayDyn /=) (targetWays_ dfs) }) +removeWayDyn = upd (\dfs -> dfs { targetWays_ = removeWay WayDyn (targetWays_ dfs) }) -------------------------- setGeneralFlag, unSetGeneralFlag :: GeneralFlag -> DynP () @@ -4470,7 +4471,7 @@ -- correctly. They need to reference data in the Haskell -- objects, but can't without -fPIC. See -- https://gitlab.haskell.org/ghc/ghc/wikis/commentary/position-independent-code - | gopt Opt_PIC dflags || WayDyn `Set.member` ways dflags -> + | gopt Opt_PIC dflags || ways dflags `hasWay` WayDyn -> ["-fPIC", "-U__PIC__", "-D__PIC__"] -- gcc may be configured to have PIC on by default, let's be -- explicit here, see #15847 @@ -4653,7 +4654,7 @@ , not (gopt Opt_ExternalInterpreter dflags) , hostIsProfiled , backendProducesObject (backend dflags) - , WayProf `Set.notMember` ways dflags + , ways dflags `hasNotWay` WayProf = loop dflags{targetWays_ = addWay WayProf (targetWays_ dflags)} "Enabling -prof, because -fobject-code is enabled and GHCi is profiled" diff --git a/compiler/GHC/Hs/Expr.hs b/compiler/GHC/Hs/Expr.hs --- a/compiler/GHC/Hs/Expr.hs +++ b/compiler/GHC/Hs/Expr.hs @@ -1050,13 +1050,15 @@ -} -- See Note [Rebindable syntax and HsExpansion] just above. -data HsExpansion a b - = HsExpanded a b +data HsExpansion orig expanded + = HsExpanded orig expanded deriving Data -- | Just print the original expression (the @a@). instance (Outputable a, Outputable b) => Outputable (HsExpansion a b) where - ppr (HsExpanded a b) = ifPprDebug (vcat [ppr a, ppr b]) (ppr a) + ppr (HsExpanded orig expanded) + = ifPprDebug (vcat [ppr orig, braces (text "Expansion:" <+> ppr expanded)]) + (ppr orig) {- diff --git a/compiler/GHC/HsToCore/Errors/Ppr.hs b/compiler/GHC/HsToCore/Errors/Ppr.hs --- a/compiler/GHC/HsToCore/Errors/Ppr.hs +++ b/compiler/GHC/HsToCore/Errors/Ppr.hs @@ -163,8 +163,6 @@ ThWarningAndDeprecationPragmas decl -> mkMsg "WARNING and DEPRECATION pragmas" $ text "Pragma for declaration of" <+> ppr decl - ThDefaultDeclarations decl - -> mkMsg "Default declarations" (ppr decl) ThSplicesWithinDeclBrackets -> mkMsg "Splices within declaration brackets" empty where @@ -282,7 +280,9 @@ -> case (bounds, usingNegLiterals) of (Just (MinBound minB, MaxBound _), NotUsingNegLiterals) | minB == -i -- Note [Suggest NegativeLiterals] - , i > 0 -> [SuggestExtension LangExt.NegativeLiterals] + , i > 0 + -> [ suggestExtensionWithInfo (text "If you are trying to write a large negative literal") + LangExt.NegativeLiterals ] _ -> noHints DsRedundantBangPatterns{} -> noHints DsOverlappingPatterns{} -> noHints diff --git a/compiler/GHC/HsToCore/Errors/Types.hs b/compiler/GHC/HsToCore/Errors/Types.hs --- a/compiler/GHC/HsToCore/Errors/Types.hs +++ b/compiler/GHC/HsToCore/Errors/Types.hs @@ -191,7 +191,6 @@ | ThNegativeOverloadedPatterns !(Pat GhcRn) | ThHaddockDocumentation | ThWarningAndDeprecationPragmas [LIdP GhcRn] - | ThDefaultDeclarations !(DefaultDecl GhcRn) | ThSplicesWithinDeclBrackets data NegLiteralExtEnabled diff --git a/compiler/GHC/Parser/Errors/Basic.hs b/compiler/GHC/Parser/Errors/Basic.hs new file mode 100644 --- /dev/null +++ b/compiler/GHC/Parser/Errors/Basic.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE LambdaCase #-} +module GHC.Parser.Errors.Basic where + +import GHC.Utils.Outputable ( SDoc, text ) + +-- | The operator symbol in the 'PsOperatorWhitespaceExtConflictMessage' diagnostic. +data OperatorWhitespaceSymbol + = OperatorWhitespaceSymbol_PrefixPercent + | OperatorWhitespaceSymbol_PrefixDollar + | OperatorWhitespaceSymbol_PrefixDollarDollar + +pprOperatorWhitespaceSymbol :: OperatorWhitespaceSymbol -> SDoc +pprOperatorWhitespaceSymbol = \case + OperatorWhitespaceSymbol_PrefixPercent -> text "%" + OperatorWhitespaceSymbol_PrefixDollar -> text "$" + OperatorWhitespaceSymbol_PrefixDollarDollar -> text "$$" + +-- | The operator occurrence type in the 'PsOperatorWhitespaceMessage' diagnostic. +data OperatorWhitespaceOccurrence + = OperatorWhitespaceOccurrence_Prefix + | OperatorWhitespaceOccurrence_Suffix + | OperatorWhitespaceOccurrence_TightInfix diff --git a/compiler/GHC/Parser/Errors/Ppr.hs b/compiler/GHC/Parser/Errors/Ppr.hs --- a/compiler/GHC/Parser/Errors/Ppr.hs +++ b/compiler/GHC/Parser/Errors/Ppr.hs @@ -1,4 +1,5 @@ {-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE FlexibleContexts #-} @@ -9,6 +10,7 @@ import GHC.Prelude import GHC.Driver.Flags +import GHC.Parser.Errors.Basic import GHC.Parser.Errors.Types import GHC.Parser.Types import GHC.Types.Basic @@ -57,23 +59,20 @@ TransLayout_Pipe -> "`|' at the same depth as implicit layout block" ) PsWarnOperatorWhitespaceExtConflict sym - -> let mk_prefix_msg operator_symbol extension_name syntax_meaning = - text "The prefix use of a" <+> quotes (text operator_symbol) + -> let mk_prefix_msg extension_name syntax_meaning = + text "The prefix use of a" <+> quotes (pprOperatorWhitespaceSymbol sym) <+> text "would denote" <+> text syntax_meaning $$ nest 2 (text "were the" <+> text extension_name <+> text "extension enabled.") - $$ text "Suggested fix: add whitespace after the" - <+> quotes (text operator_symbol) <> char '.' in mkSimpleDecorated $ case sym of - OperatorWhitespaceSymbol_PrefixPercent -> mk_prefix_msg "%" "LinearTypes" "a multiplicity annotation" - OperatorWhitespaceSymbol_PrefixDollar -> mk_prefix_msg "$" "TemplateHaskell" "an untyped splice" - OperatorWhitespaceSymbol_PrefixDollarDollar -> mk_prefix_msg "$$" "TemplateHaskell" "a typed splice" + OperatorWhitespaceSymbol_PrefixPercent -> mk_prefix_msg "LinearTypes" "a multiplicity annotation" + OperatorWhitespaceSymbol_PrefixDollar -> mk_prefix_msg "TemplateHaskell" "an untyped splice" + OperatorWhitespaceSymbol_PrefixDollarDollar -> mk_prefix_msg "TemplateHaskell" "a typed splice" PsWarnOperatorWhitespace sym occ_type -> let mk_msg occ_type_str = text "The" <+> text occ_type_str <+> text "use of a" <+> quotes (ftext sym) <+> text "might be repurposed as special syntax" $$ nest 2 (text "by a future language extension.") - $$ text "Suggested fix: add whitespace around it." in mkSimpleDecorated $ case occ_type of OperatorWhitespaceOccurrence_Prefix -> mk_msg "prefix" @@ -83,9 +82,6 @@ -> mkSimpleDecorated $ text "Found binding occurrence of" <+> quotes (text "*") <+> text "yet StarIsType is enabled." - $$ text "NB. To use (or export) this operator in" - <+> text "modules with StarIsType," - $$ text " including the definition module, you must qualify it." PsWarnStarIsType -> mkSimpleDecorated $ text "Using" <+> quotes (text "*") @@ -93,17 +89,12 @@ <+> quotes (text "Data.Kind.Type") $$ text "relies on the StarIsType extension, which will become" $$ text "deprecated in the future." - $$ text "Suggested fix: use" <+> quotes (text "Type") - <+> text "from" <+> quotes (text "Data.Kind") <+> text "instead." PsWarnUnrecognisedPragma -> mkSimpleDecorated $ text "Unrecognised pragma" PsWarnImportPreQualified -> mkSimpleDecorated $ text "Found" <+> quotes (text "qualified") <+> text "in prepositive position" - $$ text "Suggested fix: place " <+> quotes (text "qualified") - <+> text "after the module name instead." - $$ text "To allow this, enable language extension 'ImportQualifiedPost'" PsErrLexer err kind -> mkSimpleDecorated $ hcat @@ -161,55 +152,41 @@ -> mkSimpleDecorated $ text "Expected a hyphen" PsErrSpaceInSCC -> mkSimpleDecorated $ text "Spaces are not allowed in SCCs" - PsErrEmptyDoubleQuotes th_on - -> mkSimpleDecorated $ if th_on then vcat (msg ++ th_msg) else vcat msg + PsErrEmptyDoubleQuotes _th_on + -> mkSimpleDecorated $ vcat msg where msg = [ text "Parser error on `''`" , text "Character literals may not be empty" ] - th_msg = [ text "Or perhaps you intended to use quotation syntax of TemplateHaskell," - , text "but the type variable or constructor is missing" - ] - PsErrLambdaCase - -> mkSimpleDecorated $ text "Illegal lambda-case (use LambdaCase)" + -> mkSimpleDecorated $ text "Illegal lambda-case" PsErrEmptyLambda -> mkSimpleDecorated $ text "A lambda requires at least one parameter" PsErrLinearFunction - -> mkSimpleDecorated $ text "Enable LinearTypes to allow linear functions" + -> mkSimpleDecorated $ text "Illegal use of linear functions" PsErrOverloadedRecordUpdateNotEnabled - -> mkSimpleDecorated $ text "OverloadedRecordUpdate needs to be enabled" + -> mkSimpleDecorated $ text "Illegal overloaded record update" PsErrMultiWayIf - -> mkSimpleDecorated $ text "Multi-way if-expressions need MultiWayIf turned on" + -> mkSimpleDecorated $ text "Illegal multi-way if-expression" PsErrNumUnderscores reason -> mkSimpleDecorated $ text $ case reason of - NumUnderscore_Integral -> "Use NumericUnderscores to allow underscores in integer literals" - NumUnderscore_Float -> "Use NumericUnderscores to allow underscores in floating literals" + NumUnderscore_Integral -> "Illegal underscores in integer literals" + NumUnderscore_Float -> "Illegal underscores in floating literals" PsErrIllegalBangPattern e - -> mkSimpleDecorated $ text "Illegal bang-pattern (use BangPatterns):" $$ ppr e + -> mkSimpleDecorated $ text "Illegal bang-pattern" $$ ppr e PsErrOverloadedRecordDotInvalid -> mkSimpleDecorated $ text "Use of OverloadedRecordDot '.' not valid ('.' isn't allowed when constructing records or in record patterns)" PsErrIllegalPatSynExport - -> mkSimpleDecorated $ text "Illegal export form (use PatternSynonyms to enable)" + -> mkSimpleDecorated $ text "Illegal export form" PsErrOverloadedRecordUpdateNoQualifiedFields -> mkSimpleDecorated $ text "Fields cannot be qualified when OverloadedRecordUpdate is enabled" PsErrExplicitForall is_unicode - -> mkSimpleDecorated $ vcat - [ text "Illegal symbol" <+> quotes (forallSym is_unicode) <+> text "in type" - , text "Perhaps you intended to use RankNTypes or a similar language" - , text "extension to enable explicit-forall syntax:" <+> - forallSym is_unicode <+> text ". " - ] - where - forallSym True = text "∀" - forallSym False = text "forall" + -> mkSimpleDecorated $ text "Illegal symbol" <+> quotes (forallSym is_unicode) <+> text "in type" PsErrIllegalQualifiedDo qdoDoc - -> mkSimpleDecorated $ vcat - [ text "Illegal qualified" <+> quotes qdoDoc <+> text "block" - , text "Perhaps you intended to use QualifiedDo" - ] + -> mkSimpleDecorated $ + text "Illegal qualified" <+> quotes qdoDoc <+> text "block" PsErrQualifiedDoInCmd m -> mkSimpleDecorated $ hang (text "Parse error in command:") 2 $ @@ -245,7 +222,7 @@ ] PsErrIllegalExplicitNamespace -> mkSimpleDecorated $ - text "Illegal keyword 'type' (use ExplicitNamespaces to enable)" + text "Illegal keyword 'type'" PsErrUnallowedPragma prag -> mkSimpleDecorated $ @@ -255,7 +232,6 @@ -> mkSimpleDecorated $ text "Found" <+> quotes (text "qualified") <+> text "in postpositive position. " - $$ text "To allow this, enable language extension 'ImportQualifiedPost'" PsErrImportQualifiedTwice -> mkSimpleDecorated $ text "Multiple occurrences of 'qualified'" PsErrIllegalImportBundleForm @@ -374,15 +350,10 @@ -> mkSimpleDecorated $ text "Malformed head of type or class declaration:" <+> ppr ty PsErrIllegalWhereInDataDecl - -> mkSimpleDecorated $ - vcat - [ text "Illegal keyword 'where' in data declaration" - , text "Perhaps you intended to use GADTs or a similar language" - , text "extension to enable syntax: data T where" - ] + -> mkSimpleDecorated $ text "Illegal keyword 'where' in data declaration" PsErrIllegalDataTypeContext c -> mkSimpleDecorated $ - text "Illegal datatype context (use DatatypeContexts):" + text "Illegal datatype context:" <+> pprLHsContext (Just c) PsErrPrimStringInvalidChar -> mkSimpleDecorated $ text "primitive string literal must contain only characters <= \'\\xFF\'" @@ -395,7 +366,6 @@ -> mkSimpleDecorated $ text "Unexpected semi-colons in conditional:" $$ nest 4 expr - $$ text "Perhaps you meant to use DoAndIfThenElse?" where pprOptSemi True = semi pprOptSemi False = empty @@ -406,7 +376,6 @@ -> mkSimpleDecorated $ text "Unexpected semi-colons in conditional:" $$ nest 4 expr - $$ text "Perhaps you meant to use DoAndIfThenElse?" where pprOptSemi True = semi pprOptSemi False = empty @@ -439,7 +408,7 @@ -> mkSimpleDecorated $ text "Inferred type variables are not allowed here" PsErrIllegalTraditionalRecordSyntax s -> mkSimpleDecorated $ - text "Illegal record syntax (use TraditionalRecordSyntax):" <+> s + text "Illegal record syntax:" <+> s PsErrParseErrorInCmd s -> mkSimpleDecorated $ hang (text "Parse error in command:") 2 s PsErrInPat s details @@ -463,43 +432,14 @@ in mkSimpleDecorated $ msg <+> body PsErrParseRightOpSectionInPat infixOcc s -> mkSimpleDecorated $ parse_error_in_pat <+> pprInfixOcc infixOcc <> ppr s - PsErrIllegalRoleName role nearby + PsErrIllegalRoleName role _nearby -> mkSimpleDecorated $ text "Illegal role name" <+> quotes (ppr role) - $$ case nearby of - [] -> empty - [r] -> text "Perhaps you meant" <+> quotes (ppr r) - -- will this last case ever happen?? - _ -> hang (text "Perhaps you meant one of these:") - 2 (pprWithCommas (quotes . ppr) nearby) PsErrInvalidTypeSignature lhs -> mkSimpleDecorated $ text "Invalid type signature:" <+> ppr lhs <+> text ":: ..." - $$ text hint - where - hint | foreign_RDR `looks_like` lhs - = "Perhaps you meant to use ForeignFunctionInterface?" - | default_RDR `looks_like` lhs - = "Perhaps you meant to use DefaultSignatures?" - | pattern_RDR `looks_like` lhs - = "Perhaps you meant to use PatternSynonyms?" - | otherwise - = "Should be of form :: " - - -- A common error is to forget the ForeignFunctionInterface flag - -- so check for that, and suggest. cf #3805 - -- Sadly 'foreign import' still barfs 'parse error' because - -- 'import' is a keyword - -- looks_like :: RdrName -> LHsExpr GhcPsErr -> Bool -- AZ - looks_like s (L _ (HsVar _ (L _ v))) = v == s - looks_like s (L _ (HsApp _ lhs _)) = looks_like s lhs - looks_like _ _ = False - - foreign_RDR = mkUnqual varName (fsLit "foreign") - default_RDR = mkUnqual varName (fsLit "default") - pattern_RDR = mkUnqual varName (fsLit "pattern") PsErrUnexpectedTypeInDecl t what tc tparms equals_or_where -> mkSimpleDecorated $ vcat [ text "Unexpected type" <+> quotes (ppr t) @@ -532,7 +472,7 @@ diagnosticReason = \case PsUnknownMessage m -> diagnosticReason m - PsHeaderMessage _ -> ErrorWithoutFlag + PsHeaderMessage m -> psHeaderMessageReason m PsWarnTab{} -> WarningWithFlag Opt_WarnTabs PsWarnTransitionalLayout{} -> WarningWithFlag Opt_WarnAlternativeLayoutRuleTransitional PsWarnOperatorWhitespaceExtConflict{} -> WarningWithFlag Opt_WarnOperatorWhitespaceExtConflict @@ -646,25 +586,27 @@ PsHeaderMessage m -> psHeaderMessageHints m PsWarnTab{} -> [SuggestUseSpaces] PsWarnTransitionalLayout{} -> noHints - PsWarnOperatorWhitespaceExtConflict{} -> noHints - PsWarnOperatorWhitespace{} -> noHints + PsWarnOperatorWhitespaceExtConflict sym -> [SuggestUseWhitespaceAfter sym] + PsWarnOperatorWhitespace sym occ -> [SuggestUseWhitespaceAround (unpackFS sym) occ] PsWarnHaddockInvalidPos -> noHints PsWarnHaddockIgnoreMulti -> noHints - PsWarnStarBinder -> noHints - PsWarnStarIsType -> noHints + PsWarnStarBinder -> [SuggestQualifyStarOperator] + PsWarnStarIsType -> [SuggestUseTypeFromDataKind] PsWarnUnrecognisedPragma -> noHints - PsWarnImportPreQualified -> noHints + PsWarnImportPreQualified -> [ SuggestQualifiedAfterModuleName + , suggestExtension LangExt.ImportQualifiedPost] PsErrLexer{} -> noHints PsErrCmmLexer -> noHints PsErrCmmParser{} -> noHints PsErrParse token PsErrParseDetails{..} -> case token of "" -> [] - "$" | not ped_th_enabled -> [SuggestExtension LangExt.TemplateHaskell] -- #7396 - "<-" | ped_mdo_in_last_100 -> [SuggestExtension LangExt.RecursiveDo] + "$" | not ped_th_enabled -> [suggestExtension LangExt.TemplateHaskell] -- #7396 + "$$" | not ped_th_enabled -> [suggestExtension LangExt.TemplateHaskell] -- #20157 + "<-" | ped_mdo_in_last_100 -> [suggestExtension LangExt.RecursiveDo] | otherwise -> [SuggestMissingDo] "=" | ped_do_in_last_100 -> [SuggestLetInDo] -- #15849 _ | not ped_pat_syn_enabled - , ped_pattern_parsed -> [SuggestExtension LangExt.PatternSynonyms] -- #12429 + , ped_pattern_parsed -> [suggestExtension LangExt.PatternSynonyms] -- #12429 | otherwise -> [] PsErrTypeAppWithoutSpace{} -> noHints PsErrLazyPatWithoutSpace{} -> noHints @@ -672,19 +614,23 @@ PsErrInvalidInfixHole -> noHints PsErrExpectedHyphen -> noHints PsErrSpaceInSCC -> noHints - PsErrEmptyDoubleQuotes{} -> noHints - PsErrLambdaCase{} -> noHints + PsErrEmptyDoubleQuotes th_on | th_on -> [SuggestThQuotationSyntax] + | otherwise -> noHints + PsErrLambdaCase{} -> [suggestExtension LangExt.LambdaCase] PsErrEmptyLambda{} -> noHints - PsErrLinearFunction{} -> noHints - PsErrMultiWayIf{} -> noHints - PsErrOverloadedRecordUpdateNotEnabled{} -> noHints - PsErrNumUnderscores{} -> noHints - PsErrIllegalBangPattern{} -> noHints + PsErrLinearFunction{} -> [suggestExtension LangExt.LinearTypes] + PsErrMultiWayIf{} -> [suggestExtension LangExt.MultiWayIf] + PsErrOverloadedRecordUpdateNotEnabled{} -> [suggestExtension LangExt.OverloadedRecordUpdate] + PsErrNumUnderscores{} -> [suggestExtension LangExt.NumericUnderscores] + PsErrIllegalBangPattern{} -> [suggestExtension LangExt.BangPatterns] PsErrOverloadedRecordDotInvalid{} -> noHints - PsErrIllegalPatSynExport -> noHints + PsErrIllegalPatSynExport -> [suggestExtension LangExt.PatternSynonyms] PsErrOverloadedRecordUpdateNoQualifiedFields -> noHints - PsErrExplicitForall{} -> noHints - PsErrIllegalQualifiedDo{} -> noHints + PsErrExplicitForall is_unicode -> + let info = text "or a similar language extension to enable explicit-forall syntax:" <+> + forallSym is_unicode <+> text ". " + in [ suggestExtensionWithInfo info LangExt.RankNTypes ] + PsErrIllegalQualifiedDo{} -> [suggestExtension LangExt.QualifiedDo] PsErrQualifiedDoInCmd{} -> noHints PsErrRecordSyntaxInPatSynDecl{} -> noHints PsErrEmptyWhereInPatSynDecl{} -> noHints @@ -692,9 +638,9 @@ PsErrNoSingleWhereBindInPatSynDecl{} -> noHints PsErrDeclSpliceNotAtTopLevel{} -> noHints PsErrMultipleNamesInStandaloneKindSignature{} -> noHints - PsErrIllegalExplicitNamespace -> noHints + PsErrIllegalExplicitNamespace -> [suggestExtension LangExt.ExplicitNamespaces] PsErrUnallowedPragma{} -> noHints - PsErrImportPostQualified -> noHints + PsErrImportPostQualified -> [suggestExtension LangExt.ImportQualifiedPost] PsErrImportQualifiedTwice -> noHints PsErrIllegalImportBundleForm -> noHints PsErrInvalidRuleActivationMarker -> noHints @@ -737,20 +683,22 @@ PsErrIfInFunAppExpr{} -> suggestParensAndBlockArgs PsErrProcInFunAppExpr{} -> suggestParensAndBlockArgs PsErrMalformedTyOrClDecl{} -> noHints - PsErrIllegalWhereInDataDecl -> noHints - PsErrIllegalDataTypeContext{} -> noHints + PsErrIllegalWhereInDataDecl -> + [ suggestExtensionWithInfo (text "or a similar language extension to enable syntax: data T where") + LangExt.GADTs ] + PsErrIllegalDataTypeContext{} -> [suggestExtension LangExt.DatatypeContexts] PsErrPrimStringInvalidChar -> noHints PsErrSuffixAT -> noHints PsErrPrecedenceOutOfRange{} -> noHints - PsErrSemiColonsInCondExpr{} -> noHints - PsErrSemiColonsInCondCmd{} -> noHints + PsErrSemiColonsInCondExpr{} -> [suggestExtension LangExt.DoAndIfThenElse] + PsErrSemiColonsInCondCmd{} -> [suggestExtension LangExt.DoAndIfThenElse] PsErrAtInPatPos -> noHints PsErrParseErrorOnInput{} -> noHints PsErrMalformedDecl{} -> noHints PsErrUnexpectedTypeAppInDecl{} -> noHints PsErrNotADataCon{} -> noHints PsErrInferredTypeVarNotAllowed -> noHints - PsErrIllegalTraditionalRecordSyntax{} -> noHints + PsErrIllegalTraditionalRecordSyntax{} -> [suggestExtension LangExt.TraditionalRecordSyntax] PsErrParseErrorInCmd{} -> noHints PsErrInPat _ details -> case details of PEIP_RecPattern args YesPatIsRecursive ctx @@ -759,12 +707,33 @@ PEIP_OtherPatDetails ctx -> catMaybes [sug_missingdo ctx] _ -> [] where - sug_recdo = Just (SuggestExtension LangExt.RecursiveDo) + sug_recdo = Just (suggestExtension LangExt.RecursiveDo) sug_missingdo (ParseContext _ YesIncompleteDoBlock) = Just SuggestMissingDo sug_missingdo _ = Nothing PsErrParseRightOpSectionInPat{} -> noHints - PsErrIllegalRoleName{} -> noHints - PsErrInvalidTypeSignature{} -> noHints + PsErrIllegalRoleName _ nearby -> [SuggestRoles nearby] + PsErrInvalidTypeSignature lhs -> + if | foreign_RDR `looks_like` lhs + -> [suggestExtension LangExt.ForeignFunctionInterface] + | default_RDR `looks_like` lhs + -> [suggestExtension LangExt.DefaultSignatures] + | pattern_RDR `looks_like` lhs + -> [suggestExtension LangExt.PatternSynonyms] + | otherwise + -> [SuggestTypeSignatureForm] + where + -- A common error is to forget the ForeignFunctionInterface flag + -- so check for that, and suggest. cf #3805 + -- Sadly 'foreign import' still barfs 'parse error' because + -- 'import' is a keyword + -- looks_like :: RdrName -> LHsExpr GhcPsErr -> Bool -- AZ + looks_like s (L _ (HsVar _ (L _ v))) = v == s + looks_like s (L _ (HsApp _ lhs _)) = looks_like s lhs + looks_like _ _ = False + + foreign_RDR = mkUnqual varName (fsLit "foreign") + default_RDR = mkUnqual varName (fsLit "default") + pattern_RDR = mkUnqual varName (fsLit "pattern") PsErrUnexpectedTypeInDecl{} -> noHints PsErrInvalidPackageName{} -> noHints PsErrIllegalGadtRecordMultiplicity{} -> noHints @@ -785,7 +754,20 @@ , text "Expecting whitespace-separated list of GHC options." , text " E.g. {-# OPTIONS_GHC -Wall -O2 #-}" , text ("Input was: " ++ show str) ] + PsErrUnknownOptionsPragma flag + -> mkSimpleDecorated $ text "Unknown flag in {-# OPTIONS_GHC #-} pragma:" <+> text flag +psHeaderMessageReason :: PsHeaderMessage -> DiagnosticReason +psHeaderMessageReason = \case + PsErrParseLanguagePragma + -> ErrorWithoutFlag + PsErrUnsupportedExt{} + -> ErrorWithoutFlag + PsErrParseOptionsPragma{} + -> ErrorWithoutFlag + PsErrUnknownOptionsPragma{} + -> ErrorWithoutFlag + psHeaderMessageHints :: PsHeaderMessage -> [GhcHint] psHeaderMessageHints = \case PsErrParseLanguagePragma @@ -802,11 +784,13 @@ suggestions = fuzzyMatch unsup supported PsErrParseOptionsPragma{} -> noHints + PsErrUnknownOptionsPragma{} + -> noHints suggestParensAndBlockArgs :: [GhcHint] suggestParensAndBlockArgs = - [SuggestParentheses, SuggestExtension LangExt.BlockArguments] + [SuggestParentheses, suggestExtension LangExt.BlockArguments] pp_unexpected_fun_app :: Outputable a => SDoc -> a -> SDoc pp_unexpected_fun_app e a = @@ -815,3 +799,7 @@ parse_error_in_pat :: SDoc parse_error_in_pat = text "Parse error in pattern:" + +forallSym :: Bool -> SDoc +forallSym True = text "∀" +forallSym False = text "forall" diff --git a/compiler/GHC/Parser/Errors/Types.hs b/compiler/GHC/Parser/Errors/Types.hs --- a/compiler/GHC/Parser/Errors/Types.hs +++ b/compiler/GHC/Parser/Errors/Types.hs @@ -10,6 +10,7 @@ import GHC.Data.FastString import GHC.Hs import GHC.Parser.Types +import GHC.Parser.Errors.Basic import GHC.Types.Error import GHC.Types.Name.Occurrence (OccName) import GHC.Types.Name.Reader @@ -39,7 +40,25 @@ | PsErrUnsupportedExt !String ![String] | PsErrParseOptionsPragma !String + {-| PsErrUnsupportedOptionsPragma is an error that occurs when an unknown + OPTIONS_GHC pragma is supplied is found. + Example(s): + {-# OPTIONS_GHC foo #-} + + Test case(s): + + tests/safeHaskell/flags/SafeFlags28 + tests/safeHaskell/flags/SafeFlags19 + tests/safeHaskell/flags/SafeFlags29 + tests/parser/should_fail/T19923c + tests/parser/should_fail/T19923b + tests/parser/should_fail/readFail044 + tests/driver/T2499 + -} + | PsErrUnknownOptionsPragma !String + + data PsMessage = {-| An \"unknown\" message from the parser. This type constructor allows @@ -510,18 +529,6 @@ | CmmUnknownCConv !String -- ^ Unknown calling convention | CmmUnrecognisedSafety !String -- ^ Unrecognised safety | CmmUnrecognisedHint !String -- ^ Unrecognised hint - --- | The operator symbol in the 'PsOperatorWhitespaceExtConflictMessage' diagnostic. -data OperatorWhitespaceSymbol - = OperatorWhitespaceSymbol_PrefixPercent - | OperatorWhitespaceSymbol_PrefixDollar - | OperatorWhitespaceSymbol_PrefixDollarDollar - --- | The operator occurrence type in the 'PsOperatorWhitespaceMessage' diagnostic. -data OperatorWhitespaceOccurrence - = OperatorWhitespaceOccurrence_Prefix - | OperatorWhitespaceOccurrence_Suffix - | OperatorWhitespaceOccurrence_TightInfix data TransLayoutReason = TransLayout_Where -- ^ "`where' clause at the same depth as implicit layout block" diff --git a/compiler/GHC/Parser/Header.hs b/compiler/GHC/Parser/Header.hs --- a/compiler/GHC/Parser/Header.hs +++ b/compiler/GHC/Parser/Header.hs @@ -33,13 +33,12 @@ import GHC.Unit.Module import GHC.Builtin.Names -import GHC.Types.Error hiding ( getErrorMessages, getWarningMessages, getMessages ) +import GHC.Types.Error import GHC.Types.SrcLoc import GHC.Types.SourceError import GHC.Types.SourceText import GHC.Utils.Misc -import GHC.Utils.Outputable as Outputable import GHC.Utils.Panic import GHC.Utils.Monad import GHC.Utils.Error @@ -75,6 +74,7 @@ (Messages PsMessage) ([(Maybe FastString, Located ModuleName)], [(Maybe FastString, Located ModuleName)], + Bool, -- Is GHC.Prim imported or not Located ModuleName)) -- ^ The source imports and normal imports (with optional package -- names from -XPackageImports), and the module name. @@ -83,9 +83,9 @@ case unP parseHeader (initParserState popts buf loc) of PFailed pst -> -- assuming we're not logging warnings here as per below - return $ Left $ getErrorMessages pst + return $ Left $ getPsErrorMessages pst POk pst rdr_module -> fmap Right $ do - let (_warns, errs) = getMessages pst + let (_warns, errs) = getPsMessages pst -- don't log warnings: they'll be reported when we parse the file -- for real. See #2500. if not (isEmptyMessages errs) @@ -100,17 +100,19 @@ (src_idecls, ord_idecls) = partition ((== IsBoot) . ideclSource . unLoc) imps -- GHC.Prim doesn't exist physically, so don't go looking for it. - ordinary_imps = filter ((/= moduleName gHC_PRIM) . unLoc - . ideclName . unLoc) - ord_idecls + (ordinary_imps, ghc_prim_import) + = partition ((/= moduleName gHC_PRIM) . unLoc + . ideclName . unLoc) + ord_idecls implicit_imports = mkPrelImports (unLoc mod) main_loc implicit_prelude imps convImport (L _ i) = (fmap sl_fs (ideclPkgQual i), ideclName i) in - return (map convImport src_idecls, - map convImport (implicit_imports ++ ordinary_imps), - mod) + return (map convImport src_idecls + , map convImport (implicit_imports ++ ordinary_imps) + , not (null ghc_prim_import) + , mod) mkPrelImports :: ModuleName -> SrcSpan -- Attribute the "import Prelude" to this location @@ -419,9 +421,7 @@ liftIO $ throwErrors $ foldMap (singleMessage . mkMsg) flags where mkMsg (L loc flag) = mkPlainErrorMsgEnvelope loc $ - GhcDriverMessage $ DriverUnknownMessage $ mkPlainError noHints $ - text "unknown flag in {-# OPTIONS_GHC #-} pragma:" <+> - text flag + GhcPsMessage $ PsHeaderMessage $ PsErrUnknownOptionsPragma flag ----------------------------------------------------------------------------- diff --git a/compiler/GHC/Platform/Ways.hs b/compiler/GHC/Platform/Ways.hs --- a/compiler/GHC/Platform/Ways.hs +++ b/compiler/GHC/Platform/Ways.hs @@ -24,7 +24,9 @@ ( Way(..) , Ways , hasWay + , hasNotWay , addWay + , removeWay , allowed_combination , wayGeneralFlags , wayUnsetGeneralFlags @@ -72,13 +74,21 @@ type Ways = Set Way --- | Test if a ways is enabled +-- | Test if a way is enabled hasWay :: Ways -> Way -> Bool hasWay ws w = Set.member w ws +-- | Test if a way is not enabled +hasNotWay :: Ways -> Way -> Bool +hasNotWay ws w = Set.notMember w ws + -- | Add a way addWay :: Way -> Ways -> Ways addWay = Set.insert + +-- | Remove a way +removeWay :: Way -> Ways -> Ways +removeWay = Set.delete -- | Check if a combination of ways is allowed allowed_combination :: Ways -> Bool diff --git a/compiler/GHC/Tc/Errors/Ppr.hs b/compiler/GHC/Tc/Errors/Ppr.hs --- a/compiler/GHC/Tc/Errors/Ppr.hs +++ b/compiler/GHC/Tc/Errors/Ppr.hs @@ -13,11 +13,14 @@ import GHC.Core.Type import GHC.Tc.Errors.Types import GHC.Types.Error +import GHC.Types.Name.Reader (pprNameProvenance) import GHC.Types.Var.Env (emptyTidyEnv) import GHC.Driver.Flags import GHC.Hs import GHC.Utils.Outputable import GHC.Unit.State (pprWithUnitState, UnitState) +import qualified GHC.LanguageExtensions as LangExt +import qualified Data.List.NonEmpty as NE instance Diagnostic TcRnMessage where @@ -49,6 +52,49 @@ -> mkDecorated [text "Use of plugins makes the module unsafe"] TcRnModMissingRealSrcSpan mod -> mkDecorated [text "Module does not have a RealSrcSpan:" <+> ppr mod] + TcRnShadowedName occ provenance + -> let shadowed_locs = case provenance of + ShadowedNameProvenanceLocal n -> [text "bound at" <+> ppr n] + ShadowedNameProvenanceGlobal gres -> map pprNameProvenance gres + in mkSimpleDecorated $ + sep [text "This binding for" <+> quotes (ppr occ) + <+> text "shadows the existing binding" <> plural shadowed_locs, + nest 2 (vcat shadowed_locs)] + TcRnDuplicateWarningDecls d rdr_name + -> mkSimpleDecorated $ + vcat [text "Multiple warning declarations for" <+> quotes (ppr rdr_name), + text "also at " <+> ppr (getLocA d)] + TcRnSimplifierTooManyIterations limit wc + -> mkSimpleDecorated $ + hang (text "solveWanteds: too many iterations" + <+> parens (text "limit =" <+> ppr limit)) + 2 (text "Unsolved:" <+> ppr wc) + TcRnIllegalPatSynDecl rdrname + -> mkSimpleDecorated $ + hang (text "Illegal pattern synonym declaration for" <+> quotes (ppr rdrname)) + 2 (text "Pattern synonym declarations are only valid at top level") + TcRnLinearPatSyn ty + -> mkSimpleDecorated $ + hang (text "Pattern synonyms do not support linear fields (GHC #18806):") 2 (ppr ty) + TcRnEmptyRecordUpdate + -> mkSimpleDecorated $ text "Empty record update" + TcRnIllegalFieldPunning fld + -> mkSimpleDecorated $ text "Illegal use of punning for field" <+> quotes (ppr fld) + TcRnIllegalWildcardsInRecord fld_part + -> mkSimpleDecorated $ text "Illegal `..' in record" <+> pprRecordFieldPart fld_part + TcRnDuplicateFieldName fld_part dups + -> mkSimpleDecorated $ + hsep [text "duplicate field name", + quotes (ppr (NE.head dups)), + text "in record", pprRecordFieldPart fld_part] + TcRnIllegalViewPattern pat + -> mkSimpleDecorated $ vcat [text "Illegal view pattern: " <+> ppr pat] + TcRnCharLiteralOutOfRange c + -> mkSimpleDecorated $ text "character literal out of range: '\\" <> char c <> char '\'' + TcRnIllegalWildcardsInConstructor con + -> mkSimpleDecorated $ + vcat [ text "Illegal `..' notation for constructor" <+> quotes (ppr con) + , nest 2 (text "The constructor has no labelled fields") ] diagnosticReason = \case TcRnUnknownMessage m @@ -72,6 +118,30 @@ -> WarningWithoutFlag TcRnModMissingRealSrcSpan{} -> ErrorWithoutFlag + TcRnShadowedName{} + -> WarningWithFlag Opt_WarnNameShadowing + TcRnDuplicateWarningDecls{} + -> ErrorWithoutFlag + TcRnSimplifierTooManyIterations{} + -> ErrorWithoutFlag + TcRnIllegalPatSynDecl{} + -> ErrorWithoutFlag + TcRnLinearPatSyn{} + -> ErrorWithoutFlag + TcRnEmptyRecordUpdate + -> ErrorWithoutFlag + TcRnIllegalFieldPunning{} + -> ErrorWithoutFlag + TcRnIllegalWildcardsInRecord{} + -> ErrorWithoutFlag + TcRnDuplicateFieldName{} + -> ErrorWithoutFlag + TcRnIllegalViewPattern{} + -> ErrorWithoutFlag + TcRnCharLiteralOutOfRange{} + -> ErrorWithoutFlag + TcRnIllegalWildcardsInConstructor{} + -> ErrorWithoutFlag diagnosticHints = \case TcRnUnknownMessage m @@ -95,6 +165,30 @@ -> noHints TcRnModMissingRealSrcSpan{} -> noHints + TcRnShadowedName{} + -> noHints + TcRnDuplicateWarningDecls{} + -> noHints + TcRnSimplifierTooManyIterations{} + -> [SuggestIncreaseSimplifierIterations] + TcRnIllegalPatSynDecl{} + -> noHints + TcRnLinearPatSyn{} + -> noHints + TcRnEmptyRecordUpdate{} + -> noHints + TcRnIllegalFieldPunning{} + -> [suggestExtension LangExt.NamedFieldPuns] + TcRnIllegalWildcardsInRecord{} + -> [suggestExtension LangExt.RecordWildCards] + TcRnDuplicateFieldName{} + -> noHints + TcRnIllegalViewPattern{} + -> [suggestExtension LangExt.ViewPatterns] + TcRnCharLiteralOutOfRange{} + -> noHints + TcRnIllegalWildcardsInConstructor{} + -> noHints messageWithInfoDiagnosticMessage :: UnitState -> ErrInfo @@ -159,3 +253,10 @@ LevityCheckInValidClass -> empty in formatLevPolyErr ty $$ extra + + +pprRecordFieldPart :: RecordFieldPart -> SDoc +pprRecordFieldPart = \case + RecordFieldConstructor{} -> text "construction" + RecordFieldPattern{} -> text "pattern" + RecordFieldUpdate -> text "update" diff --git a/compiler/GHC/Tc/Errors/Types.hs b/compiler/GHC/Tc/Errors/Types.hs --- a/compiler/GHC/Tc/Errors/Types.hs +++ b/compiler/GHC/Tc/Errors/Types.hs @@ -6,18 +6,27 @@ , TcRnMessageDetailed(..) , ErrInfo(..) , LevityCheckProvenance(..) + , ShadowedNameProvenance(..) + , RecordFieldPart(..) ) where +import GHC.Prelude + import GHC.Hs +import GHC.Tc.Types.Constraint import GHC.Types.Error -import GHC.Types.Name (Name) +import GHC.Types.Name (Name, OccName) import GHC.Types.Name.Reader +import GHC.Types.SrcLoc import GHC.Unit.Types (Module) import GHC.Utils.Outputable -import Data.Typeable import GHC.Core.Type (Type, Var) import GHC.Unit.State (UnitState) +import GHC.Types.Basic +import qualified Data.List.NonEmpty as NE +import Data.Typeable + {- Note [Migrating TcM Messages] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -163,6 +172,167 @@ -} TcRnModMissingRealSrcSpan :: Module -> TcRnMessage + + {-| TcRnShadowedName is a warning (controlled by -Wname-shadowing) that occurs whenever + an inner-scope value has the same name as an outer-scope value, i.e. the inner + value shadows the outer one. This can catch typographical errors that turn into + hard-to-find bugs. The warning is suppressed for names beginning with an underscore. + + Examples(s): + f = ... let f = id in ... f ... -- NOT OK, 'f' is shadowed + f x = do { _ignore <- this; _ignore <- that; return (the other) } -- suppressed via underscore + + Test cases: typecheck/should_compile/T10971a + rename/should_compile/rn039 + rename/should_compile/rn064 + rename/should_compile/T1972 + rename/should_fail/T2723 + rename/should_compile/T3262 + driver/werror + -} + TcRnShadowedName :: OccName -> ShadowedNameProvenance -> TcRnMessage + + {-| TcRnDuplicateWarningDecls is an error that occurs whenever + a warning is declared twice. + + Examples(s): + None. + + Test cases: + None. + -} + TcRnDuplicateWarningDecls :: !(LocatedN RdrName) -> !RdrName -> TcRnMessage + + {-| TcRnDuplicateWarningDecls is an error that occurs whenever + the constraint solver in the simplifier hits the iterations' limit. + + Examples(s): + None. + + Test cases: + None. + -} + TcRnSimplifierTooManyIterations :: !IntWithInf + -- ^ The limit. + -> WantedConstraints + -> TcRnMessage + + {-| TcRnIllegalPatSynDecl is an error that occurs whenever + there is an illegal pattern synonym declaration. + + Examples(s): + + varWithLocalPatSyn x = case x of + P -> () + where + pattern P = () -- not valid, it can't be local, it must be defined at top-level. + + Test cases: patsyn/should_fail/local + -} + TcRnIllegalPatSynDecl :: !(LIdP GhcPs) -> TcRnMessage + + {-| TcRnLinearPatSyn is an error that occurs whenever a pattern + synonym signature uses a field that is not unrestricted. + + Example(s): None + + Test cases: linear/should_fail/LinearPatSyn2 + -} + TcRnLinearPatSyn :: !Type -> TcRnMessage + + {-| TcRnEmptyRecordUpdate is an error that occurs whenever + a record is updated without specifying any field. + + Examples(s): + + $(deriveJSON defaultOptions{} ''Bad) -- not ok, no fields selected for update of defaultOptions + + Test cases: th/T12788 + -} + TcRnEmptyRecordUpdate :: TcRnMessage + + {-| TcRnIllegalFieldPunning is an error that occurs whenever + field punning is used without the 'NamedFieldPuns' extension enabled. + + Examples(s): + + data Foo = Foo { a :: Int } + + foo :: Foo -> Int + foo Foo{a} = a -- Not ok, punning used without extension. + + Test cases: parser/should_fail/RecordDotSyntaxFail12 + -} + TcRnIllegalFieldPunning :: !(Located RdrName) -> TcRnMessage + + {-| TcRnIllegalWildcardsInRecord is an error that occurs whenever + wildcards (..) are used in a record without the relevant + extension being enabled. + + Examples(s): + + data Foo = Foo { a :: Int } + + foo :: Foo -> Int + foo Foo{..} = a -- Not ok, wildcards used without extension. + + Test cases: parser/should_fail/RecordWildCardsFail + -} + TcRnIllegalWildcardsInRecord :: !RecordFieldPart -> TcRnMessage + + {-| TcRnDuplicateFieldName is an error that occurs whenever + there are duplicate field names in a record. + + Examples(s): None. + + Test cases: None. + -} + TcRnDuplicateFieldName :: !RecordFieldPart -> NE.NonEmpty RdrName -> TcRnMessage + + {-| TcRnIllegalViewPattern is an error that occurs whenever + the ViewPatterns syntax is used but the ViewPatterns language extension + is not enabled. + + Examples(s): + data Foo = Foo { a :: Int } + + foo :: Foo -> Int + foo (a -> l) = l -- not OK, the 'ViewPattern' extension is not enabled. + + Test cases: parser/should_fail/ViewPatternsFail + -} + TcRnIllegalViewPattern :: !(Pat GhcPs) -> TcRnMessage + + {-| TcRnCharLiteralOutOfRange is an error that occurs whenever + a character is out of range. + + Examples(s): None + + Test cases: None + -} + TcRnCharLiteralOutOfRange :: !Char -> TcRnMessage + + {-| TcRnIllegalWildcardsInConstructor is an error that occurs whenever + the record wildcards '..' are used inside a constructor without labeled fields. + + Examples(s): None + + Test cases: None + -} + TcRnIllegalWildcardsInConstructor :: !Name -> TcRnMessage + +-- | Which parts of a record field are affected by a particular error or warning. +data RecordFieldPart + = RecordFieldConstructor !Name + | RecordFieldPattern !Name + | RecordFieldUpdate + +-- | Where a shadowed name comes from +data ShadowedNameProvenance + = ShadowedNameProvenanceLocal !SrcLoc + -- ^ The shadowed name is local to the module + | ShadowedNameProvenanceGlobal [GlobalRdrElt] + -- ^ The shadowed name is global, typically imported from elsewhere. -- | Where the levity checking for the input type originated data LevityCheckProvenance diff --git a/compiler/GHC/Tc/Solver/Types.hs b/compiler/GHC/Tc/Solver/Types.hs --- a/compiler/GHC/Tc/Solver/Types.hs +++ b/compiler/GHC/Tc/Solver/Types.hs @@ -138,7 +138,7 @@ = Nothing | Just {} <- isCallStackPred cls tys - , OccurrenceOf {} <- ctLocOrigin loc + , isPushCallStackOrigin (ctLocOrigin loc) = Nothing -- See Note [Solving CallStack constraints] | otherwise @@ -219,13 +219,15 @@ Note [Solving CallStack constraints] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +See also Note [Overview of implicit CallStacks] in GHc.Tc.Types.Evidence. + Suppose f :: HasCallStack => blah. Then * Each call to 'f' gives rise to [W] s1 :: IP "callStack" CallStack -- CtOrigin = OccurrenceOf f with a CtOrigin that says "OccurrenceOf f". Remember that HasCallStack is just shorthand for - IP "callStack CallStack + IP "callStack" CallStack See Note [Overview of implicit CallStacks] in GHC.Tc.Types.Evidence * We cannonicalise such constraints, in GHC.Tc.Solver.Canonical.canClassNC, by @@ -239,7 +241,7 @@ So we must be careful /not/ to solve 's1' from the Givens. Again, we ensure this by arranging that findDict always misses when looking -up souch constraints. +up such constraints. -} {- ********************************************************************* diff --git a/compiler/GHC/Tc/Types/Evidence.hs b/compiler/GHC/Tc/Types/Evidence.hs --- a/compiler/GHC/Tc/Types/Evidence.hs +++ b/compiler/GHC/Tc/Types/Evidence.hs @@ -77,7 +77,6 @@ import GHC.Types.Var.Env import GHC.Types.Var.Set import GHC.Core.Predicate -import GHC.Types.Name import GHC.Data.Pair import GHC.Types.Basic @@ -90,6 +89,8 @@ import GHC.Utils.Outputable import GHC.Data.Bag +import GHC.Data.FastString + import qualified Data.Data as Data import GHC.Types.SrcLoc import Data.IORef( IORef ) @@ -654,9 +655,14 @@ data EvCallStack -- See Note [Overview of implicit CallStacks] = EvCsEmpty - | EvCsPushCall Name RealSrcSpan EvExpr - -- ^ @EvCsPushCall name loc stk@ represents a call to @name@, occurring at - -- @loc@, in a calling context @stk@. + | EvCsPushCall + FastString -- Usually the name of the function being called + -- but can also be "the literal 42" + -- or "an if-then-else expression", etc + RealSrcSpan -- Location of the call + EvExpr -- Rest of the stack + -- ^ @EvCsPushCall origin loc stk@ represents a call from @origin@, + -- occurring at @loc@, in a calling context @stk@. deriving Data.Data {- @@ -740,7 +746,7 @@ Note [Overview of implicit CallStacks] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ (See https://gitlab.haskell.org/ghc/ghc/wikis/explicit-call-stack/implicit-locations) The goal of CallStack evidence terms is to reify locations @@ -753,9 +759,12 @@ Implicit parameters of type GHC.Stack.Types.CallStack (the name is not important) are solved in three steps: -1. Occurrences of CallStack IPs are solved directly from the given IP, - just like a regular IP. For example, the occurrence of `?stk` in +1. Explicit, user-written occurrences of `?stk :: CallStack` + which have IPOccOrigin, are solved directly from the given IP, + just like a regular IP; see GHC.Tc.Solver.Interact.interactDict. + For example, the occurrence of `?stk` in + error :: (?stk :: CallStack) => String -> a error s = raise (ErrorCall (s ++ prettyCallStack ?stk)) @@ -765,30 +774,42 @@ append the current call-site to it. For example, consider a call to the callstack-aware `error` above. - undefined :: (?stk :: CallStack) => a - undefined = error "undefined!" + foo :: (?stk :: CallStack) => a + foo = error "undefined!" Here we want to take the given `?stk` and append the current call-site, before passing it to `error`. In essence, we want to - rewrite `error "undefined!"` to + rewrite `foo "undefined!"` to - let ?stk = pushCallStack ?stk - in error "undefined!" + let ?stk = pushCallStack ?stk + in foo "undefined!" - We achieve this effect by emitting a NEW wanted + We achieve this as follows: - [W] d :: IP "stk" CallStack + * At a call of foo :: (?stk :: CallStack) => blah + we emit a Wanted + [W] d1 : IP "stk" CallStack + with CtOrigin = OccurrenceOf "foo" - from which we build the evidence term + * We /solve/ this constraint, in GHC.Tc.Solver.Canonical.canClassNC + by emitting a NEW Wanted + [W] d2 :: IP "stk" CallStack + with CtOrigin = IPOccOrigin - EvCsPushCall "error" (EvId d) + and solve d1 = EvCsPushCall "foo" (EvId d1) - that we use to solve the call to `error`. The new wanted `d` will - then be solved per rule (1), ie as a regular IP. + * The new Wanted, for `d2` will be solved per rule (1), ie as a regular IP. - (see GHC.Tc.Solver.Interact.interactDict) +3. We use the predicate isPushCallStackOrigin to identify whether we + want to do (1) solve directly, or (2) push and then solve directly. + Key point (see #19918): the CtOrigin where we want to push an item on the + call stack can include IfThenElseOrigin etc, when RebindableSyntax is + involved. See the defn of fun_orig in GHC.Tc.Gen.App.tcInstFun; it is + this CtOrigin that is pinned on the constraints generated by functions + in the "expansion" for rebindable syntax. c.f. GHC.Rename.Expr + Note [Handling overloaded and rebindable constructs] -3. We default any insoluble CallStacks to the empty CallStack. Suppose +4. We default any insoluble CallStacks to the empty CallStack. Suppose `undefined` did not request a CallStack, ie undefinedNoStk :: a @@ -1042,8 +1063,8 @@ instance Outputable EvCallStack where ppr EvCsEmpty = text "[]" - ppr (EvCsPushCall name loc tm) - = ppr (name,loc) <+> text ":" <+> ppr tm + ppr (EvCsPushCall orig loc tm) + = ppr (orig,loc) <+> text ":" <+> ppr tm instance Outputable EvTypeable where ppr (EvTypeableTyCon ts _) = text "TyCon" <+> ppr ts diff --git a/compiler/GHC/Tc/Types/Origin.hs b/compiler/GHC/Tc/Types/Origin.hs --- a/compiler/GHC/Tc/Types/Origin.hs +++ b/compiler/GHC/Tc/Types/Origin.hs @@ -18,11 +18,15 @@ -- CtOrigin CtOrigin(..), exprCtOrigin, lexprCtOrigin, matchesCtOrigin, grhssCtOrigin, isVisibleOrigin, toInvisibleOrigin, - pprCtOrigin, isGivenOrigin + pprCtOrigin, isGivenOrigin, + -- CtOrigin and CallStack + isPushCallStackOrigin, callStackOriginFS + ) where import GHC.Prelude +import GHC.Utils.Misc (HasCallStack) import GHC.Tc.Utils.TcType @@ -432,7 +436,6 @@ | MCompOrigin -- Arising from a monad comprehension | MCompPatOrigin (LPat GhcRn) -- Arising from a failable pattern in a -- monad comprehension - | IfOrigin -- Arising from an if statement | ProcOrigin -- Arising from a proc expression | AnnOrigin -- An annotation @@ -450,6 +453,7 @@ | TypeHoleOrigin OccName -- from a type hole (partial type signature) | PatCheckOrigin -- normalisation of a type during pattern-match checking | ListOrigin -- An overloaded list + | IfThenElseOrigin -- An if-then-else expression | BracketOrigin -- An overloaded quotation bracket | StaticOrigin -- A static form | Shouldn'tHappenOrigin String @@ -521,7 +525,7 @@ exprCtOrigin (ExplicitTuple {}) = Shouldn'tHappenOrigin "explicit tuple" exprCtOrigin ExplicitSum{} = Shouldn'tHappenOrigin "explicit sum" exprCtOrigin (HsCase _ _ matches) = matchesCtOrigin matches -exprCtOrigin (HsIf {}) = Shouldn'tHappenOrigin "if expression" +exprCtOrigin (HsIf {}) = IfThenElseOrigin exprCtOrigin (HsMultiIf _ rhs) = lGRHSCtOrigin rhs exprCtOrigin (HsLet _ _ e) = lexprCtOrigin e exprCtOrigin (HsDo {}) = DoOrigin @@ -639,7 +643,7 @@ = ctoHerald <+> pprCtO simple_origin -- | Short one-liners -pprCtO :: CtOrigin -> SDoc +pprCtO :: HasCallStack => CtOrigin -> SDoc pprCtO (OccurrenceOf name) = hsep [text "a use of", quotes (ppr name)] pprCtO (OccurrenceOfRecSel name) = hsep [text "a use of", quotes (ppr name)] pprCtO AppOrigin = text "an application" @@ -651,7 +655,6 @@ pprCtO PatSigOrigin = text "a pattern type signature" pprCtO PatOrigin = text "a pattern" pprCtO ViewPatOrigin = text "a view pattern" -pprCtO IfOrigin = text "an if expression" pprCtO (LiteralOrigin lit) = hsep [text "the literal", quotes (ppr lit)] pprCtO (ArithSeqOrigin seq) = hsep [text "the arithmetic sequence", quotes (ppr seq)] pprCtO SectionOrigin = text "an operator section" @@ -672,8 +675,47 @@ pprCtO (TypeHoleOrigin occ) = text "a use of wildcard" <+> quotes (ppr occ) pprCtO PatCheckOrigin = text "a pattern-match completeness check" pprCtO ListOrigin = text "an overloaded list" +pprCtO IfThenElseOrigin = text "an if-then-else expression" pprCtO StaticOrigin = text "a static form" pprCtO NonLinearPatternOrigin = text "a non-linear pattern" pprCtO (UsageEnvironmentOf x) = hsep [text "multiplicity of", quotes (ppr x)] pprCtO BracketOrigin = text "a quotation bracket" -pprCtO _ = panic "pprCtOrigin" + +-- These ones are handled by pprCtOrigin, but we nevertheless sometimes +-- get here via callStackOriginFS, when doing ambiguity checks +-- A bit silly, but no great harm +pprCtO (GivenOrigin {}) = text "a given constraint" +pprCtO (SpecPragOrigin {}) = text "a SPECIALISE pragma" +pprCtO (FunDepOrigin1 {}) = text "a functional dependency" +pprCtO (FunDepOrigin2 {}) = text "a functional dependency" +pprCtO (TypeEqOrigin {}) = text "a type equality" +pprCtO (KindEqOrigin {}) = text "a kind equality" +pprCtO (DerivOriginDC {}) = text "a deriving clause" +pprCtO (DerivOriginCoerce {}) = text "a derived method" +pprCtO (DoPatOrigin {}) = text "a do statement" +pprCtO (MCompPatOrigin {}) = text "a monad comprehension pattern" +pprCtO (Shouldn'tHappenOrigin note) = text note +pprCtO (ProvCtxtOrigin {}) = text "a provided constraint" +pprCtO (InstProvidedOrigin {}) = text "a provided constraint" +pprCtO (CycleBreakerOrigin orig) = pprCtO orig + +{- ********************************************************************* +* * + CallStacks and CtOrigin + + See Note [Overview of implicit CallStacks] in GHC.Tc.Types.Evidence +* * +********************************************************************* -} + +isPushCallStackOrigin :: CtOrigin -> Bool +-- Do we want to solve this IP constraint directly (return False) +-- or push the call site (return True) +-- See Note [Overview of implicit CallStacks] in GHc.Tc.Types.Evidence +isPushCallStackOrigin (IPOccOrigin {}) = False +isPushCallStackOrigin _ = True + + +callStackOriginFS :: CtOrigin -> FastString +-- This is the string that appears in the CallStack +callStackOriginFS (OccurrenceOf fun) = occNameFS (getOccName fun) +callStackOriginFS orig = mkFastString (showSDocUnsafe (pprCtO orig)) diff --git a/compiler/GHC/Tc/Utils/TcType.hs b/compiler/GHC/Tc/Utils/TcType.hs --- a/compiler/GHC/Tc/Utils/TcType.hs +++ b/compiler/GHC/Tc/Utils/TcType.hs @@ -80,7 +80,7 @@ isSigmaTy, isRhoTy, isRhoExpTy, isOverloadedTy, isFloatingTy, isDoubleTy, isFloatTy, isIntTy, isWordTy, isStringTy, isIntegerTy, isNaturalTy, - isBoolTy, isUnitTy, isCharTy, isCallStackTy, isCallStackPred, + isBoolTy, isUnitTy, isCharTy, isTauTy, isTauTyCon, tcIsTyVarTy, tcIsForAllTy, isPredTy, isTyVarClassPred, checkValidClsArgs, hasTyVarHead, @@ -228,7 +228,6 @@ import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Utils.Panic.Plain -import GHC.Data.FastString import GHC.Utils.Error( Validity(..), isValid ) import qualified GHC.LanguageExtensions as LangExt @@ -2119,26 +2118,6 @@ = case tcSplitTyConApp_maybe ty of Just (tc, [arg_ty]) -> tc == listTyCon && isCharTy arg_ty _ -> False - --- | Is a type a 'CallStack'? -isCallStackTy :: Type -> Bool -isCallStackTy ty - | Just tc <- tyConAppTyCon_maybe ty - = tc `hasKey` callStackTyConKey - | otherwise - = False - --- | Is a 'PredType' a 'CallStack' implicit parameter? --- --- If so, return the name of the parameter. -isCallStackPred :: Class -> [Type] -> Maybe FastString -isCallStackPred cls tys - | [ty1, ty2] <- tys - , isIPClass cls - , isCallStackTy ty2 - = isStrLitTy ty1 - | otherwise - = Nothing is_tc :: Unique -> Type -> Bool -- Newtypes are opaque to this diff --git a/compiler/GHC/Types/Error.hs b/compiler/GHC/Types/Error.hs --- a/compiler/GHC/Types/Error.hs +++ b/compiler/GHC/Types/Error.hs @@ -33,6 +33,13 @@ -- * Hints and refactoring actions , GhcHint (..) + , LanguageExtensionHint(..) + , suggestExtension + , suggestExtensionWithInfo + , suggestExtensions + , suggestExtensionsWithInfo + , suggestAnyExtension + , suggestAnyExtensionWithInfo , noHints -- * Rendering Messages diff --git a/compiler/GHC/Types/Hint.hs b/compiler/GHC/Types/Hint.hs --- a/compiler/GHC/Types/Hint.hs +++ b/compiler/GHC/Types/Hint.hs @@ -1,21 +1,77 @@ {-# LANGUAGE ExistentialQuantification #-} module GHC.Types.Hint ( - GhcHint(..), - InstantiationSuggestion(..) + GhcHint(..) + , InstantiationSuggestion(..) + , LanguageExtensionHint(..) + , suggestExtension + , suggestExtensionWithInfo + , suggestExtensions + , suggestExtensionsWithInfo + , suggestAnyExtension + , suggestAnyExtensionWithInfo ) where +import GHC.Prelude + import GHC.Utils.Outputable import qualified GHC.LanguageExtensions as LangExt import Data.Typeable import GHC.Unit.Module (ModuleName, Module) import GHC.Hs.Extension (GhcTc) -import GHC.Types.Var (Var) +import GHC.Core.Coercion import GHC.Types.Basic (Activation, RuleName) +import GHC.Parser.Errors.Basic import {-# SOURCE #-} Language.Haskell.Syntax.Expr -- This {-# SOURCE #-} import should be removable once -- 'Language.Haskell.Syntax.Bind' no longer depends on 'GHC.Tc.Types.Evidence'. + +data LanguageExtensionHint + = -- | Suggest to enable the input extension. If the input 'SDoc' + -- is not empty, it will contain some extra information about the + -- why the extension is required, but it's totally irrelevant/redundant + -- for IDEs and other tools. + SuggestSingleExtension !SDoc !LangExt.Extension + -- | Suggest to enable the input extensions. The list + -- is to be intended as /disjuctive/ i.e. the user is + -- suggested to enable /any/ of the extensions listed. If + -- the input 'SDoc' is not empty, it will contain some extra + -- information about the why the extensions are required, but + -- it's totally irrelevant/redundant for IDEs and other tools. + | SuggestAnyExtension !SDoc [LangExt.Extension] + -- | Suggest to enable the input extensions. The list + -- is to be intended as /conjunctive/ i.e. the user is + -- suggested to enable /all/ the extensions listed. If + -- the input 'SDoc' is not empty, it will contain some extra + -- information about the why the extensions are required, but + -- it's totally irrelevant/redundant for IDEs and other tools. + | SuggestExtensions !SDoc [LangExt.Extension] + +-- | Suggests a single extension without extra user info. +suggestExtension :: LangExt.Extension -> GhcHint +suggestExtension ext = SuggestExtension (SuggestSingleExtension empty ext) + +-- | Like 'suggestExtension' but allows supplying extra info for the user. +suggestExtensionWithInfo :: SDoc -> LangExt.Extension -> GhcHint +suggestExtensionWithInfo extraInfo ext = SuggestExtension (SuggestSingleExtension extraInfo ext) + +-- | Suggests to enable /every/ extension in the list. +suggestExtensions :: [LangExt.Extension] -> GhcHint +suggestExtensions exts = SuggestExtension (SuggestExtensions empty exts) + +-- | Like 'suggestExtensions' but allows supplying extra info for the user. +suggestExtensionsWithInfo :: SDoc -> [LangExt.Extension] -> GhcHint +suggestExtensionsWithInfo extraInfo exts = SuggestExtension (SuggestExtensions extraInfo exts) + +-- | Suggests to enable /any/ extension in the list. +suggestAnyExtension :: [LangExt.Extension] -> GhcHint +suggestAnyExtension exts = SuggestExtension (SuggestAnyExtension empty exts) + +-- | Like 'suggestAnyExtension' but allows supplying extra info for the user. +suggestAnyExtensionWithInfo :: SDoc -> [LangExt.Extension] -> GhcHint +suggestAnyExtensionWithInfo extraInfo exts = SuggestExtension (SuggestAnyExtension extraInfo exts) + -- | A type for hints emitted by GHC. -- A /hint/ suggests a possible way to deal with a particular warning or error. data GhcHint @@ -36,7 +92,7 @@ parser/should_fail/T18251e, ... (and many more) -} - | SuggestExtension !LangExt.Extension + | SuggestExtension !LanguageExtensionHint {-| Suggests that a monadic code block is probably missing a \"do\" keyword. Example: @@ -83,6 +139,25 @@ Test Case(s): None -} | SuggestUseSpaces + {-| Suggests adding a whitespace after the given symbol. + + Examples: None + Test Case(s): parser/should_compile/T18834a.hs + -} + | SuggestUseWhitespaceAfter !OperatorWhitespaceSymbol + {-| Suggests adding a whitespace around the given operator symbol, + as it might be repurposed as special syntax by a future language extension. + The second parameter is how such operator occurred, if in a prefix, suffix + or tight infix position. + + Triggered by: 'GHC.Parser.Errors.Types.PsWarnOperatorWhitespace'. + + Example: + h a b = a+b -- not OK, no spaces around '+'. + + Test Case(s): parser/should_compile/T18834b.hs + -} + | SuggestUseWhitespaceAround !String !OperatorWhitespaceOccurrence {-| Suggests wrapping an expression in parentheses Examples: None @@ -115,6 +190,63 @@ | SuggestAddInlineOrNoInlinePragma !Var !Activation | SuggestAddPhaseToCompetingRule !RuleName + {-| Suggests increasing the limit for the number of iterations in the simplifier. + + -} + | SuggestIncreaseSimplifierIterations + {-| Suggests to explicitly import 'Type' from the 'Data.Kind' module, because + using "*" to mean 'Data.Kind.Type' relies on the StarIsType extension, which + will become deprecated in the future. + + Triggered by: 'GHC.Parser.Errors.Types.PsWarnStarIsType' + Example: None + Test case(s): wcompat-warnings/WCompatWarningsOn.hs + + -} + | SuggestUseTypeFromDataKind + + {-| Suggests placing the 'qualified' keyword /after/ the module name. + + Triggered by: 'GHC.Parser.Errors.Types.PsWarnImportPreQualified' + Example: None + Test case(s): module/mod184.hs + + -} + | SuggestQualifiedAfterModuleName + + {-| Suggests using TemplateHaskell quotation syntax. + + Triggered by: 'GHC.Parser.Errors.Types.PsErrEmptyDoubleQuotes' only if TemplateHaskell + is enabled. + Example: None + Test case(s): parser/should_fail/T13450TH.hs + + -} + | SuggestThQuotationSyntax + + {-| Suggests alternative roles in case we found an illegal one. + + Triggered by: 'GHC.Parser.Errors.Types.PsErrIllegalRoleName' + Example: None + Test case(s): roles/should_fail/Roles7.hs + + -} + | SuggestRoles [Role] + + {-| Suggests qualifying the '*' operator in modules where StarIsType is enabled. + + Triggered by: 'GHC.Parser.Errors.Types.PsWarnStarBinder' + Test case(s): warnings/should_compile/StarBinder.hs + -} + | SuggestQualifyStarOperator + + {-| Suggests that a type signature should have form :: + in order to be accepted by GHC. + + Triggered by: 'GHC.Parser.Errors.Types.PsErrInvalidTypeSignature' + Test case(s): parser/should_fail/T3811 + -} + | SuggestTypeSignatureForm -- | An 'InstantiationSuggestion' for a '.hsig' file. This is generated -- by GHC in case of a 'DriverUnexpectedSignature' and suggests a way diff --git a/compiler/GHC/Types/Hint/Ppr.hs b/compiler/GHC/Types/Hint/Ppr.hs --- a/compiler/GHC/Types/Hint/Ppr.hs +++ b/compiler/GHC/Types/Hint/Ppr.hs @@ -9,22 +9,29 @@ import GHC.Prelude +import GHC.Parser.Errors.Basic import GHC.Types.Hint import GHC.Hs.Expr () -- instance Outputable import GHC.Types.Id import GHC.Utils.Outputable -import qualified GHC.LanguageExtensions as LangExt +import Data.List (intersperse) + instance Outputable GhcHint where ppr = \case UnknownHint m -> ppr m - SuggestExtension ext - -> case ext of - LangExt.NegativeLiterals - -> text "If you are trying to write a large negative literal, use NegativeLiterals" - _ -> text "Perhaps you intended to use" <+> ppr ext + SuggestExtension extHint + -> case extHint of + SuggestSingleExtension extraUserInfo ext -> + (text "Perhaps you intended to use" <+> ppr ext) $$ extraUserInfo + SuggestAnyExtension extraUserInfo exts -> + let header = text "Enable any of the following extensions:" + in header <+> hsep (intersperse (char ',') (map ppr exts)) $$ extraUserInfo + SuggestExtensions extraUserInfo exts -> + let header = text "Enable all of the following extensions:" + in header <+> hsep (intersperse (char ',') (map ppr exts)) $$ extraUserInfo SuggestMissingDo -> text "Possibly caused by a missing 'do'?" SuggestLetInDo @@ -46,6 +53,11 @@ text "replacing <" <> ppr pi_mod_name <> text "> as necessary." SuggestUseSpaces -> text "Please use spaces instead." + SuggestUseWhitespaceAfter sym + -> text "Add whitespace after the" + <+> quotes (pprOperatorWhitespaceSymbol sym) <> char '.' + SuggestUseWhitespaceAround sym _occurrence + -> text "Add whitespace around" <+> quotes (text sym) <> char '.' SuggestParentheses -> text "Use parentheses." SuggestIncreaseMaxPmCheckModels @@ -61,6 +73,31 @@ SuggestAddPhaseToCompetingRule bad_rule -> vcat [ text "Add phase [n] or [~n] to the competing rule" , whenPprDebug (ppr bad_rule) ] + SuggestIncreaseSimplifierIterations + -> text "Set limit with -fconstraint-solver-iterations=n; n=0 for no limit" + SuggestUseTypeFromDataKind + -> text "Use" <+> quotes (text "Type") + <+> text "from" <+> quotes (text "Data.Kind") <+> text "instead." + SuggestQualifiedAfterModuleName + -> text "Place" <+> quotes (text "qualified") + <+> text "after the module name." + SuggestThQuotationSyntax + -> vcat [ text "Perhaps you intended to use quotation syntax of TemplateHaskell," + , text "but the type variable or constructor is missing" + ] + SuggestRoles nearby + -> case nearby of + [] -> empty + [r] -> text "Perhaps you meant" <+> quotes (ppr r) + -- will this last case ever happen?? + _ -> hang (text "Perhaps you meant one of these:") + 2 (pprWithCommas (quotes . ppr) nearby) + SuggestQualifyStarOperator + -> text "To use (or export) this operator in" + <+> text "modules with StarIsType," + $$ text " including the definition module, you must qualify it." + SuggestTypeSignatureForm + -> text "A type signature should be of form :: " perhapsAsPat :: SDoc perhapsAsPat = text "Perhaps you meant an as-pattern, which must not be surrounded by whitespace" diff --git a/compiler/GHC/Types/Id/Make.hs b/compiler/GHC/Types/Id/Make.hs --- a/compiler/GHC/Types/Id/Make.hs +++ b/compiler/GHC/Types/Id/Make.hs @@ -696,7 +696,7 @@ = return NoDataConRep | otherwise - = do { wrap_args <- mapM newLocal wrap_arg_tys + = do { wrap_args <- mapM (newLocal (fsLit "conrep")) wrap_arg_tys ; wrap_body <- mk_rep_app (wrap_args `zip` dropList eq_spec unboxers) initial_wrap_app @@ -986,12 +986,17 @@ -} ------------------------- -newLocal :: Scaled Type -> UniqSM Var -newLocal (Scaled w ty) = do { uniq <- getUniqueM - ; return (mkSysLocalOrCoVar (fsLit "dt") uniq w ty) } - -- We should not have "OrCoVar" here, this is a bug (#17545) +-- | Conjure a fresh local binder. +newLocal :: FastString -- ^ a string which will form part of the 'Var'\'s name + -> Scaled Type -- ^ the type of the 'Var' + -> UniqSM Var +newLocal name_stem (Scaled w ty) = + do { uniq <- getUniqueM + ; return (mkSysLocalOrCoVar name_stem uniq w ty) } + -- We should not have "OrCoVar" here, this is a bug (#17545) + -- | Unpack/Strictness decisions from source module. -- -- This function should only ever be invoked for data constructor fields, and @@ -1072,14 +1077,14 @@ wrapCo co rep_ty (unbox_rep, box_rep) -- co :: arg_ty ~ rep_ty = (unboxer, boxer) where - unboxer arg_id = do { rep_id <- newLocal (Scaled (idMult arg_id) rep_ty) + unboxer arg_id = do { rep_id <- newLocal (fsLit "cowrap_unbx") (Scaled (idMult arg_id) rep_ty) ; (rep_ids, rep_fn) <- unbox_rep rep_id ; let co_bind = NonRec rep_id (Var arg_id `Cast` co) ; return (rep_ids, Let co_bind . rep_fn) } boxer = Boxer $ \ subst -> do { (rep_ids, rep_expr) <- case box_rep of - UnitBox -> do { rep_id <- newLocal (linear $ TcType.substTy subst rep_ty) + UnitBox -> do { rep_id <- newLocal (fsLit "cowrap_bx") (linear $ TcType.substTy subst rep_ty) ; return ([rep_id], Var rep_id) } Boxer boxer -> boxer subst ; let sco = substCoUnchecked subst co @@ -1112,7 +1117,7 @@ -- Note [Unpacking GADTs and existentials] ( rep_tys `zip` dataConRepStrictness con ,( \ arg_id -> - do { rep_ids <- mapM newLocal rep_tys + do { rep_ids <- mapM (newLocal (fsLit "unbx")) rep_tys ; let r_mult = idMult arg_id ; let rep_ids' = map (scaleIdBy r_mult) rep_ids ; let unbox_fn body @@ -1120,7 +1125,7 @@ (DataAlt con) rep_ids' body ; return (rep_ids, unbox_fn) } , Boxer $ \ subst -> - do { rep_ids <- mapM (newLocal . TcType.substScaledTyUnchecked subst) rep_tys + do { rep_ids <- mapM (newLocal (fsLit "bx") . TcType.substScaledTyUnchecked subst) rep_tys ; return (rep_ids, Var (dataConWorkId con) `mkTyApps` (substTysUnchecked subst tc_args) `mkVarApps` rep_ids ) } ) ) diff --git a/compiler/GHC/Types/Literal.hs b/compiler/GHC/Types/Literal.hs --- a/compiler/GHC/Types/Literal.hs +++ b/compiler/GHC/Types/Literal.hs @@ -42,6 +42,7 @@ , litNumWrap , litNumCoerce , litNumNarrow + , litNumBitSize , isMinBound , isMaxBound @@ -54,8 +55,8 @@ , isLitValue_maybe, isLitRubbish -- ** Coercions - , narrowInt8Lit, narrowInt16Lit, narrowInt32Lit - , narrowWord8Lit, narrowWord16Lit, narrowWord32Lit + , narrowInt8Lit, narrowInt16Lit, narrowInt32Lit, narrowInt64Lit + , narrowWord8Lit, narrowWord16Lit, narrowWord32Lit, narrowWord64Lit , extendIntLit, extendWordLit , charToIntLit, intToCharLit , floatToIntLit, intToFloatLit, doubleToIntLit, intToDoubleLit @@ -190,6 +191,22 @@ LitNumWord32 -> False LitNumWord64 -> False +-- | Number of bits +litNumBitSize :: Platform -> LitNumType -> Maybe Word +litNumBitSize platform nt = case nt of + LitNumInteger -> Nothing + LitNumNatural -> Nothing + LitNumInt -> Just (fromIntegral (platformWordSizeInBits platform)) + LitNumInt8 -> Just 8 + LitNumInt16 -> Just 16 + LitNumInt32 -> Just 32 + LitNumInt64 -> Just 64 + LitNumWord -> Just (fromIntegral (platformWordSizeInBits platform)) + LitNumWord8 -> Just 8 + LitNumWord16 -> Just 16 + LitNumWord32 -> Just 32 + LitNumWord64 -> Just 64 + instance Binary LitNumType where put_ bh numTyp = putByte bh (fromIntegral (fromEnum numTyp)) get bh = do @@ -652,14 +669,16 @@ narrowLit' nt' (LitNumber _ i) = LitNumber nt' (toInteger (fromInteger i :: a)) narrowLit' _ l = pprPanic "narrowLit" (ppr l) -narrowInt8Lit, narrowInt16Lit, narrowInt32Lit, - narrowWord8Lit, narrowWord16Lit, narrowWord32Lit :: Literal -> Literal +narrowInt8Lit, narrowInt16Lit, narrowInt32Lit, narrowInt64Lit, + narrowWord8Lit, narrowWord16Lit, narrowWord32Lit, narrowWord64Lit :: Literal -> Literal narrowInt8Lit = narrowLit' @Int8 LitNumInt8 narrowInt16Lit = narrowLit' @Int16 LitNumInt16 narrowInt32Lit = narrowLit' @Int32 LitNumInt32 +narrowInt64Lit = narrowLit' @Int64 LitNumInt64 narrowWord8Lit = narrowLit' @Word8 LitNumWord8 narrowWord16Lit = narrowLit' @Word16 LitNumWord16 narrowWord32Lit = narrowLit' @Word32 LitNumWord32 +narrowWord64Lit = narrowLit' @Word64 LitNumWord64 -- | Extend a fixed-width literal (e.g. 'Int16#') to a word-sized literal (e.g. -- 'Int#'). diff --git a/compiler/GHC/Unit/Finder.hs b/compiler/GHC/Unit/Finder.hs new file mode 100644 --- /dev/null +++ b/compiler/GHC/Unit/Finder.hs @@ -0,0 +1,655 @@ +{- +(c) The University of Glasgow, 2000-2006 + +-} + + +{-# LANGUAGE FlexibleContexts #-} + +-- | Module finder +module GHC.Unit.Finder ( + FindResult(..), + InstalledFindResult(..), + FinderOpts(..), + FinderCache, + initFinderCache, + flushFinderCaches, + findImportedModule, + findPluginModule, + findExactModule, + findHomeModule, + findExposedPackageModule, + mkHomeModLocation, + mkHomeModLocation2, + mkHiOnlyModLocation, + mkHiPath, + mkObjPath, + addHomeModuleToFinder, + uncacheModule, + mkStubPaths, + + findObjectLinkableMaybe, + findObjectLinkable, + + -- Hash cache + lookupFileCache + ) where + +import GHC.Prelude + +import GHC.Platform.Ways + +import GHC.Builtin.Names ( gHC_PRIM ) + +import GHC.Unit.Types +import GHC.Unit.Module +import GHC.Unit.Home +import GHC.Unit.State +import GHC.Unit.Finder.Types + +import GHC.Data.FastString +import GHC.Data.Maybe ( expectJust ) +import qualified GHC.Data.ShortText as ST + +import GHC.Utils.Misc +import GHC.Utils.Outputable as Outputable +import GHC.Utils.Panic + +import GHC.Linker.Types + +import GHC.Fingerprint +import Data.IORef +import System.Directory +import System.FilePath +import Control.Monad +import Data.Time +import qualified Data.Map as M + + +type FileExt = String -- Filename extension +type BaseName = String -- Basename of file + +-- ----------------------------------------------------------------------------- +-- The Finder + +-- The Finder provides a thin filesystem abstraction to the rest of +-- the compiler. For a given module, it can tell you where the +-- source, interface, and object files for that module live. + +-- It does *not* know which particular package a module lives in. Use +-- Packages.lookupModuleInAllUnits for that. + +-- ----------------------------------------------------------------------------- +-- The finder's cache + + +initFinderCache :: IO FinderCache +initFinderCache = FinderCache <$> newIORef emptyInstalledModuleEnv + <*> newIORef M.empty + +-- remove all the home modules from the cache; package modules are +-- assumed to not move around during a session; also flush the file hash +-- cache +flushFinderCaches :: FinderCache -> HomeUnit -> IO () +flushFinderCaches (FinderCache ref file_ref) home_unit = do + atomicModifyIORef' ref $ \fm -> (filterInstalledModuleEnv is_ext fm, ()) + atomicModifyIORef' file_ref $ \_ -> (M.empty, ()) + where + is_ext mod _ = not (isHomeInstalledModule home_unit mod) + +addToFinderCache :: FinderCache -> InstalledModule -> InstalledFindResult -> IO () +addToFinderCache (FinderCache ref _) key val = + atomicModifyIORef' ref $ \c -> (extendInstalledModuleEnv c key val, ()) + +removeFromFinderCache :: FinderCache -> InstalledModule -> IO () +removeFromFinderCache (FinderCache ref _) key = + atomicModifyIORef' ref $ \c -> (delInstalledModuleEnv c key, ()) + +lookupFinderCache :: FinderCache -> InstalledModule -> IO (Maybe InstalledFindResult) +lookupFinderCache (FinderCache ref _) key = do + c <- readIORef ref + return $! lookupInstalledModuleEnv c key + +lookupFileCache :: FinderCache -> FilePath -> IO Fingerprint +lookupFileCache (FinderCache _ ref) key = do + c <- readIORef ref + case M.lookup key c of + Nothing -> do + hash <- getFileHash key + atomicModifyIORef' ref $ \c -> (M.insert key hash c, ()) + return hash + Just fp -> return fp + +-- ----------------------------------------------------------------------------- +-- The three external entry points + +-- | Locations and information the finder cares about. +-- +-- Should be taken from 'DynFlags' via 'initFinderOpts'. +data FinderOpts = FinderOpts + { finder_importPaths :: [FilePath] + -- ^ Where are we allowed to look for Modules and Source files + , finder_lookupHomeInterfaces :: Bool + -- ^ When looking up a home module: + -- + -- * 'True': search interface files (e.g. in '-c' mode) + -- * 'False': search source files (e.g. in '--make' mode) + + , finder_bypassHiFileCheck :: Bool + -- ^ Don't check that an imported interface file actually exists + -- if it can only be at one location. The interface will be reported + -- as `InstalledFound` even if the file doesn't exist, so this is + -- only useful in specific cases (e.g. to generate dependencies + -- with `ghc -M`) + , finder_ways :: Ways + , finder_enableSuggestions :: Bool + -- ^ If we encounter unknown modules, should we suggest modules + -- that have a similar name. + , finder_hieDir :: Maybe FilePath + , finder_hieSuf :: String + , finder_hiDir :: Maybe FilePath + , finder_hiSuf :: String + , finder_objectDir :: Maybe FilePath + , finder_objectSuf :: String + , finder_stubDir :: Maybe FilePath + } + + +-- | Locate a module that was imported by the user. We have the +-- module's name, and possibly a package name. Without a package +-- name, this function will use the search path and the known exposed +-- packages to find the module, if a package is specified then only +-- that package is searched for the module. + +findImportedModule + :: FinderCache + -> FinderOpts + -> UnitState + -> HomeUnit + -> ModuleName + -> Maybe FastString + -> IO FindResult +findImportedModule fc fopts units home_unit mod_name mb_pkg = + case mb_pkg of + Nothing -> unqual_import + Just pkg | pkg == fsLit "this" -> home_import -- "this" is special + | otherwise -> pkg_import + where + home_import = findHomeModule fc fopts home_unit mod_name + + pkg_import = findExposedPackageModule fc fopts units mod_name mb_pkg + + unqual_import = home_import + `orIfNotFound` + findExposedPackageModule fc fopts units mod_name Nothing + +-- | Locate a plugin module requested by the user, for a compiler +-- plugin. This consults the same set of exposed packages as +-- 'findImportedModule', unless @-hide-all-plugin-packages@ or +-- @-plugin-package@ are specified. +findPluginModule :: FinderCache -> FinderOpts -> UnitState -> HomeUnit -> ModuleName -> IO FindResult +findPluginModule fc fopts units home_unit mod_name = + findHomeModule fc fopts home_unit mod_name + `orIfNotFound` + findExposedPluginPackageModule fc fopts units mod_name + +-- | Locate a specific 'Module'. The purpose of this function is to +-- create a 'ModLocation' for a given 'Module', that is to find out +-- where the files associated with this module live. It is used when +-- reading the interface for a module mentioned by another interface, +-- for example (a "system import"). + +findExactModule :: FinderCache -> FinderOpts -> UnitState -> HomeUnit -> InstalledModule -> IO InstalledFindResult +findExactModule fc fopts unit_state home_unit mod = do + if isHomeInstalledModule home_unit mod + then findInstalledHomeModule fc fopts home_unit (moduleName mod) + else findPackageModule fc unit_state fopts mod + +-- ----------------------------------------------------------------------------- +-- Helpers + +-- | Given a monadic actions @this@ and @or_this@, first execute +-- @this@. If the returned 'FindResult' is successful, return +-- it; otherwise, execute @or_this@. If both failed, this function +-- also combines their failure messages in a reasonable way. +orIfNotFound :: Monad m => m FindResult -> m FindResult -> m FindResult +orIfNotFound this or_this = do + res <- this + case res of + NotFound { fr_paths = paths1, fr_mods_hidden = mh1 + , fr_pkgs_hidden = ph1, fr_unusables = u1, fr_suggestions = s1 } + -> do res2 <- or_this + case res2 of + NotFound { fr_paths = paths2, fr_pkg = mb_pkg2, fr_mods_hidden = mh2 + , fr_pkgs_hidden = ph2, fr_unusables = u2 + , fr_suggestions = s2 } + -> return (NotFound { fr_paths = paths1 ++ paths2 + , fr_pkg = mb_pkg2 -- snd arg is the package search + , fr_mods_hidden = mh1 ++ mh2 + , fr_pkgs_hidden = ph1 ++ ph2 + , fr_unusables = u1 ++ u2 + , fr_suggestions = s1 ++ s2 }) + _other -> return res2 + _other -> return res + +-- | Helper function for 'findHomeModule': this function wraps an IO action +-- which would look up @mod_name@ in the file system (the home package), +-- and first consults the 'hsc_FC' cache to see if the lookup has already +-- been done. Otherwise, do the lookup (with the IO action) and save +-- the result in the finder cache and the module location cache (if it +-- was successful.) +homeSearchCache :: FinderCache -> HomeUnit -> ModuleName -> IO InstalledFindResult -> IO InstalledFindResult +homeSearchCache fc home_unit mod_name do_this = do + let mod = mkHomeInstalledModule home_unit mod_name + modLocationCache fc mod do_this + +findExposedPackageModule :: FinderCache -> FinderOpts -> UnitState -> ModuleName -> Maybe FastString -> IO FindResult +findExposedPackageModule fc fopts units mod_name mb_pkg = + findLookupResult fc fopts + $ lookupModuleWithSuggestions units mod_name mb_pkg + +findExposedPluginPackageModule :: FinderCache -> FinderOpts -> UnitState -> ModuleName -> IO FindResult +findExposedPluginPackageModule fc fopts units mod_name = + findLookupResult fc fopts + $ lookupPluginModuleWithSuggestions units mod_name Nothing + +findLookupResult :: FinderCache -> FinderOpts -> LookupResult -> IO FindResult +findLookupResult fc fopts r = case r of + LookupFound m pkg_conf -> do + let im = fst (getModuleInstantiation m) + r' <- findPackageModule_ fc fopts im (fst pkg_conf) + case r' of + -- TODO: ghc -M is unlikely to do the right thing + -- with just the location of the thing that was + -- instantiated; you probably also need all of the + -- implicit locations from the instances + InstalledFound loc _ -> return (Found loc m) + InstalledNoPackage _ -> return (NoPackage (moduleUnit m)) + InstalledNotFound fp _ -> return (NotFound{ fr_paths = fp, fr_pkg = Just (moduleUnit m) + , fr_pkgs_hidden = [] + , fr_mods_hidden = [] + , fr_unusables = [] + , fr_suggestions = []}) + LookupMultiple rs -> + return (FoundMultiple rs) + LookupHidden pkg_hiddens mod_hiddens -> + return (NotFound{ fr_paths = [], fr_pkg = Nothing + , fr_pkgs_hidden = map (moduleUnit.fst) pkg_hiddens + , fr_mods_hidden = map (moduleUnit.fst) mod_hiddens + , fr_unusables = [] + , fr_suggestions = [] }) + LookupUnusable unusable -> + let unusables' = map get_unusable unusable + get_unusable (m, ModUnusable r) = (moduleUnit m, r) + get_unusable (_, r) = + pprPanic "findLookupResult: unexpected origin" (ppr r) + in return (NotFound{ fr_paths = [], fr_pkg = Nothing + , fr_pkgs_hidden = [] + , fr_mods_hidden = [] + , fr_unusables = unusables' + , fr_suggestions = [] }) + LookupNotFound suggest -> do + let suggest' + | finder_enableSuggestions fopts = suggest + | otherwise = [] + return (NotFound{ fr_paths = [], fr_pkg = Nothing + , fr_pkgs_hidden = [] + , fr_mods_hidden = [] + , fr_unusables = [] + , fr_suggestions = suggest' }) + +modLocationCache :: FinderCache -> InstalledModule -> IO InstalledFindResult -> IO InstalledFindResult +modLocationCache fc mod do_this = do + m <- lookupFinderCache fc mod + case m of + Just result -> return result + Nothing -> do + result <- do_this + addToFinderCache fc mod result + return result + +-- This returns a module because it's more convenient for users +addHomeModuleToFinder :: FinderCache -> HomeUnit -> ModuleName -> ModLocation -> IO Module +addHomeModuleToFinder fc home_unit mod_name loc = do + let mod = mkHomeInstalledModule home_unit mod_name + addToFinderCache fc mod (InstalledFound loc mod) + return (mkHomeModule home_unit mod_name) + +uncacheModule :: FinderCache -> HomeUnit -> ModuleName -> IO () +uncacheModule fc home_unit mod_name = do + let mod = mkHomeInstalledModule home_unit mod_name + removeFromFinderCache fc mod + +-- ----------------------------------------------------------------------------- +-- The internal workers + +findHomeModule :: FinderCache -> FinderOpts -> HomeUnit -> ModuleName -> IO FindResult +findHomeModule fc fopts home_unit mod_name = do + let uid = homeUnitAsUnit home_unit + r <- findInstalledHomeModule fc fopts home_unit mod_name + return $ case r of + InstalledFound loc _ -> Found loc (mkHomeModule home_unit mod_name) + InstalledNoPackage _ -> NoPackage uid -- impossible + InstalledNotFound fps _ -> NotFound { + fr_paths = fps, + fr_pkg = Just uid, + fr_mods_hidden = [], + fr_pkgs_hidden = [], + fr_unusables = [], + fr_suggestions = [] + } + +-- | Implements the search for a module name in the home package only. Calling +-- this function directly is usually *not* what you want; currently, it's used +-- as a building block for the following operations: +-- +-- 1. When you do a normal package lookup, we first check if the module +-- is available in the home module, before looking it up in the package +-- database. +-- +-- 2. When you have a package qualified import with package name "this", +-- we shortcut to the home module. +-- +-- 3. When we look up an exact 'Module', if the unit id associated with +-- the module is the current home module do a look up in the home module. +-- +-- 4. Some special-case code in GHCi (ToDo: Figure out why that needs to +-- call this.) +findInstalledHomeModule :: FinderCache -> FinderOpts -> HomeUnit -> ModuleName -> IO InstalledFindResult +findInstalledHomeModule fc fopts home_unit mod_name = do + homeSearchCache fc home_unit mod_name $ + let + home_path = finder_importPaths fopts + hisuf = finder_hiSuf fopts + mod = mkHomeInstalledModule home_unit mod_name + + source_exts = + [ ("hs", mkHomeModLocationSearched fopts mod_name "hs") + , ("lhs", mkHomeModLocationSearched fopts mod_name "lhs") + , ("hsig", mkHomeModLocationSearched fopts mod_name "hsig") + , ("lhsig", mkHomeModLocationSearched fopts mod_name "lhsig") + ] + + -- we use mkHomeModHiOnlyLocation instead of mkHiOnlyModLocation so that + -- when hiDir field is set in dflags, we know to look there (see #16500) + hi_exts = [ (hisuf, mkHomeModHiOnlyLocation fopts mod_name) + , (addBootSuffix hisuf, mkHomeModHiOnlyLocation fopts mod_name) + ] + + -- In compilation manager modes, we look for source files in the home + -- package because we can compile these automatically. In one-shot + -- compilation mode we look for .hi and .hi-boot files only. + exts | finder_lookupHomeInterfaces fopts = hi_exts + | otherwise = source_exts + in + + -- special case for GHC.Prim; we won't find it in the filesystem. + -- This is important only when compiling the base package (where GHC.Prim + -- is a home module). + if mod `installedModuleEq` gHC_PRIM + then return (InstalledFound (error "GHC.Prim ModLocation") mod) + else searchPathExts home_path mod exts + + +-- | Search for a module in external packages only. +findPackageModule :: FinderCache -> UnitState -> FinderOpts -> InstalledModule -> IO InstalledFindResult +findPackageModule fc unit_state fopts mod = do + let pkg_id = moduleUnit mod + case lookupUnitId unit_state pkg_id of + Nothing -> return (InstalledNoPackage pkg_id) + Just u -> findPackageModule_ fc fopts mod u + +-- | Look up the interface file associated with module @mod@. This function +-- requires a few invariants to be upheld: (1) the 'Module' in question must +-- be the module identifier of the *original* implementation of a module, +-- not a reexport (this invariant is upheld by "GHC.Unit.State") and (2) +-- the 'UnitInfo' must be consistent with the unit id in the 'Module'. +-- The redundancy is to avoid an extra lookup in the package state +-- for the appropriate config. +findPackageModule_ :: FinderCache -> FinderOpts -> InstalledModule -> UnitInfo -> IO InstalledFindResult +findPackageModule_ fc fopts mod pkg_conf = do + massertPpr (moduleUnit mod == unitId pkg_conf) + (ppr (moduleUnit mod) <+> ppr (unitId pkg_conf)) + modLocationCache fc mod $ + + -- special case for GHC.Prim; we won't find it in the filesystem. + if mod `installedModuleEq` gHC_PRIM + then return (InstalledFound (error "GHC.Prim ModLocation") mod) + else + + let + tag = waysBuildTag (finder_ways fopts) + + -- hi-suffix for packages depends on the build tag. + package_hisuf | null tag = "hi" + | otherwise = tag ++ "_hi" + + mk_hi_loc = mkHiOnlyModLocation fopts package_hisuf + + import_dirs = map ST.unpack $ unitImportDirs pkg_conf + -- we never look for a .hi-boot file in an external package; + -- .hi-boot files only make sense for the home package. + in + case import_dirs of + [one] | finder_bypassHiFileCheck fopts -> do + -- there's only one place that this .hi file can be, so + -- don't bother looking for it. + let basename = moduleNameSlashes (moduleName mod) + loc <- mk_hi_loc one basename + return (InstalledFound loc mod) + _otherwise -> + searchPathExts import_dirs mod [(package_hisuf, mk_hi_loc)] + +-- ----------------------------------------------------------------------------- +-- General path searching + +searchPathExts :: [FilePath] -- paths to search + -> InstalledModule -- module name + -> [ ( + FileExt, -- suffix + FilePath -> BaseName -> IO ModLocation -- action + ) + ] + -> IO InstalledFindResult + +searchPathExts paths mod exts = search to_search + where + basename = moduleNameSlashes (moduleName mod) + + to_search :: [(FilePath, IO ModLocation)] + to_search = [ (file, fn path basename) + | path <- paths, + (ext,fn) <- exts, + let base | path == "." = basename + | otherwise = path basename + file = base <.> ext + ] + + search [] = return (InstalledNotFound (map fst to_search) (Just (moduleUnit mod))) + + search ((file, mk_result) : rest) = do + b <- doesFileExist file + if b + then do { loc <- mk_result; return (InstalledFound loc mod) } + else search rest + +mkHomeModLocationSearched :: FinderOpts -> ModuleName -> FileExt + -> FilePath -> BaseName -> IO ModLocation +mkHomeModLocationSearched fopts mod suff path basename = + mkHomeModLocation2 fopts mod (path basename) suff + +-- ----------------------------------------------------------------------------- +-- Constructing a home module location + +-- This is where we construct the ModLocation for a module in the home +-- package, for which we have a source file. It is called from three +-- places: +-- +-- (a) Here in the finder, when we are searching for a module to import, +-- using the search path (-i option). +-- +-- (b) The compilation manager, when constructing the ModLocation for +-- a "root" module (a source file named explicitly on the command line +-- or in a :load command in GHCi). +-- +-- (c) The driver in one-shot mode, when we need to construct a +-- ModLocation for a source file named on the command-line. +-- +-- Parameters are: +-- +-- mod +-- The name of the module +-- +-- path +-- (a): The search path component where the source file was found. +-- (b) and (c): "." +-- +-- src_basename +-- (a): (moduleNameSlashes mod) +-- (b) and (c): The filename of the source file, minus its extension +-- +-- ext +-- The filename extension of the source file (usually "hs" or "lhs"). + +mkHomeModLocation :: FinderOpts -> ModuleName -> FilePath -> IO ModLocation +mkHomeModLocation dflags mod src_filename = do + let (basename,extension) = splitExtension src_filename + mkHomeModLocation2 dflags mod basename extension + +mkHomeModLocation2 :: FinderOpts + -> ModuleName + -> FilePath -- Of source module, without suffix + -> String -- Suffix + -> IO ModLocation +mkHomeModLocation2 fopts mod src_basename ext = do + let mod_basename = moduleNameSlashes mod + + obj_fn = mkObjPath fopts src_basename mod_basename + hi_fn = mkHiPath fopts src_basename mod_basename + hie_fn = mkHiePath fopts src_basename mod_basename + + return (ModLocation{ ml_hs_file = Just (src_basename <.> ext), + ml_hi_file = hi_fn, + ml_obj_file = obj_fn, + ml_hie_file = hie_fn }) + +mkHomeModHiOnlyLocation :: FinderOpts + -> ModuleName + -> FilePath + -> BaseName + -> IO ModLocation +mkHomeModHiOnlyLocation fopts mod path basename = do + loc <- mkHomeModLocation2 fopts mod (path basename) "" + return loc { ml_hs_file = Nothing } + +mkHiOnlyModLocation :: FinderOpts -> Suffix -> FilePath -> String + -> IO ModLocation +mkHiOnlyModLocation fopts hisuf path basename + = do let full_basename = path basename + obj_fn = mkObjPath fopts full_basename basename + hie_fn = mkHiePath fopts full_basename basename + return ModLocation{ ml_hs_file = Nothing, + ml_hi_file = full_basename <.> hisuf, + -- Remove the .hi-boot suffix from + -- hi_file, if it had one. We always + -- want the name of the real .hi file + -- in the ml_hi_file field. + ml_obj_file = obj_fn, + ml_hie_file = hie_fn + } + +-- | Constructs the filename of a .o file for a given source file. +-- Does /not/ check whether the .o file exists +mkObjPath + :: FinderOpts + -> FilePath -- the filename of the source file, minus the extension + -> String -- the module name with dots replaced by slashes + -> FilePath +mkObjPath fopts basename mod_basename = obj_basename <.> osuf + where + odir = finder_objectDir fopts + osuf = finder_objectSuf fopts + + obj_basename | Just dir <- odir = dir mod_basename + | otherwise = basename + + +-- | Constructs the filename of a .hi file for a given source file. +-- Does /not/ check whether the .hi file exists +mkHiPath + :: FinderOpts + -> FilePath -- the filename of the source file, minus the extension + -> String -- the module name with dots replaced by slashes + -> FilePath +mkHiPath fopts basename mod_basename = hi_basename <.> hisuf + where + hidir = finder_hiDir fopts + hisuf = finder_hiSuf fopts + + hi_basename | Just dir <- hidir = dir mod_basename + | otherwise = basename + +-- | Constructs the filename of a .hie file for a given source file. +-- Does /not/ check whether the .hie file exists +mkHiePath + :: FinderOpts + -> FilePath -- the filename of the source file, minus the extension + -> String -- the module name with dots replaced by slashes + -> FilePath +mkHiePath fopts basename mod_basename = hie_basename <.> hiesuf + where + hiedir = finder_hieDir fopts + hiesuf = finder_hieSuf fopts + + hie_basename | Just dir <- hiedir = dir mod_basename + | otherwise = basename + + + +-- ----------------------------------------------------------------------------- +-- Filenames of the stub files + +-- We don't have to store these in ModLocations, because they can be derived +-- from other available information, and they're only rarely needed. + +mkStubPaths + :: FinderOpts + -> ModuleName + -> ModLocation + -> FilePath + +mkStubPaths fopts mod location + = let + stubdir = finder_stubDir fopts + + mod_basename = moduleNameSlashes mod + src_basename = dropExtension $ expectJust "mkStubPaths" + (ml_hs_file location) + + stub_basename0 + | Just dir <- stubdir = dir mod_basename + | otherwise = src_basename + + stub_basename = stub_basename0 ++ "_stub" + in + stub_basename <.> "h" + +-- ----------------------------------------------------------------------------- +-- findLinkable isn't related to the other stuff in here, +-- but there's no other obvious place for it + +findObjectLinkableMaybe :: Module -> ModLocation -> IO (Maybe Linkable) +findObjectLinkableMaybe mod locn + = do let obj_fn = ml_obj_file locn + maybe_obj_time <- modificationTimeIfExists obj_fn + case maybe_obj_time of + Nothing -> return Nothing + Just obj_time -> liftM Just (findObjectLinkable mod obj_fn obj_time) + +-- Make an object linkable when we know the object file exists, and we know +-- its modification time. +findObjectLinkable :: Module -> FilePath -> UTCTime -> IO Linkable +findObjectLinkable mod obj_fn obj_time = return (LM obj_time mod [DotO obj_fn]) + -- We used to look for _stub.o files here, but that was a bug (#706) + -- Now GHC merges the stub.o into the main .o (#3687) + diff --git a/compiler/GHC/Unit/Info.hs b/compiler/GHC/Unit/Info.hs --- a/compiler/GHC/Unit/Info.hs +++ b/compiler/GHC/Unit/Info.hs @@ -50,7 +50,6 @@ import Data.Version import Data.Bifunctor import Data.List (isPrefixOf, stripPrefix) -import qualified Data.Set as Set -- | Information about an installed unit @@ -205,19 +204,19 @@ -- | Either the 'unitLibraryDirs' or 'unitLibraryDynDirs' as appropriate for the way. libraryDirsForWay :: Ways -> UnitInfo -> [String] libraryDirsForWay ws - | WayDyn `elem` ws = map ST.unpack . unitLibraryDynDirs + | hasWay ws WayDyn = map ST.unpack . unitLibraryDynDirs | otherwise = map ST.unpack . unitLibraryDirs unitHsLibs :: GhcNameVersion -> Ways -> UnitInfo -> [String] unitHsLibs namever ways0 p = map (mkDynName . addSuffix . ST.unpack) (unitLibraries p) where - ways1 = Set.filter (/= WayDyn) ways0 + ways1 = removeWay WayDyn ways0 -- the name of a shared library is libHSfoo-ghc.so -- we leave out the _dyn, because it is superfluous -- debug and profiled RTSs include support for -eventlog - ways2 | WayDebug `Set.member` ways1 || WayProf `Set.member` ways1 - = Set.filter (/= WayTracing) ways1 + ways2 | ways1 `hasWay` WayDebug || ways1 `hasWay` WayProf + = removeWay WayTracing ways1 | otherwise = ways1 @@ -247,7 +246,7 @@ -- and handling specifically for the `rts` package for -- example in ghc-cabal. addSuffix rts@"HSrts" = rts ++ (expandTag rts_tag) - addSuffix rts@"HSrts-1.0.1" = rts ++ (expandTag rts_tag) + addSuffix rts@"HSrts-1.0.2" = rts ++ (expandTag rts_tag) addSuffix other_lib = other_lib ++ (expandTag tag) expandTag t | null t = "" diff --git a/compiler/GHC/Unit/Module/ModSummary.hs b/compiler/GHC/Unit/Module/ModSummary.hs --- a/compiler/GHC/Unit/Module/ModSummary.hs +++ b/compiler/GHC/Unit/Module/ModSummary.hs @@ -90,6 +90,8 @@ -- ^ Source imports of the module ms_textual_imps :: [(Maybe FastString, Located ModuleName)], -- ^ Non-source imports of the module from the module *text* + ms_ghc_prim_import :: Bool, + -- ^ Whether the special module GHC.Prim was imported explicitliy ms_parsed_mod :: Maybe HsParsedModule, -- ^ The parsed, nonrenamed source, if we have it. This is also -- used to support "inline module syntax" in Backpack files. @@ -111,6 +113,7 @@ ms_mod_name :: ModSummary -> ModuleName ms_mod_name = moduleName . ms_mod +-- | Textual imports, plus plugin imports but not SOURCE imports. ms_imps :: ModSummary -> [(Maybe FastString, Located ModuleName)] ms_imps ms = ms_textual_imps ms ++ diff --git a/compiler/GHC/Unit/State.hs b/compiler/GHC/Unit/State.hs --- a/compiler/GHC/Unit/State.hs +++ b/compiler/GHC/Unit/State.hs @@ -2,6 +2,7 @@ {-# LANGUAGE ScopedTypeVariables, BangPatterns, FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} -- | Unit manipulation module GHC.Unit.State ( @@ -34,6 +35,7 @@ listVisibleModuleNames, lookupModuleInAllUnits, lookupModuleWithSuggestions, + lookupModulePackage, lookupPluginModuleWithSuggestions, requirementMerges, LookupResult(..), @@ -1790,7 +1792,7 @@ -> [(Module, UnitInfo)] lookupModuleInAllUnits pkgs m = case lookupModuleWithSuggestions pkgs m Nothing of - LookupFound a b -> [(a,b)] + LookupFound a b -> [(a,fst b)] LookupMultiple rs -> map f rs where f (m,_) = (m, expectJust "lookupModule" (lookupUnit pkgs (moduleUnit m))) @@ -1799,7 +1801,7 @@ -- | The result of performing a lookup data LookupResult = -- | Found the module uniquely, nothing else to do - LookupFound Module UnitInfo + LookupFound Module (UnitInfo, ModuleOrigin) -- | Multiple modules with the same name in scope | LookupMultiple [(Module, ModuleOrigin)] -- | No modules found, but there were some hidden ones with @@ -1822,6 +1824,26 @@ lookupModuleWithSuggestions pkgs = lookupModuleWithSuggestions' pkgs (moduleNameProvidersMap pkgs) +-- | The package which the module **appears** to come from, this could be +-- the one which reexports the module from it's original package. This function +-- is currently only used for -Wunused-packages +lookupModulePackage :: UnitState -> ModuleName -> Maybe FastString -> Maybe [UnitInfo] +lookupModulePackage pkgs mn mfs = + case lookupModuleWithSuggestions' pkgs (moduleNameProvidersMap pkgs) mn mfs of + LookupFound _ (orig_unit, origin) -> + case origin of + ModOrigin {fromOrigUnit, fromExposedReexport} -> + case fromOrigUnit of + -- Just True means, the import is available from its original location + Just True -> + pure [orig_unit] + -- Otherwise, it must be available from a reexport + _ -> pure fromExposedReexport + + _ -> Nothing + + _ -> Nothing + lookupPluginModuleWithSuggestions :: UnitState -> ModuleName -> Maybe FastString @@ -1840,7 +1862,7 @@ Just xs -> case foldl' classify ([],[],[], []) (Map.toList xs) of ([], [], [], []) -> LookupNotFound suggestions - (_, _, _, [(m, _)]) -> LookupFound m (mod_unit m) + (_, _, _, [(m, o)]) -> LookupFound m (mod_unit m, o) (_, _, _, exposed@(_:_)) -> LookupMultiple exposed ([], [], unusable@(_:_), []) -> LookupUnusable unusable (hidden_pkg, hidden_mod, _, []) -> diff --git a/compiler/GHC/Utils/Logger.hs b/compiler/GHC/Utils/Logger.hs --- a/compiler/GHC/Utils/Logger.hs +++ b/compiler/GHC/Utils/Logger.hs @@ -577,10 +577,19 @@ -> SDoc -> IO () putDumpFileMaybe' logger printer flag hdr fmt doc - = when (logHasDumpFlag logger flag) $ do - let sty = mkDumpStyle printer - logDumpFile logger sty flag hdr fmt doc + = when (logHasDumpFlag logger flag) $ + logDumpFile' logger printer flag hdr fmt doc {-# INLINE putDumpFileMaybe' #-} -- see Note [INLINE conditional tracing utilities] + + +logDumpFile' :: Logger -> PrintUnqualified -> DumpFlag + -> String -> DumpFormat -> SDoc -> IO () +{-# NOINLINE logDumpFile' #-} +-- NOINLINE: Now we are past the conditional, into the "cold" path, +-- don't inline, to reduce code size at the call site +-- See Note [INLINE conditional tracing utilities] +logDumpFile' logger printer flag hdr fmt doc + = logDumpFile logger (mkDumpStyle printer) flag hdr fmt doc -- | Ensure that a dump file is created even if it stays empty touchDumpFile :: Logger -> DumpFlag -> IO () diff --git a/compiler/GHC/Utils/Monad.hs b/compiler/GHC/Utils/Monad.hs --- a/compiler/GHC/Utils/Monad.hs +++ b/compiler/GHC/Utils/Monad.hs @@ -355,6 +355,25 @@ where FCode m = FCode' $ oneShot (\cgInfoDown -> oneShot (\state ->m cgInfoDown state)) +INLINE pragmas and (>>) +~~~~~~~~~~~~~~~~~~~~~~~ +A nasty gotcha is described in #20008. In brief, be careful if you get (>>) via +its default method: + + instance Applicative M where + pure a = MkM (\s -> (s, a)) + (<*>) = ap + + instance Monad UM where + {-# INLINE (>>=) #-} + m >>= k = MkM (\s -> blah) + +Here we define (>>), via its default method, in terms of (>>=). If you do this, +be sure to put an INLINE pragma on (>>=), as above. That tells it to inline +(>>=) in the RHS of (>>), even when it is applied to only two arguments, which +in turn conveys the one-shot info from (>>=) to (>>). Lacking the INLINE, GHC +may eta-expand (>>), and with a non-one-shot lambda. #20008 has more discussion. + Derived instances ~~~~~~~~~~~~~~~~~ One caveat of both approaches is that derived instances don't use the smart diff --git a/compiler/GHC/Utils/Outputable.hs b/compiler/GHC/Utils/Outputable.hs --- a/compiler/GHC/Utils/Outputable.hs +++ b/compiler/GHC/Utils/Outputable.hs @@ -44,7 +44,7 @@ fsep, fcat, hang, hangNotEmpty, punctuate, ppWhen, ppUnless, ppWhenOption, ppUnlessOption, - speakNth, speakN, speakNOf, plural, isOrAre, doOrDoes, itsOrTheir, + speakNth, speakN, speakNOf, plural, singular, isOrAre, doOrDoes, itsOrTheir, thisOrThese, unicodeSyntax, coloured, keyword, @@ -1425,6 +1425,15 @@ plural [_] = empty -- a bit frightening, but there you are plural _ = char 's' +-- | Determines the singular verb suffix appropriate for the length of a list: +-- +-- > singular [] = empty +-- > singular["Hello"] = char 's' +-- > singular ["Hello", "World"] = empty +singular :: [a] -> SDoc +singular [_] = char 's' +singular _ = empty + -- | Determines the form of to be appropriate for the length of a list: -- -- > isOrAre [] = text "are" @@ -1451,3 +1460,13 @@ itsOrTheir :: [a] -> SDoc itsOrTheir [_] = text "its" itsOrTheir _ = text "their" + + +-- | Determines the form of subject appropriate for the length of a list: +-- +-- > thisOrThese [x] = text "This" +-- > thisOrThese [x,y] = text "These" +-- > thisOrThese [] = text "These" -- probably avoid this +thisOrThese :: [a] -> SDoc +thisOrThese [_] = text "This" +thisOrThese _ = text "These" diff --git a/compiler/GHC/Utils/Panic.hs b/compiler/GHC/Utils/Panic.hs --- a/compiler/GHC/Utils/Panic.hs +++ b/compiler/GHC/Utils/Panic.hs @@ -19,7 +19,6 @@ , throwGhcExceptionIO , handleGhcException - , GHC.Utils.Panic.Plain.progName , pgmError , panic , pprPanic @@ -124,9 +123,7 @@ | otherwise = Nothing instance Show GhcException where - showsPrec _ e@(ProgramError _) = showGhcExceptionUnsafe e - showsPrec _ e@(CmdLineError _) = showString ": " . showGhcExceptionUnsafe e - showsPrec _ e = showString progName . showString ": " . showGhcExceptionUnsafe e + showsPrec _ e = showGhcExceptionUnsafe e -- | Show an exception as a string. showException :: Exception e => e -> String diff --git a/compiler/GHC/Utils/Panic/Plain.hs b/compiler/GHC/Utils/Panic/Plain.hs --- a/compiler/GHC/Utils/Panic/Plain.hs +++ b/compiler/GHC/Utils/Panic/Plain.hs @@ -22,8 +22,6 @@ , cmdLineError, cmdLineErrorIO , assertPanic , assert, assertM, massert - - , progName ) where import GHC.Settings.Config @@ -31,7 +29,6 @@ import GHC.Utils.Exception as Exception import GHC.Stack import GHC.Prelude -import System.Environment import System.IO.Unsafe -- | This type is very similar to 'GHC.Utils.Panic.GhcException', but it omits @@ -69,14 +66,7 @@ instance Exception PlainGhcException instance Show PlainGhcException where - showsPrec _ e@(PlainProgramError _) = showPlainGhcException e - showsPrec _ e@(PlainCmdLineError _) = showString ": " . showPlainGhcException e - showsPrec _ e = showString progName . showString ": " . showPlainGhcException e - --- | The name of this GHC. -progName :: String -progName = unsafePerformIO (getProgName) -{-# NOINLINE progName #-} + showsPrec _ e = showPlainGhcException e -- | Short usage information to display when we are given the wrong cmd line arguments. short_usage :: String diff --git a/compiler/GHC/Utils/TmpFs.hs b/compiler/GHC/Utils/TmpFs.hs --- a/compiler/GHC/Utils/TmpFs.hs +++ b/compiler/GHC/Utils/TmpFs.hs @@ -9,6 +9,7 @@ , FilesToClean(..) , emptyFilesToClean , TempFileLifetime(..) + , TempDir (..) , cleanTempDirs , cleanTempFiles , cleanCurrentModuleTempFiles @@ -24,7 +25,6 @@ import GHC.Prelude -import GHC.Driver.Session import GHC.Utils.Error import GHC.Utils.Outputable import GHC.Utils.Logger @@ -32,7 +32,6 @@ import GHC.Utils.Exception as Exception import GHC.Driver.Phases -import Control.Monad import Data.List (partition) import qualified Data.Set as Set import Data.Set (Set) @@ -92,6 +91,7 @@ -- runGhc(T) deriving (Show) +newtype TempDir = TempDir FilePath -- | An empty FilesToClean emptyFilesToClean :: FilesToClean @@ -135,19 +135,17 @@ src_files <- atomicModifyIORef' (tmp_files_to_clean src) (\s -> (emptyFilesToClean, s)) atomicModifyIORef' (tmp_files_to_clean dst) (\s -> (mergeFilesToClean src_files s, ())) -cleanTempDirs :: Logger -> TmpFs -> DynFlags -> IO () -cleanTempDirs logger tmpfs dflags - = unless (gopt Opt_KeepTmpFiles dflags) - $ mask_ +cleanTempDirs :: Logger -> TmpFs -> IO () +cleanTempDirs logger tmpfs + = mask_ $ do let ref = tmp_dirs_to_clean tmpfs ds <- atomicModifyIORef' ref $ \ds -> (Map.empty, ds) removeTmpDirs logger (Map.elems ds) -- | Delete all files in @tmp_files_to_clean@. -cleanTempFiles :: Logger -> TmpFs -> DynFlags -> IO () -cleanTempFiles logger tmpfs dflags - = unless (gopt Opt_KeepTmpFiles dflags) - $ mask_ +cleanTempFiles :: Logger -> TmpFs -> IO () +cleanTempFiles logger tmpfs + = mask_ $ do let ref = tmp_files_to_clean tmpfs to_delete <- atomicModifyIORef' ref $ \FilesToClean @@ -161,10 +159,9 @@ -- TFL_CurrentModule. -- If a file must be cleaned eventually, but must survive a -- cleanCurrentModuleTempFiles, ensure it has lifetime TFL_GhcSession. -cleanCurrentModuleTempFiles :: Logger -> TmpFs -> DynFlags -> IO () -cleanCurrentModuleTempFiles logger tmpfs dflags - = unless (gopt Opt_KeepTmpFiles dflags) - $ mask_ +cleanCurrentModuleTempFiles :: Logger -> TmpFs -> IO () +cleanCurrentModuleTempFiles logger tmpfs + = mask_ $ do let ref = tmp_files_to_clean tmpfs to_delete <- atomicModifyIORef' ref $ \ftc@FilesToClean{ftcCurrentModule = cm_files} -> @@ -212,9 +209,9 @@ atomicModifyIORef' (tmp_next_suffix tmpfs) $ \n -> (n+1,n) -- Find a temporary name that doesn't already exist. -newTempName :: Logger -> TmpFs -> DynFlags -> TempFileLifetime -> Suffix -> IO FilePath -newTempName logger tmpfs dflags lifetime extn - = do d <- getTempDir logger tmpfs dflags +newTempName :: Logger -> TmpFs -> TempDir -> TempFileLifetime -> Suffix -> IO FilePath +newTempName logger tmpfs tmp_dir lifetime extn + = do d <- getTempDir logger tmpfs tmp_dir findTempName (d "ghc_") -- See Note [Deterministic base name] where findTempName :: FilePath -> IO FilePath @@ -227,9 +224,9 @@ addFilesToClean tmpfs lifetime [filename] return filename -newTempDir :: Logger -> TmpFs -> DynFlags -> IO FilePath -newTempDir logger tmpfs dflags - = do d <- getTempDir logger tmpfs dflags +newTempDir :: Logger -> TmpFs -> TempDir -> IO FilePath +newTempDir logger tmpfs tmp_dir + = do d <- getTempDir logger tmpfs tmp_dir findTempDir (d "ghc_") where findTempDir :: FilePath -> IO FilePath @@ -242,10 +239,10 @@ -- see mkTempDir below; this is wrong: -> consIORef (tmp_dirs_to_clean tmpfs) filename return filename -newTempLibName :: Logger -> TmpFs -> DynFlags -> TempFileLifetime -> Suffix +newTempLibName :: Logger -> TmpFs -> TempDir -> TempFileLifetime -> Suffix -> IO (FilePath, FilePath, String) -newTempLibName logger tmpfs dflags lifetime extn - = do d <- getTempDir logger tmpfs dflags +newTempLibName logger tmpfs tmp_dir lifetime extn + = do d <- getTempDir logger tmpfs tmp_dir findTempName d ("ghc_") where findTempName :: FilePath -> String -> IO (FilePath, FilePath, String) @@ -262,8 +259,8 @@ -- Return our temporary directory within tmp_dir, creating one if we -- don't have one yet. -getTempDir :: Logger -> TmpFs -> DynFlags -> IO FilePath -getTempDir logger tmpfs dflags = do +getTempDir :: Logger -> TmpFs -> TempDir -> IO FilePath +getTempDir logger tmpfs (TempDir tmp_dir) = do mapping <- readIORef dir_ref case Map.lookup tmp_dir mapping of Nothing -> do @@ -272,7 +269,6 @@ mask_ $ mkTempDir prefix Just dir -> return dir where - tmp_dir = tmpDir dflags dir_ref = tmp_dirs_to_clean tmpfs mkTempDir :: FilePath -> IO FilePath diff --git a/compiler/GHC/Utils/Trace.hs b/compiler/GHC/Utils/Trace.hs --- a/compiler/GHC/Utils/Trace.hs +++ b/compiler/GHC/Utils/Trace.hs @@ -7,6 +7,7 @@ , pprSTrace , pprTraceException , warnPprTrace + , pprTraceUserWarning , trace ) where @@ -68,6 +69,15 @@ warnPprTrace False _msg x = x warnPprTrace True msg x = pprDebugAndThen defaultSDocContext trace (text "WARNING:") + (msg $$ withFrozenCallStack traceCallStackDoc ) + x + +-- | For when we want to show the user a non-fatal WARNING so that they can +-- report a GHC bug, but don't want to panic. +pprTraceUserWarning :: HasCallStack => SDoc -> a -> a +pprTraceUserWarning msg x + | unsafeHasNoDebugOutput = x + | otherwise = pprDebugAndThen defaultSDocContext trace (text "WARNING:") (msg $$ withFrozenCallStack traceCallStackDoc ) x diff --git a/compiler/cbits/genSym.c b/compiler/cbits/genSym.c --- a/compiler/cbits/genSym.c +++ b/compiler/cbits/genSym.c @@ -16,9 +16,7 @@ HsInt ghc_lib_parser_genSym(void) { HsInt u = atomic_inc((StgWord *)&ghc_unique_counter, ghc_unique_inc) & UNIQUE_MASK; -#if DEBUG // Uh oh! We will overflow next time a unique is requested. - assert(u != UNIQUE_MASK); -#endif + ASSERT(u != UNIQUE_MASK); return u; } diff --git a/ghc-lib-parser.cabal b/ghc-lib-parser.cabal --- a/ghc-lib-parser.cabal +++ b/ghc-lib-parser.cabal @@ -1,7 +1,7 @@ cabal-version: >=1.22 build-type: Simple name: ghc-lib-parser -version: 0.20210701 +version: 0.20210801 license: BSD3 license-file: LICENSE category: Development @@ -79,7 +79,6 @@ time >= 1.4 && < 1.10, transformers == 0.5.*, process >= 1 && < 1.7, - hpc == 0.6.*, exceptions == 0.10.*, parsec build-tools: alex >= 3.1, happy >= 1.19.4 @@ -228,6 +227,7 @@ GHC.Driver.CmdLine GHC.Driver.Config GHC.Driver.Config.Diagnostic + GHC.Driver.Config.Finder GHC.Driver.Config.Logger GHC.Driver.Config.Parser GHC.Driver.Env @@ -240,6 +240,7 @@ GHC.Driver.Monad GHC.Driver.Phases GHC.Driver.Pipeline.Monad + GHC.Driver.Pipeline.Phases GHC.Driver.Plugins GHC.Driver.Ppr GHC.Driver.Session @@ -289,6 +290,7 @@ GHC.Parser GHC.Parser.Annotation GHC.Parser.CharClass + GHC.Parser.Errors.Basic GHC.Parser.Errors.Ppr GHC.Parser.Errors.Types GHC.Parser.Header @@ -393,6 +395,7 @@ GHC.Unit.Database GHC.Unit.Env GHC.Unit.External + GHC.Unit.Finder GHC.Unit.Finder.Types GHC.Unit.Home GHC.Unit.Home.ModInfo diff --git a/ghc-lib/stage0/compiler/build/GHC/Parser/Lexer.hs b/ghc-lib/stage0/compiler/build/GHC/Parser/Lexer.hs --- a/ghc-lib/stage0/compiler/build/GHC/Parser/Lexer.hs +++ b/ghc-lib/stage0/compiler/build/GHC/Parser/Lexer.hs @@ -23,7 +23,7 @@ MonadP(..), getRealSrcLoc, getPState, failMsgP, failLocMsgP, srcParseFail, - getErrorMessages, getMessages, + getPsErrorMessages, getPsMessages, popContext, pushModuleContext, setLastToken, setSrcLoc, activeContext, nextIsEOF, getLexState, popLexState, pushLexState, @@ -70,7 +70,7 @@ import GHC.Utils.Panic import GHC.Data.StringBuffer import GHC.Data.FastString -import GHC.Types.Error hiding ( getErrorMessages, getMessages ) +import GHC.Types.Error import GHC.Types.Unique.FM import GHC.Data.Maybe import GHC.Data.OrdList @@ -85,6 +85,7 @@ import GHC.Parser.Annotation import GHC.Driver.Flags +import GHC.Parser.Errors.Basic import GHC.Parser.Errors.Types import GHC.Parser.Errors.Ppr () @@ -608,7 +609,7 @@ , (0,alex_action_117) ] -{-# LINE 698 "compiler/GHC/Parser/Lexer.x" #-} +{-# LINE 699 "compiler/GHC/Parser/Lexer.x" #-} -- ----------------------------------------------------------------------------- @@ -2210,7 +2211,7 @@ newtype ParseResult a = PR (# (# PState, a #) | PState #) -- | The parser has consumed a (possibly empty) prefix of the input and produced --- a result. Use 'getMessages' to check for accumulated warnings and non-fatal +-- a result. Use 'getPsMessages' to check for accumulated warnings and non-fatal -- errors. -- -- The carried parsing state can be used to resume parsing. @@ -2220,8 +2221,8 @@ -- | The parser has consumed a (possibly empty) prefix of the input and failed. -- -- The carried parsing state can be used to resume parsing. It is the state --- right before failure, including the fatal parse error. 'getMessages' and --- 'getErrorMessages' must return a non-empty bag of errors. +-- right before failure, including the fatal parse error. 'getPsMessages' and +-- 'getPsErrorMessages' must return a non-empty bag of errors. pattern PFailed :: PState -> ParseResult a pattern PFailed s = PR (# | s #) @@ -2836,7 +2837,7 @@ addError :: MsgEnvelope PsMessage -> m () -- | Add a warning to the accumulator. - -- Use 'getMessages' to get the accumulated warnings. + -- Use 'getPsMessages' to get the accumulated warnings. addWarning :: MsgEnvelope PsMessage -> m () -- | Add a fatal error. This will be the last error reported by the parser, and @@ -2922,13 +2923,13 @@ -- | Get a bag of the errors that have been accumulated so far. -- Does not take -Werror into account. -getErrorMessages :: PState -> Messages PsMessage -getErrorMessages p = errors p +getPsErrorMessages :: PState -> Messages PsMessage +getPsErrorMessages p = errors p -- | Get the warnings and errors accumulated so far. -- Does not take -Werror into account. -getMessages :: PState -> (Messages PsMessage, Messages PsMessage) -getMessages p = +getPsMessages :: PState -> (Messages PsMessage, Messages PsMessage) +getPsMessages p = let ws = warnings p diag_opts = pDiagOpts (options p) -- we add the tabulation warning on the fly because diff --git a/ghc-lib/stage0/compiler/build/primop-data-decl.hs-incl b/ghc-lib/stage0/compiler/build/primop-data-decl.hs-incl --- a/ghc-lib/stage0/compiler/build/primop-data-decl.hs-incl +++ b/ghc-lib/stage0/compiler/build/primop-data-decl.hs-incl @@ -288,7 +288,6 @@ | FloatToDoubleOp | FloatDecode_IntOp | NewArrayOp - | SameMutableArrayOp | ReadArrayOp | WriteArrayOp | SizeofArrayOp @@ -304,7 +303,6 @@ | ThawArrayOp | CasArrayOp | NewSmallArrayOp - | SameSmallMutableArrayOp | ShrinkSmallMutableArrayOp_Char | ReadSmallArrayOp | WriteSmallArrayOp @@ -328,7 +326,6 @@ | ByteArrayIsPinnedOp | ByteArrayContents_Char | MutableByteArrayContents_Char - | SameMutableByteArrayOp | ShrinkMutableByteArrayOp_Char | ResizeMutableByteArrayOp_Char | UnsafeFreezeByteArrayOp @@ -442,7 +439,6 @@ | FetchOrByteArrayOp_Int | FetchXorByteArrayOp_Int | NewArrayArrayOp - | SameMutableArrayArrayOp | UnsafeFreezeArrayArrayOp | SizeofArrayArrayOp | SizeofMutableArrayArrayOp @@ -532,7 +528,6 @@ | NewMutVarOp | ReadMutVarOp | WriteMutVarOp - | SameMutVarOp | AtomicModifyMutVar2Op | AtomicModifyMutVar_Op | CasMutVarOp @@ -551,7 +546,6 @@ | ReadTVarOp | ReadTVarIOOp | WriteTVarOp - | SameTVarOp | NewMVarOp | TakeMVarOp | TryTakeMVarOp @@ -559,12 +553,10 @@ | TryPutMVarOp | ReadMVarOp | TryReadMVarOp - | SameMVarOp | IsEmptyMVarOp | NewIOPortrOp | ReadIOPortOp | WriteIOPortOp - | SameIOPortOp | DelayOp | WaitReadOp | WaitWriteOp @@ -587,7 +579,6 @@ | DeRefStablePtrOp | EqStablePtrOp | MakeStableNameOp - | EqStableNameOp | StableNameToIntOp | CompactNewOp | CompactResizeOp diff --git a/ghc-lib/stage0/compiler/build/primop-list.hs-incl b/ghc-lib/stage0/compiler/build/primop-list.hs-incl --- a/ghc-lib/stage0/compiler/build/primop-list.hs-incl +++ b/ghc-lib/stage0/compiler/build/primop-list.hs-incl @@ -287,7 +287,6 @@ , FloatToDoubleOp , FloatDecode_IntOp , NewArrayOp - , SameMutableArrayOp , ReadArrayOp , WriteArrayOp , SizeofArrayOp @@ -303,7 +302,6 @@ , ThawArrayOp , CasArrayOp , NewSmallArrayOp - , SameSmallMutableArrayOp , ShrinkSmallMutableArrayOp_Char , ReadSmallArrayOp , WriteSmallArrayOp @@ -327,7 +325,6 @@ , ByteArrayIsPinnedOp , ByteArrayContents_Char , MutableByteArrayContents_Char - , SameMutableByteArrayOp , ShrinkMutableByteArrayOp_Char , ResizeMutableByteArrayOp_Char , UnsafeFreezeByteArrayOp @@ -441,7 +438,6 @@ , FetchOrByteArrayOp_Int , FetchXorByteArrayOp_Int , NewArrayArrayOp - , SameMutableArrayArrayOp , UnsafeFreezeArrayArrayOp , SizeofArrayArrayOp , SizeofMutableArrayArrayOp @@ -531,7 +527,6 @@ , NewMutVarOp , ReadMutVarOp , WriteMutVarOp - , SameMutVarOp , AtomicModifyMutVar2Op , AtomicModifyMutVar_Op , CasMutVarOp @@ -550,7 +545,6 @@ , ReadTVarOp , ReadTVarIOOp , WriteTVarOp - , SameTVarOp , NewMVarOp , TakeMVarOp , TryTakeMVarOp @@ -558,12 +552,10 @@ , TryPutMVarOp , ReadMVarOp , TryReadMVarOp - , SameMVarOp , IsEmptyMVarOp , NewIOPortrOp , ReadIOPortOp , WriteIOPortOp - , SameIOPortOp , DelayOp , WaitReadOp , WaitWriteOp @@ -586,7 +578,6 @@ , DeRefStablePtrOp , EqStablePtrOp , MakeStableNameOp - , EqStableNameOp , StableNameToIntOp , CompactNewOp , CompactResizeOp diff --git a/ghc-lib/stage0/compiler/build/primop-primop-info.hs-incl b/ghc-lib/stage0/compiler/build/primop-primop-info.hs-incl --- a/ghc-lib/stage0/compiler/build/primop-primop-info.hs-incl +++ b/ghc-lib/stage0/compiler/build/primop-primop-info.hs-incl @@ -287,7 +287,6 @@ primOpInfo FloatToDoubleOp = mkGenPrimOp (fsLit "float2Double#") [] [floatPrimTy] (doublePrimTy) primOpInfo FloatDecode_IntOp = mkGenPrimOp (fsLit "decodeFloat_Int#") [] [floatPrimTy] ((mkTupleTy Unboxed [intPrimTy, intPrimTy])) primOpInfo NewArrayOp = mkGenPrimOp (fsLit "newArray#") [alphaTyVarSpec, deltaTyVarSpec] [intPrimTy, alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, mkMutableArrayPrimTy deltaTy alphaTy])) -primOpInfo SameMutableArrayOp = mkGenPrimOp (fsLit "sameMutableArray#") [deltaTyVarSpec, alphaTyVarSpec] [mkMutableArrayPrimTy deltaTy alphaTy, mkMutableArrayPrimTy deltaTy alphaTy] (intPrimTy) primOpInfo ReadArrayOp = mkGenPrimOp (fsLit "readArray#") [deltaTyVarSpec, alphaTyVarSpec] [mkMutableArrayPrimTy deltaTy alphaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, alphaTy])) primOpInfo WriteArrayOp = mkGenPrimOp (fsLit "writeArray#") [deltaTyVarSpec, alphaTyVarSpec] [mkMutableArrayPrimTy deltaTy alphaTy, intPrimTy, alphaTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) primOpInfo SizeofArrayOp = mkGenPrimOp (fsLit "sizeofArray#") [alphaTyVarSpec] [mkArrayPrimTy alphaTy] (intPrimTy) @@ -303,7 +302,6 @@ primOpInfo ThawArrayOp = mkGenPrimOp (fsLit "thawArray#") [alphaTyVarSpec, deltaTyVarSpec] [mkArrayPrimTy alphaTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, mkMutableArrayPrimTy deltaTy alphaTy])) primOpInfo CasArrayOp = mkGenPrimOp (fsLit "casArray#") [deltaTyVarSpec, alphaTyVarSpec] [mkMutableArrayPrimTy deltaTy alphaTy, intPrimTy, alphaTy, alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, intPrimTy, alphaTy])) primOpInfo NewSmallArrayOp = mkGenPrimOp (fsLit "newSmallArray#") [alphaTyVarSpec, deltaTyVarSpec] [intPrimTy, alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, mkSmallMutableArrayPrimTy deltaTy alphaTy])) -primOpInfo SameSmallMutableArrayOp = mkGenPrimOp (fsLit "sameSmallMutableArray#") [deltaTyVarSpec, alphaTyVarSpec] [mkSmallMutableArrayPrimTy deltaTy alphaTy, mkSmallMutableArrayPrimTy deltaTy alphaTy] (intPrimTy) primOpInfo ShrinkSmallMutableArrayOp_Char = mkGenPrimOp (fsLit "shrinkSmallMutableArray#") [deltaTyVarSpec, alphaTyVarSpec] [mkSmallMutableArrayPrimTy deltaTy alphaTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) primOpInfo ReadSmallArrayOp = mkGenPrimOp (fsLit "readSmallArray#") [deltaTyVarSpec, alphaTyVarSpec] [mkSmallMutableArrayPrimTy deltaTy alphaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, alphaTy])) primOpInfo WriteSmallArrayOp = mkGenPrimOp (fsLit "writeSmallArray#") [deltaTyVarSpec, alphaTyVarSpec] [mkSmallMutableArrayPrimTy deltaTy alphaTy, intPrimTy, alphaTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) @@ -327,7 +325,6 @@ primOpInfo ByteArrayIsPinnedOp = mkGenPrimOp (fsLit "isByteArrayPinned#") [] [byteArrayPrimTy] (intPrimTy) primOpInfo ByteArrayContents_Char = mkGenPrimOp (fsLit "byteArrayContents#") [] [byteArrayPrimTy] (addrPrimTy) primOpInfo MutableByteArrayContents_Char = mkGenPrimOp (fsLit "mutableByteArrayContents#") [deltaTyVarSpec] [mkMutableByteArrayPrimTy deltaTy] (addrPrimTy) -primOpInfo SameMutableByteArrayOp = mkGenPrimOp (fsLit "sameMutableByteArray#") [deltaTyVarSpec] [mkMutableByteArrayPrimTy deltaTy, mkMutableByteArrayPrimTy deltaTy] (intPrimTy) primOpInfo ShrinkMutableByteArrayOp_Char = mkGenPrimOp (fsLit "shrinkMutableByteArray#") [deltaTyVarSpec] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) primOpInfo ResizeMutableByteArrayOp_Char = mkGenPrimOp (fsLit "resizeMutableByteArray#") [deltaTyVarSpec] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, mkMutableByteArrayPrimTy deltaTy])) primOpInfo UnsafeFreezeByteArrayOp = mkGenPrimOp (fsLit "unsafeFreezeByteArray#") [deltaTyVarSpec] [mkMutableByteArrayPrimTy deltaTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, byteArrayPrimTy])) @@ -441,7 +438,6 @@ primOpInfo FetchOrByteArrayOp_Int = mkGenPrimOp (fsLit "fetchOrIntArray#") [deltaTyVarSpec] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, intPrimTy])) primOpInfo FetchXorByteArrayOp_Int = mkGenPrimOp (fsLit "fetchXorIntArray#") [deltaTyVarSpec] [mkMutableByteArrayPrimTy deltaTy, intPrimTy, intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, intPrimTy])) primOpInfo NewArrayArrayOp = mkGenPrimOp (fsLit "newArrayArray#") [deltaTyVarSpec] [intPrimTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, mkMutableArrayArrayPrimTy deltaTy])) -primOpInfo SameMutableArrayArrayOp = mkGenPrimOp (fsLit "sameMutableArrayArray#") [deltaTyVarSpec] [mkMutableArrayArrayPrimTy deltaTy, mkMutableArrayArrayPrimTy deltaTy] (intPrimTy) primOpInfo UnsafeFreezeArrayArrayOp = mkGenPrimOp (fsLit "unsafeFreezeArrayArray#") [deltaTyVarSpec] [mkMutableArrayArrayPrimTy deltaTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, mkArrayArrayPrimTy])) primOpInfo SizeofArrayArrayOp = mkGenPrimOp (fsLit "sizeofArrayArray#") [] [mkArrayArrayPrimTy] (intPrimTy) primOpInfo SizeofMutableArrayArrayOp = mkGenPrimOp (fsLit "sizeofMutableArrayArray#") [deltaTyVarSpec] [mkMutableArrayArrayPrimTy deltaTy] (intPrimTy) @@ -531,7 +527,6 @@ primOpInfo NewMutVarOp = mkGenPrimOp (fsLit "newMutVar#") [alphaTyVarSpec, deltaTyVarSpec] [alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, mkMutVarPrimTy deltaTy alphaTy])) primOpInfo ReadMutVarOp = mkGenPrimOp (fsLit "readMutVar#") [deltaTyVarSpec, alphaTyVarSpec] [mkMutVarPrimTy deltaTy alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, alphaTy])) primOpInfo WriteMutVarOp = mkGenPrimOp (fsLit "writeMutVar#") [deltaTyVarSpec, alphaTyVarSpec] [mkMutVarPrimTy deltaTy alphaTy, alphaTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo SameMutVarOp = mkGenPrimOp (fsLit "sameMutVar#") [deltaTyVarSpec, alphaTyVarSpec] [mkMutVarPrimTy deltaTy alphaTy, mkMutVarPrimTy deltaTy alphaTy] (intPrimTy) primOpInfo AtomicModifyMutVar2Op = mkGenPrimOp (fsLit "atomicModifyMutVar2#") [deltaTyVarSpec, alphaTyVarSpec, gammaTyVarSpec] [mkMutVarPrimTy deltaTy alphaTy, (mkVisFunTyMany (alphaTy) (gammaTy)), mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, alphaTy, gammaTy])) primOpInfo AtomicModifyMutVar_Op = mkGenPrimOp (fsLit "atomicModifyMutVar_#") [deltaTyVarSpec, alphaTyVarSpec] [mkMutVarPrimTy deltaTy alphaTy, (mkVisFunTyMany (alphaTy) (alphaTy)), mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, alphaTy, alphaTy])) primOpInfo CasMutVarOp = mkGenPrimOp (fsLit "casMutVar#") [deltaTyVarSpec, alphaTyVarSpec] [mkMutVarPrimTy deltaTy alphaTy, alphaTy, alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, intPrimTy, alphaTy])) @@ -550,7 +545,6 @@ primOpInfo ReadTVarOp = mkGenPrimOp (fsLit "readTVar#") [deltaTyVarSpec, alphaTyVarSpec] [mkTVarPrimTy deltaTy alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, alphaTy])) primOpInfo ReadTVarIOOp = mkGenPrimOp (fsLit "readTVarIO#") [deltaTyVarSpec, alphaTyVarSpec] [mkTVarPrimTy deltaTy alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, alphaTy])) primOpInfo WriteTVarOp = mkGenPrimOp (fsLit "writeTVar#") [deltaTyVarSpec, alphaTyVarSpec] [mkTVarPrimTy deltaTy alphaTy, alphaTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) -primOpInfo SameTVarOp = mkGenPrimOp (fsLit "sameTVar#") [deltaTyVarSpec, alphaTyVarSpec] [mkTVarPrimTy deltaTy alphaTy, mkTVarPrimTy deltaTy alphaTy] (intPrimTy) primOpInfo NewMVarOp = mkGenPrimOp (fsLit "newMVar#") [deltaTyVarSpec, alphaTyVarSpec] [mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, mkMVarPrimTy deltaTy alphaTy])) primOpInfo TakeMVarOp = mkGenPrimOp (fsLit "takeMVar#") [deltaTyVarSpec, alphaTyVarSpec] [mkMVarPrimTy deltaTy alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, alphaTy])) primOpInfo TryTakeMVarOp = mkGenPrimOp (fsLit "tryTakeMVar#") [deltaTyVarSpec, alphaTyVarSpec] [mkMVarPrimTy deltaTy alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, intPrimTy, alphaTy])) @@ -558,12 +552,10 @@ primOpInfo TryPutMVarOp = mkGenPrimOp (fsLit "tryPutMVar#") [deltaTyVarSpec, alphaTyVarSpec] [mkMVarPrimTy deltaTy alphaTy, alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, intPrimTy])) primOpInfo ReadMVarOp = mkGenPrimOp (fsLit "readMVar#") [deltaTyVarSpec, alphaTyVarSpec] [mkMVarPrimTy deltaTy alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, alphaTy])) primOpInfo TryReadMVarOp = mkGenPrimOp (fsLit "tryReadMVar#") [deltaTyVarSpec, alphaTyVarSpec] [mkMVarPrimTy deltaTy alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, intPrimTy, alphaTy])) -primOpInfo SameMVarOp = mkGenPrimOp (fsLit "sameMVar#") [deltaTyVarSpec, alphaTyVarSpec] [mkMVarPrimTy deltaTy alphaTy, mkMVarPrimTy deltaTy alphaTy] (intPrimTy) primOpInfo IsEmptyMVarOp = mkGenPrimOp (fsLit "isEmptyMVar#") [deltaTyVarSpec, alphaTyVarSpec] [mkMVarPrimTy deltaTy alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, intPrimTy])) primOpInfo NewIOPortrOp = mkGenPrimOp (fsLit "newIOPort#") [deltaTyVarSpec, alphaTyVarSpec] [mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, mkIOPortPrimTy deltaTy alphaTy])) primOpInfo ReadIOPortOp = mkGenPrimOp (fsLit "readIOPort#") [deltaTyVarSpec, alphaTyVarSpec] [mkIOPortPrimTy deltaTy alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, alphaTy])) primOpInfo WriteIOPortOp = mkGenPrimOp (fsLit "writeIOPort#") [deltaTyVarSpec, alphaTyVarSpec] [mkIOPortPrimTy deltaTy alphaTy, alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, intPrimTy])) -primOpInfo SameIOPortOp = mkGenPrimOp (fsLit "sameIOPort#") [deltaTyVarSpec, alphaTyVarSpec] [mkIOPortPrimTy deltaTy alphaTy, mkIOPortPrimTy deltaTy alphaTy] (intPrimTy) primOpInfo DelayOp = mkGenPrimOp (fsLit "delay#") [deltaTyVarSpec] [intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) primOpInfo WaitReadOp = mkGenPrimOp (fsLit "waitRead#") [deltaTyVarSpec] [intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) primOpInfo WaitWriteOp = mkGenPrimOp (fsLit "waitWrite#") [deltaTyVarSpec] [intPrimTy, mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) @@ -576,17 +568,16 @@ primOpInfo IsCurrentThreadBoundOp = mkGenPrimOp (fsLit "isCurrentThreadBound#") [] [mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, intPrimTy])) primOpInfo NoDuplicateOp = mkGenPrimOp (fsLit "noDuplicate#") [deltaTyVarSpec] [mkStatePrimTy deltaTy] (mkStatePrimTy deltaTy) primOpInfo ThreadStatusOp = mkGenPrimOp (fsLit "threadStatus#") [] [threadIdPrimTy, mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, intPrimTy, intPrimTy, intPrimTy])) -primOpInfo MkWeakOp = mkGenPrimOp (fsLit "mkWeak#") [levity1TyVarInf, levPolyTyVar1Spec, betaTyVarSpec, gammaTyVarSpec] [levPolyTy1, betaTy, (mkVisFunTyMany (mkStatePrimTy realWorldTy) ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, gammaTy]))), mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, mkWeakPrimTy betaTy])) -primOpInfo MkWeakNoFinalizerOp = mkGenPrimOp (fsLit "mkWeakNoFinalizer#") [levity1TyVarInf, levPolyTyVar1Spec, betaTyVarSpec] [levPolyTy1, betaTy, mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, mkWeakPrimTy betaTy])) +primOpInfo MkWeakOp = mkGenPrimOp (fsLit "mkWeak#") [levity1TyVarInf, levPolyAlphaTyVarSpec, betaTyVarSpec, gammaTyVarSpec] [levPolyAlphaTy, betaTy, (mkVisFunTyMany (mkStatePrimTy realWorldTy) ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, gammaTy]))), mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, mkWeakPrimTy betaTy])) +primOpInfo MkWeakNoFinalizerOp = mkGenPrimOp (fsLit "mkWeakNoFinalizer#") [levity1TyVarInf, levPolyAlphaTyVarSpec, betaTyVarSpec] [levPolyAlphaTy, betaTy, mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, mkWeakPrimTy betaTy])) primOpInfo AddCFinalizerToWeakOp = mkGenPrimOp (fsLit "addCFinalizerToWeak#") [betaTyVarSpec] [addrPrimTy, addrPrimTy, intPrimTy, addrPrimTy, mkWeakPrimTy betaTy, mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, intPrimTy])) primOpInfo DeRefWeakOp = mkGenPrimOp (fsLit "deRefWeak#") [alphaTyVarSpec] [mkWeakPrimTy alphaTy, mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, intPrimTy, alphaTy])) primOpInfo FinalizeWeakOp = mkGenPrimOp (fsLit "finalizeWeak#") [alphaTyVarSpec, betaTyVarSpec] [mkWeakPrimTy alphaTy, mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, intPrimTy, (mkVisFunTyMany (mkStatePrimTy realWorldTy) ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, betaTy])))])) -primOpInfo TouchOp = mkGenPrimOp (fsLit "touch#") [levity1TyVarInf, levPolyTyVar1Spec] [levPolyTy1, mkStatePrimTy realWorldTy] (mkStatePrimTy realWorldTy) +primOpInfo TouchOp = mkGenPrimOp (fsLit "touch#") [levity1TyVarInf, levPolyAlphaTyVarSpec] [levPolyAlphaTy, mkStatePrimTy realWorldTy] (mkStatePrimTy realWorldTy) primOpInfo MakeStablePtrOp = mkGenPrimOp (fsLit "makeStablePtr#") [alphaTyVarSpec] [alphaTy, mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, mkStablePtrPrimTy alphaTy])) primOpInfo DeRefStablePtrOp = mkGenPrimOp (fsLit "deRefStablePtr#") [alphaTyVarSpec] [mkStablePtrPrimTy alphaTy, mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, alphaTy])) primOpInfo EqStablePtrOp = mkGenPrimOp (fsLit "eqStablePtr#") [alphaTyVarSpec] [mkStablePtrPrimTy alphaTy, mkStablePtrPrimTy alphaTy] (intPrimTy) primOpInfo MakeStableNameOp = mkGenPrimOp (fsLit "makeStableName#") [alphaTyVarSpec] [alphaTy, mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, mkStableNamePrimTy alphaTy])) -primOpInfo EqStableNameOp = mkGenPrimOp (fsLit "eqStableName#") [alphaTyVarSpec, betaTyVarSpec] [mkStableNamePrimTy alphaTy, mkStableNamePrimTy betaTy] (intPrimTy) primOpInfo StableNameToIntOp = mkGenPrimOp (fsLit "stableNameToInt#") [alphaTyVarSpec] [mkStableNamePrimTy alphaTy] (intPrimTy) primOpInfo CompactNewOp = mkGenPrimOp (fsLit "compactNew#") [] [wordPrimTy, mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, compactPrimTy])) primOpInfo CompactResizeOp = mkGenPrimOp (fsLit "compactResize#") [] [compactPrimTy, wordPrimTy, mkStatePrimTy realWorldTy] (mkStatePrimTy realWorldTy) @@ -599,13 +590,13 @@ primOpInfo CompactAdd = mkGenPrimOp (fsLit "compactAdd#") [alphaTyVarSpec] [compactPrimTy, alphaTy, mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, alphaTy])) primOpInfo CompactAddWithSharing = mkGenPrimOp (fsLit "compactAddWithSharing#") [alphaTyVarSpec] [compactPrimTy, alphaTy, mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, alphaTy])) primOpInfo CompactSize = mkGenPrimOp (fsLit "compactSize#") [] [compactPrimTy, mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, wordPrimTy])) -primOpInfo ReallyUnsafePtrEqualityOp = mkGenPrimOp (fsLit "reallyUnsafePtrEquality#") [alphaTyVarSpec] [alphaTy, alphaTy] (intPrimTy) +primOpInfo ReallyUnsafePtrEqualityOp = mkGenPrimOp (fsLit "reallyUnsafePtrEquality#") [levity1TyVarInf, levPolyAlphaTyVarSpec, levity2TyVarInf, levPolyBetaTyVarSpec] [levPolyAlphaTy, levPolyBetaTy] (intPrimTy) primOpInfo ParOp = mkGenPrimOp (fsLit "par#") [alphaTyVarSpec] [alphaTy] (intPrimTy) primOpInfo SparkOp = mkGenPrimOp (fsLit "spark#") [alphaTyVarSpec, deltaTyVarSpec] [alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, alphaTy])) primOpInfo SeqOp = mkGenPrimOp (fsLit "seq#") [alphaTyVarSpec, deltaTyVarSpec] [alphaTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, alphaTy])) primOpInfo GetSparkOp = mkGenPrimOp (fsLit "getSpark#") [deltaTyVarSpec, alphaTyVarSpec] [mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, intPrimTy, alphaTy])) primOpInfo NumSparks = mkGenPrimOp (fsLit "numSparks#") [deltaTyVarSpec] [mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, intPrimTy])) -primOpInfo KeepAliveOp = mkGenPrimOp (fsLit "keepAlive#") [levity1TyVarInf, levPolyTyVar1Spec, runtimeRep2TyVarInf, openBetaTyVarSpec] [levPolyTy1, mkStatePrimTy realWorldTy, (mkVisFunTyMany (mkStatePrimTy realWorldTy) (openBetaTy))] (openBetaTy) +primOpInfo KeepAliveOp = mkGenPrimOp (fsLit "keepAlive#") [levity1TyVarInf, levPolyAlphaTyVarSpec, runtimeRep2TyVarInf, openBetaTyVarSpec] [levPolyAlphaTy, mkStatePrimTy realWorldTy, (mkVisFunTyMany (mkStatePrimTy realWorldTy) (openBetaTy))] (openBetaTy) primOpInfo DataToTagOp = mkGenPrimOp (fsLit "dataToTag#") [alphaTyVarSpec] [alphaTy] (intPrimTy) primOpInfo TagToEnumOp = mkGenPrimOp (fsLit "tagToEnum#") [alphaTyVarSpec] [intPrimTy] (alphaTy) primOpInfo AddrToAnyOp = mkGenPrimOp (fsLit "addrToAny#") [alphaTyVarSpec] [addrPrimTy] ((mkTupleTy Unboxed [alphaTy])) diff --git a/ghc-lib/stage0/compiler/build/primop-tag.hs-incl b/ghc-lib/stage0/compiler/build/primop-tag.hs-incl --- a/ghc-lib/stage0/compiler/build/primop-tag.hs-incl +++ b/ghc-lib/stage0/compiler/build/primop-tag.hs-incl @@ -1,1286 +1,1277 @@ maxPrimOpTag :: Int -maxPrimOpTag = 1283 -primOpTag :: PrimOp -> Int -primOpTag CharGtOp = 1 -primOpTag CharGeOp = 2 -primOpTag CharEqOp = 3 -primOpTag CharNeOp = 4 -primOpTag CharLtOp = 5 -primOpTag CharLeOp = 6 -primOpTag OrdOp = 7 -primOpTag Int8ToIntOp = 8 -primOpTag IntToInt8Op = 9 -primOpTag Int8NegOp = 10 -primOpTag Int8AddOp = 11 -primOpTag Int8SubOp = 12 -primOpTag Int8MulOp = 13 -primOpTag Int8QuotOp = 14 -primOpTag Int8RemOp = 15 -primOpTag Int8QuotRemOp = 16 -primOpTag Int8SllOp = 17 -primOpTag Int8SraOp = 18 -primOpTag Int8SrlOp = 19 -primOpTag Int8ToWord8Op = 20 -primOpTag Int8EqOp = 21 -primOpTag Int8GeOp = 22 -primOpTag Int8GtOp = 23 -primOpTag Int8LeOp = 24 -primOpTag Int8LtOp = 25 -primOpTag Int8NeOp = 26 -primOpTag Word8ToWordOp = 27 -primOpTag WordToWord8Op = 28 -primOpTag Word8AddOp = 29 -primOpTag Word8SubOp = 30 -primOpTag Word8MulOp = 31 -primOpTag Word8QuotOp = 32 -primOpTag Word8RemOp = 33 -primOpTag Word8QuotRemOp = 34 -primOpTag Word8AndOp = 35 -primOpTag Word8OrOp = 36 -primOpTag Word8XorOp = 37 -primOpTag Word8NotOp = 38 -primOpTag Word8SllOp = 39 -primOpTag Word8SrlOp = 40 -primOpTag Word8ToInt8Op = 41 -primOpTag Word8EqOp = 42 -primOpTag Word8GeOp = 43 -primOpTag Word8GtOp = 44 -primOpTag Word8LeOp = 45 -primOpTag Word8LtOp = 46 -primOpTag Word8NeOp = 47 -primOpTag Int16ToIntOp = 48 -primOpTag IntToInt16Op = 49 -primOpTag Int16NegOp = 50 -primOpTag Int16AddOp = 51 -primOpTag Int16SubOp = 52 -primOpTag Int16MulOp = 53 -primOpTag Int16QuotOp = 54 -primOpTag Int16RemOp = 55 -primOpTag Int16QuotRemOp = 56 -primOpTag Int16SllOp = 57 -primOpTag Int16SraOp = 58 -primOpTag Int16SrlOp = 59 -primOpTag Int16ToWord16Op = 60 -primOpTag Int16EqOp = 61 -primOpTag Int16GeOp = 62 -primOpTag Int16GtOp = 63 -primOpTag Int16LeOp = 64 -primOpTag Int16LtOp = 65 -primOpTag Int16NeOp = 66 -primOpTag Word16ToWordOp = 67 -primOpTag WordToWord16Op = 68 -primOpTag Word16AddOp = 69 -primOpTag Word16SubOp = 70 -primOpTag Word16MulOp = 71 -primOpTag Word16QuotOp = 72 -primOpTag Word16RemOp = 73 -primOpTag Word16QuotRemOp = 74 -primOpTag Word16AndOp = 75 -primOpTag Word16OrOp = 76 -primOpTag Word16XorOp = 77 -primOpTag Word16NotOp = 78 -primOpTag Word16SllOp = 79 -primOpTag Word16SrlOp = 80 -primOpTag Word16ToInt16Op = 81 -primOpTag Word16EqOp = 82 -primOpTag Word16GeOp = 83 -primOpTag Word16GtOp = 84 -primOpTag Word16LeOp = 85 -primOpTag Word16LtOp = 86 -primOpTag Word16NeOp = 87 -primOpTag Int32ToIntOp = 88 -primOpTag IntToInt32Op = 89 -primOpTag Int32NegOp = 90 -primOpTag Int32AddOp = 91 -primOpTag Int32SubOp = 92 -primOpTag Int32MulOp = 93 -primOpTag Int32QuotOp = 94 -primOpTag Int32RemOp = 95 -primOpTag Int32QuotRemOp = 96 -primOpTag Int32SllOp = 97 -primOpTag Int32SraOp = 98 -primOpTag Int32SrlOp = 99 -primOpTag Int32ToWord32Op = 100 -primOpTag Int32EqOp = 101 -primOpTag Int32GeOp = 102 -primOpTag Int32GtOp = 103 -primOpTag Int32LeOp = 104 -primOpTag Int32LtOp = 105 -primOpTag Int32NeOp = 106 -primOpTag Word32ToWordOp = 107 -primOpTag WordToWord32Op = 108 -primOpTag Word32AddOp = 109 -primOpTag Word32SubOp = 110 -primOpTag Word32MulOp = 111 -primOpTag Word32QuotOp = 112 -primOpTag Word32RemOp = 113 -primOpTag Word32QuotRemOp = 114 -primOpTag Word32AndOp = 115 -primOpTag Word32OrOp = 116 -primOpTag Word32XorOp = 117 -primOpTag Word32NotOp = 118 -primOpTag Word32SllOp = 119 -primOpTag Word32SrlOp = 120 -primOpTag Word32ToInt32Op = 121 -primOpTag Word32EqOp = 122 -primOpTag Word32GeOp = 123 -primOpTag Word32GtOp = 124 -primOpTag Word32LeOp = 125 -primOpTag Word32LtOp = 126 -primOpTag Word32NeOp = 127 -primOpTag IntAddOp = 128 -primOpTag IntSubOp = 129 -primOpTag IntMulOp = 130 -primOpTag IntMul2Op = 131 -primOpTag IntMulMayOfloOp = 132 -primOpTag IntQuotOp = 133 -primOpTag IntRemOp = 134 -primOpTag IntQuotRemOp = 135 -primOpTag IntAndOp = 136 -primOpTag IntOrOp = 137 -primOpTag IntXorOp = 138 -primOpTag IntNotOp = 139 -primOpTag IntNegOp = 140 -primOpTag IntAddCOp = 141 -primOpTag IntSubCOp = 142 -primOpTag IntGtOp = 143 -primOpTag IntGeOp = 144 -primOpTag IntEqOp = 145 -primOpTag IntNeOp = 146 -primOpTag IntLtOp = 147 -primOpTag IntLeOp = 148 -primOpTag ChrOp = 149 -primOpTag IntToWordOp = 150 -primOpTag IntToFloatOp = 151 -primOpTag IntToDoubleOp = 152 -primOpTag WordToFloatOp = 153 -primOpTag WordToDoubleOp = 154 -primOpTag IntSllOp = 155 -primOpTag IntSraOp = 156 -primOpTag IntSrlOp = 157 -primOpTag WordAddOp = 158 -primOpTag WordAddCOp = 159 -primOpTag WordSubCOp = 160 -primOpTag WordAdd2Op = 161 -primOpTag WordSubOp = 162 -primOpTag WordMulOp = 163 -primOpTag WordMul2Op = 164 -primOpTag WordQuotOp = 165 -primOpTag WordRemOp = 166 -primOpTag WordQuotRemOp = 167 -primOpTag WordQuotRem2Op = 168 -primOpTag WordAndOp = 169 -primOpTag WordOrOp = 170 -primOpTag WordXorOp = 171 -primOpTag WordNotOp = 172 -primOpTag WordSllOp = 173 -primOpTag WordSrlOp = 174 -primOpTag WordToIntOp = 175 -primOpTag WordGtOp = 176 -primOpTag WordGeOp = 177 -primOpTag WordEqOp = 178 -primOpTag WordNeOp = 179 -primOpTag WordLtOp = 180 -primOpTag WordLeOp = 181 -primOpTag PopCnt8Op = 182 -primOpTag PopCnt16Op = 183 -primOpTag PopCnt32Op = 184 -primOpTag PopCnt64Op = 185 -primOpTag PopCntOp = 186 -primOpTag Pdep8Op = 187 -primOpTag Pdep16Op = 188 -primOpTag Pdep32Op = 189 -primOpTag Pdep64Op = 190 -primOpTag PdepOp = 191 -primOpTag Pext8Op = 192 -primOpTag Pext16Op = 193 -primOpTag Pext32Op = 194 -primOpTag Pext64Op = 195 -primOpTag PextOp = 196 -primOpTag Clz8Op = 197 -primOpTag Clz16Op = 198 -primOpTag Clz32Op = 199 -primOpTag Clz64Op = 200 -primOpTag ClzOp = 201 -primOpTag Ctz8Op = 202 -primOpTag Ctz16Op = 203 -primOpTag Ctz32Op = 204 -primOpTag Ctz64Op = 205 -primOpTag CtzOp = 206 -primOpTag BSwap16Op = 207 -primOpTag BSwap32Op = 208 -primOpTag BSwap64Op = 209 -primOpTag BSwapOp = 210 -primOpTag BRev8Op = 211 -primOpTag BRev16Op = 212 -primOpTag BRev32Op = 213 -primOpTag BRev64Op = 214 -primOpTag BRevOp = 215 -primOpTag Narrow8IntOp = 216 -primOpTag Narrow16IntOp = 217 -primOpTag Narrow32IntOp = 218 -primOpTag Narrow8WordOp = 219 -primOpTag Narrow16WordOp = 220 -primOpTag Narrow32WordOp = 221 -primOpTag DoubleGtOp = 222 -primOpTag DoubleGeOp = 223 -primOpTag DoubleEqOp = 224 -primOpTag DoubleNeOp = 225 -primOpTag DoubleLtOp = 226 -primOpTag DoubleLeOp = 227 -primOpTag DoubleAddOp = 228 -primOpTag DoubleSubOp = 229 -primOpTag DoubleMulOp = 230 -primOpTag DoubleDivOp = 231 -primOpTag DoubleNegOp = 232 -primOpTag DoubleFabsOp = 233 -primOpTag DoubleToIntOp = 234 -primOpTag DoubleToFloatOp = 235 -primOpTag DoubleExpOp = 236 -primOpTag DoubleExpM1Op = 237 -primOpTag DoubleLogOp = 238 -primOpTag DoubleLog1POp = 239 -primOpTag DoubleSqrtOp = 240 -primOpTag DoubleSinOp = 241 -primOpTag DoubleCosOp = 242 -primOpTag DoubleTanOp = 243 -primOpTag DoubleAsinOp = 244 -primOpTag DoubleAcosOp = 245 -primOpTag DoubleAtanOp = 246 -primOpTag DoubleSinhOp = 247 -primOpTag DoubleCoshOp = 248 -primOpTag DoubleTanhOp = 249 -primOpTag DoubleAsinhOp = 250 -primOpTag DoubleAcoshOp = 251 -primOpTag DoubleAtanhOp = 252 -primOpTag DoublePowerOp = 253 -primOpTag DoubleDecode_2IntOp = 254 -primOpTag DoubleDecode_Int64Op = 255 -primOpTag FloatGtOp = 256 -primOpTag FloatGeOp = 257 -primOpTag FloatEqOp = 258 -primOpTag FloatNeOp = 259 -primOpTag FloatLtOp = 260 -primOpTag FloatLeOp = 261 -primOpTag FloatAddOp = 262 -primOpTag FloatSubOp = 263 -primOpTag FloatMulOp = 264 -primOpTag FloatDivOp = 265 -primOpTag FloatNegOp = 266 -primOpTag FloatFabsOp = 267 -primOpTag FloatToIntOp = 268 -primOpTag FloatExpOp = 269 -primOpTag FloatExpM1Op = 270 -primOpTag FloatLogOp = 271 -primOpTag FloatLog1POp = 272 -primOpTag FloatSqrtOp = 273 -primOpTag FloatSinOp = 274 -primOpTag FloatCosOp = 275 -primOpTag FloatTanOp = 276 -primOpTag FloatAsinOp = 277 -primOpTag FloatAcosOp = 278 -primOpTag FloatAtanOp = 279 -primOpTag FloatSinhOp = 280 -primOpTag FloatCoshOp = 281 -primOpTag FloatTanhOp = 282 -primOpTag FloatAsinhOp = 283 -primOpTag FloatAcoshOp = 284 -primOpTag FloatAtanhOp = 285 -primOpTag FloatPowerOp = 286 -primOpTag FloatToDoubleOp = 287 -primOpTag FloatDecode_IntOp = 288 -primOpTag NewArrayOp = 289 -primOpTag SameMutableArrayOp = 290 -primOpTag ReadArrayOp = 291 -primOpTag WriteArrayOp = 292 -primOpTag SizeofArrayOp = 293 -primOpTag SizeofMutableArrayOp = 294 -primOpTag IndexArrayOp = 295 -primOpTag UnsafeFreezeArrayOp = 296 -primOpTag UnsafeThawArrayOp = 297 -primOpTag CopyArrayOp = 298 -primOpTag CopyMutableArrayOp = 299 -primOpTag CloneArrayOp = 300 -primOpTag CloneMutableArrayOp = 301 -primOpTag FreezeArrayOp = 302 -primOpTag ThawArrayOp = 303 -primOpTag CasArrayOp = 304 -primOpTag NewSmallArrayOp = 305 -primOpTag SameSmallMutableArrayOp = 306 -primOpTag ShrinkSmallMutableArrayOp_Char = 307 -primOpTag ReadSmallArrayOp = 308 -primOpTag WriteSmallArrayOp = 309 -primOpTag SizeofSmallArrayOp = 310 -primOpTag SizeofSmallMutableArrayOp = 311 -primOpTag GetSizeofSmallMutableArrayOp = 312 -primOpTag IndexSmallArrayOp = 313 -primOpTag UnsafeFreezeSmallArrayOp = 314 -primOpTag UnsafeThawSmallArrayOp = 315 -primOpTag CopySmallArrayOp = 316 -primOpTag CopySmallMutableArrayOp = 317 -primOpTag CloneSmallArrayOp = 318 -primOpTag CloneSmallMutableArrayOp = 319 -primOpTag FreezeSmallArrayOp = 320 -primOpTag ThawSmallArrayOp = 321 -primOpTag CasSmallArrayOp = 322 -primOpTag NewByteArrayOp_Char = 323 -primOpTag NewPinnedByteArrayOp_Char = 324 -primOpTag NewAlignedPinnedByteArrayOp_Char = 325 -primOpTag MutableByteArrayIsPinnedOp = 326 -primOpTag ByteArrayIsPinnedOp = 327 -primOpTag ByteArrayContents_Char = 328 -primOpTag MutableByteArrayContents_Char = 329 -primOpTag SameMutableByteArrayOp = 330 -primOpTag ShrinkMutableByteArrayOp_Char = 331 -primOpTag ResizeMutableByteArrayOp_Char = 332 -primOpTag UnsafeFreezeByteArrayOp = 333 -primOpTag SizeofByteArrayOp = 334 -primOpTag SizeofMutableByteArrayOp = 335 -primOpTag GetSizeofMutableByteArrayOp = 336 -primOpTag IndexByteArrayOp_Char = 337 -primOpTag IndexByteArrayOp_WideChar = 338 -primOpTag IndexByteArrayOp_Int = 339 -primOpTag IndexByteArrayOp_Word = 340 -primOpTag IndexByteArrayOp_Addr = 341 -primOpTag IndexByteArrayOp_Float = 342 -primOpTag IndexByteArrayOp_Double = 343 -primOpTag IndexByteArrayOp_StablePtr = 344 -primOpTag IndexByteArrayOp_Int8 = 345 -primOpTag IndexByteArrayOp_Int16 = 346 -primOpTag IndexByteArrayOp_Int32 = 347 -primOpTag IndexByteArrayOp_Int64 = 348 -primOpTag IndexByteArrayOp_Word8 = 349 -primOpTag IndexByteArrayOp_Word16 = 350 -primOpTag IndexByteArrayOp_Word32 = 351 -primOpTag IndexByteArrayOp_Word64 = 352 -primOpTag IndexByteArrayOp_Word8AsChar = 353 -primOpTag IndexByteArrayOp_Word8AsWideChar = 354 -primOpTag IndexByteArrayOp_Word8AsInt = 355 -primOpTag IndexByteArrayOp_Word8AsWord = 356 -primOpTag IndexByteArrayOp_Word8AsAddr = 357 -primOpTag IndexByteArrayOp_Word8AsFloat = 358 -primOpTag IndexByteArrayOp_Word8AsDouble = 359 -primOpTag IndexByteArrayOp_Word8AsStablePtr = 360 -primOpTag IndexByteArrayOp_Word8AsInt16 = 361 -primOpTag IndexByteArrayOp_Word8AsInt32 = 362 -primOpTag IndexByteArrayOp_Word8AsInt64 = 363 -primOpTag IndexByteArrayOp_Word8AsWord16 = 364 -primOpTag IndexByteArrayOp_Word8AsWord32 = 365 -primOpTag IndexByteArrayOp_Word8AsWord64 = 366 -primOpTag ReadByteArrayOp_Char = 367 -primOpTag ReadByteArrayOp_WideChar = 368 -primOpTag ReadByteArrayOp_Int = 369 -primOpTag ReadByteArrayOp_Word = 370 -primOpTag ReadByteArrayOp_Addr = 371 -primOpTag ReadByteArrayOp_Float = 372 -primOpTag ReadByteArrayOp_Double = 373 -primOpTag ReadByteArrayOp_StablePtr = 374 -primOpTag ReadByteArrayOp_Int8 = 375 -primOpTag ReadByteArrayOp_Int16 = 376 -primOpTag ReadByteArrayOp_Int32 = 377 -primOpTag ReadByteArrayOp_Int64 = 378 -primOpTag ReadByteArrayOp_Word8 = 379 -primOpTag ReadByteArrayOp_Word16 = 380 -primOpTag ReadByteArrayOp_Word32 = 381 -primOpTag ReadByteArrayOp_Word64 = 382 -primOpTag ReadByteArrayOp_Word8AsChar = 383 -primOpTag ReadByteArrayOp_Word8AsWideChar = 384 -primOpTag ReadByteArrayOp_Word8AsInt = 385 -primOpTag ReadByteArrayOp_Word8AsWord = 386 -primOpTag ReadByteArrayOp_Word8AsAddr = 387 -primOpTag ReadByteArrayOp_Word8AsFloat = 388 -primOpTag ReadByteArrayOp_Word8AsDouble = 389 -primOpTag ReadByteArrayOp_Word8AsStablePtr = 390 -primOpTag ReadByteArrayOp_Word8AsInt16 = 391 -primOpTag ReadByteArrayOp_Word8AsInt32 = 392 -primOpTag ReadByteArrayOp_Word8AsInt64 = 393 -primOpTag ReadByteArrayOp_Word8AsWord16 = 394 -primOpTag ReadByteArrayOp_Word8AsWord32 = 395 -primOpTag ReadByteArrayOp_Word8AsWord64 = 396 -primOpTag WriteByteArrayOp_Char = 397 -primOpTag WriteByteArrayOp_WideChar = 398 -primOpTag WriteByteArrayOp_Int = 399 -primOpTag WriteByteArrayOp_Word = 400 -primOpTag WriteByteArrayOp_Addr = 401 -primOpTag WriteByteArrayOp_Float = 402 -primOpTag WriteByteArrayOp_Double = 403 -primOpTag WriteByteArrayOp_StablePtr = 404 -primOpTag WriteByteArrayOp_Int8 = 405 -primOpTag WriteByteArrayOp_Int16 = 406 -primOpTag WriteByteArrayOp_Int32 = 407 -primOpTag WriteByteArrayOp_Int64 = 408 -primOpTag WriteByteArrayOp_Word8 = 409 -primOpTag WriteByteArrayOp_Word16 = 410 -primOpTag WriteByteArrayOp_Word32 = 411 -primOpTag WriteByteArrayOp_Word64 = 412 -primOpTag WriteByteArrayOp_Word8AsChar = 413 -primOpTag WriteByteArrayOp_Word8AsWideChar = 414 -primOpTag WriteByteArrayOp_Word8AsInt = 415 -primOpTag WriteByteArrayOp_Word8AsWord = 416 -primOpTag WriteByteArrayOp_Word8AsAddr = 417 -primOpTag WriteByteArrayOp_Word8AsFloat = 418 -primOpTag WriteByteArrayOp_Word8AsDouble = 419 -primOpTag WriteByteArrayOp_Word8AsStablePtr = 420 -primOpTag WriteByteArrayOp_Word8AsInt16 = 421 -primOpTag WriteByteArrayOp_Word8AsInt32 = 422 -primOpTag WriteByteArrayOp_Word8AsInt64 = 423 -primOpTag WriteByteArrayOp_Word8AsWord16 = 424 -primOpTag WriteByteArrayOp_Word8AsWord32 = 425 -primOpTag WriteByteArrayOp_Word8AsWord64 = 426 -primOpTag CompareByteArraysOp = 427 -primOpTag CopyByteArrayOp = 428 -primOpTag CopyMutableByteArrayOp = 429 -primOpTag CopyByteArrayToAddrOp = 430 -primOpTag CopyMutableByteArrayToAddrOp = 431 -primOpTag CopyAddrToByteArrayOp = 432 -primOpTag SetByteArrayOp = 433 -primOpTag AtomicReadByteArrayOp_Int = 434 -primOpTag AtomicWriteByteArrayOp_Int = 435 -primOpTag CasByteArrayOp_Int = 436 -primOpTag FetchAddByteArrayOp_Int = 437 -primOpTag FetchSubByteArrayOp_Int = 438 -primOpTag FetchAndByteArrayOp_Int = 439 -primOpTag FetchNandByteArrayOp_Int = 440 -primOpTag FetchOrByteArrayOp_Int = 441 -primOpTag FetchXorByteArrayOp_Int = 442 -primOpTag NewArrayArrayOp = 443 -primOpTag SameMutableArrayArrayOp = 444 -primOpTag UnsafeFreezeArrayArrayOp = 445 -primOpTag SizeofArrayArrayOp = 446 -primOpTag SizeofMutableArrayArrayOp = 447 -primOpTag IndexArrayArrayOp_ByteArray = 448 -primOpTag IndexArrayArrayOp_ArrayArray = 449 -primOpTag ReadArrayArrayOp_ByteArray = 450 -primOpTag ReadArrayArrayOp_MutableByteArray = 451 -primOpTag ReadArrayArrayOp_ArrayArray = 452 -primOpTag ReadArrayArrayOp_MutableArrayArray = 453 -primOpTag WriteArrayArrayOp_ByteArray = 454 -primOpTag WriteArrayArrayOp_MutableByteArray = 455 -primOpTag WriteArrayArrayOp_ArrayArray = 456 -primOpTag WriteArrayArrayOp_MutableArrayArray = 457 -primOpTag CopyArrayArrayOp = 458 -primOpTag CopyMutableArrayArrayOp = 459 -primOpTag AddrAddOp = 460 -primOpTag AddrSubOp = 461 -primOpTag AddrRemOp = 462 -primOpTag AddrToIntOp = 463 -primOpTag IntToAddrOp = 464 -primOpTag AddrGtOp = 465 -primOpTag AddrGeOp = 466 -primOpTag AddrEqOp = 467 -primOpTag AddrNeOp = 468 -primOpTag AddrLtOp = 469 -primOpTag AddrLeOp = 470 -primOpTag IndexOffAddrOp_Char = 471 -primOpTag IndexOffAddrOp_WideChar = 472 -primOpTag IndexOffAddrOp_Int = 473 -primOpTag IndexOffAddrOp_Word = 474 -primOpTag IndexOffAddrOp_Addr = 475 -primOpTag IndexOffAddrOp_Float = 476 -primOpTag IndexOffAddrOp_Double = 477 -primOpTag IndexOffAddrOp_StablePtr = 478 -primOpTag IndexOffAddrOp_Int8 = 479 -primOpTag IndexOffAddrOp_Int16 = 480 -primOpTag IndexOffAddrOp_Int32 = 481 -primOpTag IndexOffAddrOp_Int64 = 482 -primOpTag IndexOffAddrOp_Word8 = 483 -primOpTag IndexOffAddrOp_Word16 = 484 -primOpTag IndexOffAddrOp_Word32 = 485 -primOpTag IndexOffAddrOp_Word64 = 486 -primOpTag ReadOffAddrOp_Char = 487 -primOpTag ReadOffAddrOp_WideChar = 488 -primOpTag ReadOffAddrOp_Int = 489 -primOpTag ReadOffAddrOp_Word = 490 -primOpTag ReadOffAddrOp_Addr = 491 -primOpTag ReadOffAddrOp_Float = 492 -primOpTag ReadOffAddrOp_Double = 493 -primOpTag ReadOffAddrOp_StablePtr = 494 -primOpTag ReadOffAddrOp_Int8 = 495 -primOpTag ReadOffAddrOp_Int16 = 496 -primOpTag ReadOffAddrOp_Int32 = 497 -primOpTag ReadOffAddrOp_Int64 = 498 -primOpTag ReadOffAddrOp_Word8 = 499 -primOpTag ReadOffAddrOp_Word16 = 500 -primOpTag ReadOffAddrOp_Word32 = 501 -primOpTag ReadOffAddrOp_Word64 = 502 -primOpTag WriteOffAddrOp_Char = 503 -primOpTag WriteOffAddrOp_WideChar = 504 -primOpTag WriteOffAddrOp_Int = 505 -primOpTag WriteOffAddrOp_Word = 506 -primOpTag WriteOffAddrOp_Addr = 507 -primOpTag WriteOffAddrOp_Float = 508 -primOpTag WriteOffAddrOp_Double = 509 -primOpTag WriteOffAddrOp_StablePtr = 510 -primOpTag WriteOffAddrOp_Int8 = 511 -primOpTag WriteOffAddrOp_Int16 = 512 -primOpTag WriteOffAddrOp_Int32 = 513 -primOpTag WriteOffAddrOp_Int64 = 514 -primOpTag WriteOffAddrOp_Word8 = 515 -primOpTag WriteOffAddrOp_Word16 = 516 -primOpTag WriteOffAddrOp_Word32 = 517 -primOpTag WriteOffAddrOp_Word64 = 518 -primOpTag InterlockedExchange_Addr = 519 -primOpTag InterlockedExchange_Word = 520 -primOpTag CasAddrOp_Addr = 521 -primOpTag CasAddrOp_Word = 522 -primOpTag FetchAddAddrOp_Word = 523 -primOpTag FetchSubAddrOp_Word = 524 -primOpTag FetchAndAddrOp_Word = 525 -primOpTag FetchNandAddrOp_Word = 526 -primOpTag FetchOrAddrOp_Word = 527 -primOpTag FetchXorAddrOp_Word = 528 -primOpTag AtomicReadAddrOp_Word = 529 -primOpTag AtomicWriteAddrOp_Word = 530 -primOpTag NewMutVarOp = 531 -primOpTag ReadMutVarOp = 532 -primOpTag WriteMutVarOp = 533 -primOpTag SameMutVarOp = 534 -primOpTag AtomicModifyMutVar2Op = 535 -primOpTag AtomicModifyMutVar_Op = 536 -primOpTag CasMutVarOp = 537 -primOpTag CatchOp = 538 -primOpTag RaiseOp = 539 -primOpTag RaiseIOOp = 540 -primOpTag MaskAsyncExceptionsOp = 541 -primOpTag MaskUninterruptibleOp = 542 -primOpTag UnmaskAsyncExceptionsOp = 543 -primOpTag MaskStatus = 544 -primOpTag AtomicallyOp = 545 -primOpTag RetryOp = 546 -primOpTag CatchRetryOp = 547 -primOpTag CatchSTMOp = 548 -primOpTag NewTVarOp = 549 -primOpTag ReadTVarOp = 550 -primOpTag ReadTVarIOOp = 551 -primOpTag WriteTVarOp = 552 -primOpTag SameTVarOp = 553 -primOpTag NewMVarOp = 554 -primOpTag TakeMVarOp = 555 -primOpTag TryTakeMVarOp = 556 -primOpTag PutMVarOp = 557 -primOpTag TryPutMVarOp = 558 -primOpTag ReadMVarOp = 559 -primOpTag TryReadMVarOp = 560 -primOpTag SameMVarOp = 561 -primOpTag IsEmptyMVarOp = 562 -primOpTag NewIOPortrOp = 563 -primOpTag ReadIOPortOp = 564 -primOpTag WriteIOPortOp = 565 -primOpTag SameIOPortOp = 566 -primOpTag DelayOp = 567 -primOpTag WaitReadOp = 568 -primOpTag WaitWriteOp = 569 -primOpTag ForkOp = 570 -primOpTag ForkOnOp = 571 -primOpTag KillThreadOp = 572 -primOpTag YieldOp = 573 -primOpTag MyThreadIdOp = 574 -primOpTag LabelThreadOp = 575 -primOpTag IsCurrentThreadBoundOp = 576 -primOpTag NoDuplicateOp = 577 -primOpTag ThreadStatusOp = 578 -primOpTag MkWeakOp = 579 -primOpTag MkWeakNoFinalizerOp = 580 -primOpTag AddCFinalizerToWeakOp = 581 -primOpTag DeRefWeakOp = 582 -primOpTag FinalizeWeakOp = 583 -primOpTag TouchOp = 584 -primOpTag MakeStablePtrOp = 585 -primOpTag DeRefStablePtrOp = 586 -primOpTag EqStablePtrOp = 587 -primOpTag MakeStableNameOp = 588 -primOpTag EqStableNameOp = 589 -primOpTag StableNameToIntOp = 590 -primOpTag CompactNewOp = 591 -primOpTag CompactResizeOp = 592 -primOpTag CompactContainsOp = 593 -primOpTag CompactContainsAnyOp = 594 -primOpTag CompactGetFirstBlockOp = 595 -primOpTag CompactGetNextBlockOp = 596 -primOpTag CompactAllocateBlockOp = 597 -primOpTag CompactFixupPointersOp = 598 -primOpTag CompactAdd = 599 -primOpTag CompactAddWithSharing = 600 -primOpTag CompactSize = 601 -primOpTag ReallyUnsafePtrEqualityOp = 602 -primOpTag ParOp = 603 -primOpTag SparkOp = 604 -primOpTag SeqOp = 605 -primOpTag GetSparkOp = 606 -primOpTag NumSparks = 607 -primOpTag KeepAliveOp = 608 -primOpTag DataToTagOp = 609 -primOpTag TagToEnumOp = 610 -primOpTag AddrToAnyOp = 611 -primOpTag AnyToAddrOp = 612 -primOpTag MkApUpd0_Op = 613 -primOpTag NewBCOOp = 614 -primOpTag UnpackClosureOp = 615 -primOpTag ClosureSizeOp = 616 -primOpTag GetApStackValOp = 617 -primOpTag GetCCSOfOp = 618 -primOpTag GetCurrentCCSOp = 619 -primOpTag ClearCCSOp = 620 -primOpTag WhereFromOp = 621 -primOpTag TraceEventOp = 622 -primOpTag TraceEventBinaryOp = 623 -primOpTag TraceMarkerOp = 624 -primOpTag SetThreadAllocationCounter = 625 -primOpTag (VecBroadcastOp IntVec 16 W8) = 626 -primOpTag (VecBroadcastOp IntVec 8 W16) = 627 -primOpTag (VecBroadcastOp IntVec 4 W32) = 628 -primOpTag (VecBroadcastOp IntVec 2 W64) = 629 -primOpTag (VecBroadcastOp IntVec 32 W8) = 630 -primOpTag (VecBroadcastOp IntVec 16 W16) = 631 -primOpTag (VecBroadcastOp IntVec 8 W32) = 632 -primOpTag (VecBroadcastOp IntVec 4 W64) = 633 -primOpTag (VecBroadcastOp IntVec 64 W8) = 634 -primOpTag (VecBroadcastOp IntVec 32 W16) = 635 -primOpTag (VecBroadcastOp IntVec 16 W32) = 636 -primOpTag (VecBroadcastOp IntVec 8 W64) = 637 -primOpTag (VecBroadcastOp WordVec 16 W8) = 638 -primOpTag (VecBroadcastOp WordVec 8 W16) = 639 -primOpTag (VecBroadcastOp WordVec 4 W32) = 640 -primOpTag (VecBroadcastOp WordVec 2 W64) = 641 -primOpTag (VecBroadcastOp WordVec 32 W8) = 642 -primOpTag (VecBroadcastOp WordVec 16 W16) = 643 -primOpTag (VecBroadcastOp WordVec 8 W32) = 644 -primOpTag (VecBroadcastOp WordVec 4 W64) = 645 -primOpTag (VecBroadcastOp WordVec 64 W8) = 646 -primOpTag (VecBroadcastOp WordVec 32 W16) = 647 -primOpTag (VecBroadcastOp WordVec 16 W32) = 648 -primOpTag (VecBroadcastOp WordVec 8 W64) = 649 -primOpTag (VecBroadcastOp FloatVec 4 W32) = 650 -primOpTag (VecBroadcastOp FloatVec 2 W64) = 651 -primOpTag (VecBroadcastOp FloatVec 8 W32) = 652 -primOpTag (VecBroadcastOp FloatVec 4 W64) = 653 -primOpTag (VecBroadcastOp FloatVec 16 W32) = 654 -primOpTag (VecBroadcastOp FloatVec 8 W64) = 655 -primOpTag (VecPackOp IntVec 16 W8) = 656 -primOpTag (VecPackOp IntVec 8 W16) = 657 -primOpTag (VecPackOp IntVec 4 W32) = 658 -primOpTag (VecPackOp IntVec 2 W64) = 659 -primOpTag (VecPackOp IntVec 32 W8) = 660 -primOpTag (VecPackOp IntVec 16 W16) = 661 -primOpTag (VecPackOp IntVec 8 W32) = 662 -primOpTag (VecPackOp IntVec 4 W64) = 663 -primOpTag (VecPackOp IntVec 64 W8) = 664 -primOpTag (VecPackOp IntVec 32 W16) = 665 -primOpTag (VecPackOp IntVec 16 W32) = 666 -primOpTag (VecPackOp IntVec 8 W64) = 667 -primOpTag (VecPackOp WordVec 16 W8) = 668 -primOpTag (VecPackOp WordVec 8 W16) = 669 -primOpTag (VecPackOp WordVec 4 W32) = 670 -primOpTag (VecPackOp WordVec 2 W64) = 671 -primOpTag (VecPackOp WordVec 32 W8) = 672 -primOpTag (VecPackOp WordVec 16 W16) = 673 -primOpTag (VecPackOp WordVec 8 W32) = 674 -primOpTag (VecPackOp WordVec 4 W64) = 675 -primOpTag (VecPackOp WordVec 64 W8) = 676 -primOpTag (VecPackOp WordVec 32 W16) = 677 -primOpTag (VecPackOp WordVec 16 W32) = 678 -primOpTag (VecPackOp WordVec 8 W64) = 679 -primOpTag (VecPackOp FloatVec 4 W32) = 680 -primOpTag (VecPackOp FloatVec 2 W64) = 681 -primOpTag (VecPackOp FloatVec 8 W32) = 682 -primOpTag (VecPackOp FloatVec 4 W64) = 683 -primOpTag (VecPackOp FloatVec 16 W32) = 684 -primOpTag (VecPackOp FloatVec 8 W64) = 685 -primOpTag (VecUnpackOp IntVec 16 W8) = 686 -primOpTag (VecUnpackOp IntVec 8 W16) = 687 -primOpTag (VecUnpackOp IntVec 4 W32) = 688 -primOpTag (VecUnpackOp IntVec 2 W64) = 689 -primOpTag (VecUnpackOp IntVec 32 W8) = 690 -primOpTag (VecUnpackOp IntVec 16 W16) = 691 -primOpTag (VecUnpackOp IntVec 8 W32) = 692 -primOpTag (VecUnpackOp IntVec 4 W64) = 693 -primOpTag (VecUnpackOp IntVec 64 W8) = 694 -primOpTag (VecUnpackOp IntVec 32 W16) = 695 -primOpTag (VecUnpackOp IntVec 16 W32) = 696 -primOpTag (VecUnpackOp IntVec 8 W64) = 697 -primOpTag (VecUnpackOp WordVec 16 W8) = 698 -primOpTag (VecUnpackOp WordVec 8 W16) = 699 -primOpTag (VecUnpackOp WordVec 4 W32) = 700 -primOpTag (VecUnpackOp WordVec 2 W64) = 701 -primOpTag (VecUnpackOp WordVec 32 W8) = 702 -primOpTag (VecUnpackOp WordVec 16 W16) = 703 -primOpTag (VecUnpackOp WordVec 8 W32) = 704 -primOpTag (VecUnpackOp WordVec 4 W64) = 705 -primOpTag (VecUnpackOp WordVec 64 W8) = 706 -primOpTag (VecUnpackOp WordVec 32 W16) = 707 -primOpTag (VecUnpackOp WordVec 16 W32) = 708 -primOpTag (VecUnpackOp WordVec 8 W64) = 709 -primOpTag (VecUnpackOp FloatVec 4 W32) = 710 -primOpTag (VecUnpackOp FloatVec 2 W64) = 711 -primOpTag (VecUnpackOp FloatVec 8 W32) = 712 -primOpTag (VecUnpackOp FloatVec 4 W64) = 713 -primOpTag (VecUnpackOp FloatVec 16 W32) = 714 -primOpTag (VecUnpackOp FloatVec 8 W64) = 715 -primOpTag (VecInsertOp IntVec 16 W8) = 716 -primOpTag (VecInsertOp IntVec 8 W16) = 717 -primOpTag (VecInsertOp IntVec 4 W32) = 718 -primOpTag (VecInsertOp IntVec 2 W64) = 719 -primOpTag (VecInsertOp IntVec 32 W8) = 720 -primOpTag (VecInsertOp IntVec 16 W16) = 721 -primOpTag (VecInsertOp IntVec 8 W32) = 722 -primOpTag (VecInsertOp IntVec 4 W64) = 723 -primOpTag (VecInsertOp IntVec 64 W8) = 724 -primOpTag (VecInsertOp IntVec 32 W16) = 725 -primOpTag (VecInsertOp IntVec 16 W32) = 726 -primOpTag (VecInsertOp IntVec 8 W64) = 727 -primOpTag (VecInsertOp WordVec 16 W8) = 728 -primOpTag (VecInsertOp WordVec 8 W16) = 729 -primOpTag (VecInsertOp WordVec 4 W32) = 730 -primOpTag (VecInsertOp WordVec 2 W64) = 731 -primOpTag (VecInsertOp WordVec 32 W8) = 732 -primOpTag (VecInsertOp WordVec 16 W16) = 733 -primOpTag (VecInsertOp WordVec 8 W32) = 734 -primOpTag (VecInsertOp WordVec 4 W64) = 735 -primOpTag (VecInsertOp WordVec 64 W8) = 736 -primOpTag (VecInsertOp WordVec 32 W16) = 737 -primOpTag (VecInsertOp WordVec 16 W32) = 738 -primOpTag (VecInsertOp WordVec 8 W64) = 739 -primOpTag (VecInsertOp FloatVec 4 W32) = 740 -primOpTag (VecInsertOp FloatVec 2 W64) = 741 -primOpTag (VecInsertOp FloatVec 8 W32) = 742 -primOpTag (VecInsertOp FloatVec 4 W64) = 743 -primOpTag (VecInsertOp FloatVec 16 W32) = 744 -primOpTag (VecInsertOp FloatVec 8 W64) = 745 -primOpTag (VecAddOp IntVec 16 W8) = 746 -primOpTag (VecAddOp IntVec 8 W16) = 747 -primOpTag (VecAddOp IntVec 4 W32) = 748 -primOpTag (VecAddOp IntVec 2 W64) = 749 -primOpTag (VecAddOp IntVec 32 W8) = 750 -primOpTag (VecAddOp IntVec 16 W16) = 751 -primOpTag (VecAddOp IntVec 8 W32) = 752 -primOpTag (VecAddOp IntVec 4 W64) = 753 -primOpTag (VecAddOp IntVec 64 W8) = 754 -primOpTag (VecAddOp IntVec 32 W16) = 755 -primOpTag (VecAddOp IntVec 16 W32) = 756 -primOpTag (VecAddOp IntVec 8 W64) = 757 -primOpTag (VecAddOp WordVec 16 W8) = 758 -primOpTag (VecAddOp WordVec 8 W16) = 759 -primOpTag (VecAddOp WordVec 4 W32) = 760 -primOpTag (VecAddOp WordVec 2 W64) = 761 -primOpTag (VecAddOp WordVec 32 W8) = 762 -primOpTag (VecAddOp WordVec 16 W16) = 763 -primOpTag (VecAddOp WordVec 8 W32) = 764 -primOpTag (VecAddOp WordVec 4 W64) = 765 -primOpTag (VecAddOp WordVec 64 W8) = 766 -primOpTag (VecAddOp WordVec 32 W16) = 767 -primOpTag (VecAddOp WordVec 16 W32) = 768 -primOpTag (VecAddOp WordVec 8 W64) = 769 -primOpTag (VecAddOp FloatVec 4 W32) = 770 -primOpTag (VecAddOp FloatVec 2 W64) = 771 -primOpTag (VecAddOp FloatVec 8 W32) = 772 -primOpTag (VecAddOp FloatVec 4 W64) = 773 -primOpTag (VecAddOp FloatVec 16 W32) = 774 -primOpTag (VecAddOp FloatVec 8 W64) = 775 -primOpTag (VecSubOp IntVec 16 W8) = 776 -primOpTag (VecSubOp IntVec 8 W16) = 777 -primOpTag (VecSubOp IntVec 4 W32) = 778 -primOpTag (VecSubOp IntVec 2 W64) = 779 -primOpTag (VecSubOp IntVec 32 W8) = 780 -primOpTag (VecSubOp IntVec 16 W16) = 781 -primOpTag (VecSubOp IntVec 8 W32) = 782 -primOpTag (VecSubOp IntVec 4 W64) = 783 -primOpTag (VecSubOp IntVec 64 W8) = 784 -primOpTag (VecSubOp IntVec 32 W16) = 785 -primOpTag (VecSubOp IntVec 16 W32) = 786 -primOpTag (VecSubOp IntVec 8 W64) = 787 -primOpTag (VecSubOp WordVec 16 W8) = 788 -primOpTag (VecSubOp WordVec 8 W16) = 789 -primOpTag (VecSubOp WordVec 4 W32) = 790 -primOpTag (VecSubOp WordVec 2 W64) = 791 -primOpTag (VecSubOp WordVec 32 W8) = 792 -primOpTag (VecSubOp WordVec 16 W16) = 793 -primOpTag (VecSubOp WordVec 8 W32) = 794 -primOpTag (VecSubOp WordVec 4 W64) = 795 -primOpTag (VecSubOp WordVec 64 W8) = 796 -primOpTag (VecSubOp WordVec 32 W16) = 797 -primOpTag (VecSubOp WordVec 16 W32) = 798 -primOpTag (VecSubOp WordVec 8 W64) = 799 -primOpTag (VecSubOp FloatVec 4 W32) = 800 -primOpTag (VecSubOp FloatVec 2 W64) = 801 -primOpTag (VecSubOp FloatVec 8 W32) = 802 -primOpTag (VecSubOp FloatVec 4 W64) = 803 -primOpTag (VecSubOp FloatVec 16 W32) = 804 -primOpTag (VecSubOp FloatVec 8 W64) = 805 -primOpTag (VecMulOp IntVec 16 W8) = 806 -primOpTag (VecMulOp IntVec 8 W16) = 807 -primOpTag (VecMulOp IntVec 4 W32) = 808 -primOpTag (VecMulOp IntVec 2 W64) = 809 -primOpTag (VecMulOp IntVec 32 W8) = 810 -primOpTag (VecMulOp IntVec 16 W16) = 811 -primOpTag (VecMulOp IntVec 8 W32) = 812 -primOpTag (VecMulOp IntVec 4 W64) = 813 -primOpTag (VecMulOp IntVec 64 W8) = 814 -primOpTag (VecMulOp IntVec 32 W16) = 815 -primOpTag (VecMulOp IntVec 16 W32) = 816 -primOpTag (VecMulOp IntVec 8 W64) = 817 -primOpTag (VecMulOp WordVec 16 W8) = 818 -primOpTag (VecMulOp WordVec 8 W16) = 819 -primOpTag (VecMulOp WordVec 4 W32) = 820 -primOpTag (VecMulOp WordVec 2 W64) = 821 -primOpTag (VecMulOp WordVec 32 W8) = 822 -primOpTag (VecMulOp WordVec 16 W16) = 823 -primOpTag (VecMulOp WordVec 8 W32) = 824 -primOpTag (VecMulOp WordVec 4 W64) = 825 -primOpTag (VecMulOp WordVec 64 W8) = 826 -primOpTag (VecMulOp WordVec 32 W16) = 827 -primOpTag (VecMulOp WordVec 16 W32) = 828 -primOpTag (VecMulOp WordVec 8 W64) = 829 -primOpTag (VecMulOp FloatVec 4 W32) = 830 -primOpTag (VecMulOp FloatVec 2 W64) = 831 -primOpTag (VecMulOp FloatVec 8 W32) = 832 -primOpTag (VecMulOp FloatVec 4 W64) = 833 -primOpTag (VecMulOp FloatVec 16 W32) = 834 -primOpTag (VecMulOp FloatVec 8 W64) = 835 -primOpTag (VecDivOp FloatVec 4 W32) = 836 -primOpTag (VecDivOp FloatVec 2 W64) = 837 -primOpTag (VecDivOp FloatVec 8 W32) = 838 -primOpTag (VecDivOp FloatVec 4 W64) = 839 -primOpTag (VecDivOp FloatVec 16 W32) = 840 -primOpTag (VecDivOp FloatVec 8 W64) = 841 -primOpTag (VecQuotOp IntVec 16 W8) = 842 -primOpTag (VecQuotOp IntVec 8 W16) = 843 -primOpTag (VecQuotOp IntVec 4 W32) = 844 -primOpTag (VecQuotOp IntVec 2 W64) = 845 -primOpTag (VecQuotOp IntVec 32 W8) = 846 -primOpTag (VecQuotOp IntVec 16 W16) = 847 -primOpTag (VecQuotOp IntVec 8 W32) = 848 -primOpTag (VecQuotOp IntVec 4 W64) = 849 -primOpTag (VecQuotOp IntVec 64 W8) = 850 -primOpTag (VecQuotOp IntVec 32 W16) = 851 -primOpTag (VecQuotOp IntVec 16 W32) = 852 -primOpTag (VecQuotOp IntVec 8 W64) = 853 -primOpTag (VecQuotOp WordVec 16 W8) = 854 -primOpTag (VecQuotOp WordVec 8 W16) = 855 -primOpTag (VecQuotOp WordVec 4 W32) = 856 -primOpTag (VecQuotOp WordVec 2 W64) = 857 -primOpTag (VecQuotOp WordVec 32 W8) = 858 -primOpTag (VecQuotOp WordVec 16 W16) = 859 -primOpTag (VecQuotOp WordVec 8 W32) = 860 -primOpTag (VecQuotOp WordVec 4 W64) = 861 -primOpTag (VecQuotOp WordVec 64 W8) = 862 -primOpTag (VecQuotOp WordVec 32 W16) = 863 -primOpTag (VecQuotOp WordVec 16 W32) = 864 -primOpTag (VecQuotOp WordVec 8 W64) = 865 -primOpTag (VecRemOp IntVec 16 W8) = 866 -primOpTag (VecRemOp IntVec 8 W16) = 867 -primOpTag (VecRemOp IntVec 4 W32) = 868 -primOpTag (VecRemOp IntVec 2 W64) = 869 -primOpTag (VecRemOp IntVec 32 W8) = 870 -primOpTag (VecRemOp IntVec 16 W16) = 871 -primOpTag (VecRemOp IntVec 8 W32) = 872 -primOpTag (VecRemOp IntVec 4 W64) = 873 -primOpTag (VecRemOp IntVec 64 W8) = 874 -primOpTag (VecRemOp IntVec 32 W16) = 875 -primOpTag (VecRemOp IntVec 16 W32) = 876 -primOpTag (VecRemOp IntVec 8 W64) = 877 -primOpTag (VecRemOp WordVec 16 W8) = 878 -primOpTag (VecRemOp WordVec 8 W16) = 879 -primOpTag (VecRemOp WordVec 4 W32) = 880 -primOpTag (VecRemOp WordVec 2 W64) = 881 -primOpTag (VecRemOp WordVec 32 W8) = 882 -primOpTag (VecRemOp WordVec 16 W16) = 883 -primOpTag (VecRemOp WordVec 8 W32) = 884 -primOpTag (VecRemOp WordVec 4 W64) = 885 -primOpTag (VecRemOp WordVec 64 W8) = 886 -primOpTag (VecRemOp WordVec 32 W16) = 887 -primOpTag (VecRemOp WordVec 16 W32) = 888 -primOpTag (VecRemOp WordVec 8 W64) = 889 -primOpTag (VecNegOp IntVec 16 W8) = 890 -primOpTag (VecNegOp IntVec 8 W16) = 891 -primOpTag (VecNegOp IntVec 4 W32) = 892 -primOpTag (VecNegOp IntVec 2 W64) = 893 -primOpTag (VecNegOp IntVec 32 W8) = 894 -primOpTag (VecNegOp IntVec 16 W16) = 895 -primOpTag (VecNegOp IntVec 8 W32) = 896 -primOpTag (VecNegOp IntVec 4 W64) = 897 -primOpTag (VecNegOp IntVec 64 W8) = 898 -primOpTag (VecNegOp IntVec 32 W16) = 899 -primOpTag (VecNegOp IntVec 16 W32) = 900 -primOpTag (VecNegOp IntVec 8 W64) = 901 -primOpTag (VecNegOp FloatVec 4 W32) = 902 -primOpTag (VecNegOp FloatVec 2 W64) = 903 -primOpTag (VecNegOp FloatVec 8 W32) = 904 -primOpTag (VecNegOp FloatVec 4 W64) = 905 -primOpTag (VecNegOp FloatVec 16 W32) = 906 -primOpTag (VecNegOp FloatVec 8 W64) = 907 -primOpTag (VecIndexByteArrayOp IntVec 16 W8) = 908 -primOpTag (VecIndexByteArrayOp IntVec 8 W16) = 909 -primOpTag (VecIndexByteArrayOp IntVec 4 W32) = 910 -primOpTag (VecIndexByteArrayOp IntVec 2 W64) = 911 -primOpTag (VecIndexByteArrayOp IntVec 32 W8) = 912 -primOpTag (VecIndexByteArrayOp IntVec 16 W16) = 913 -primOpTag (VecIndexByteArrayOp IntVec 8 W32) = 914 -primOpTag (VecIndexByteArrayOp IntVec 4 W64) = 915 -primOpTag (VecIndexByteArrayOp IntVec 64 W8) = 916 -primOpTag (VecIndexByteArrayOp IntVec 32 W16) = 917 -primOpTag (VecIndexByteArrayOp IntVec 16 W32) = 918 -primOpTag (VecIndexByteArrayOp IntVec 8 W64) = 919 -primOpTag (VecIndexByteArrayOp WordVec 16 W8) = 920 -primOpTag (VecIndexByteArrayOp WordVec 8 W16) = 921 -primOpTag (VecIndexByteArrayOp WordVec 4 W32) = 922 -primOpTag (VecIndexByteArrayOp WordVec 2 W64) = 923 -primOpTag (VecIndexByteArrayOp WordVec 32 W8) = 924 -primOpTag (VecIndexByteArrayOp WordVec 16 W16) = 925 -primOpTag (VecIndexByteArrayOp WordVec 8 W32) = 926 -primOpTag (VecIndexByteArrayOp WordVec 4 W64) = 927 -primOpTag (VecIndexByteArrayOp WordVec 64 W8) = 928 -primOpTag (VecIndexByteArrayOp WordVec 32 W16) = 929 -primOpTag (VecIndexByteArrayOp WordVec 16 W32) = 930 -primOpTag (VecIndexByteArrayOp WordVec 8 W64) = 931 -primOpTag (VecIndexByteArrayOp FloatVec 4 W32) = 932 -primOpTag (VecIndexByteArrayOp FloatVec 2 W64) = 933 -primOpTag (VecIndexByteArrayOp FloatVec 8 W32) = 934 -primOpTag (VecIndexByteArrayOp FloatVec 4 W64) = 935 -primOpTag (VecIndexByteArrayOp FloatVec 16 W32) = 936 -primOpTag (VecIndexByteArrayOp FloatVec 8 W64) = 937 -primOpTag (VecReadByteArrayOp IntVec 16 W8) = 938 -primOpTag (VecReadByteArrayOp IntVec 8 W16) = 939 -primOpTag (VecReadByteArrayOp IntVec 4 W32) = 940 -primOpTag (VecReadByteArrayOp IntVec 2 W64) = 941 -primOpTag (VecReadByteArrayOp IntVec 32 W8) = 942 -primOpTag (VecReadByteArrayOp IntVec 16 W16) = 943 -primOpTag (VecReadByteArrayOp IntVec 8 W32) = 944 -primOpTag (VecReadByteArrayOp IntVec 4 W64) = 945 -primOpTag (VecReadByteArrayOp IntVec 64 W8) = 946 -primOpTag (VecReadByteArrayOp IntVec 32 W16) = 947 -primOpTag (VecReadByteArrayOp IntVec 16 W32) = 948 -primOpTag (VecReadByteArrayOp IntVec 8 W64) = 949 -primOpTag (VecReadByteArrayOp WordVec 16 W8) = 950 -primOpTag (VecReadByteArrayOp WordVec 8 W16) = 951 -primOpTag (VecReadByteArrayOp WordVec 4 W32) = 952 -primOpTag (VecReadByteArrayOp WordVec 2 W64) = 953 -primOpTag (VecReadByteArrayOp WordVec 32 W8) = 954 -primOpTag (VecReadByteArrayOp WordVec 16 W16) = 955 -primOpTag (VecReadByteArrayOp WordVec 8 W32) = 956 -primOpTag (VecReadByteArrayOp WordVec 4 W64) = 957 -primOpTag (VecReadByteArrayOp WordVec 64 W8) = 958 -primOpTag (VecReadByteArrayOp WordVec 32 W16) = 959 -primOpTag (VecReadByteArrayOp WordVec 16 W32) = 960 -primOpTag (VecReadByteArrayOp WordVec 8 W64) = 961 -primOpTag (VecReadByteArrayOp FloatVec 4 W32) = 962 -primOpTag (VecReadByteArrayOp FloatVec 2 W64) = 963 -primOpTag (VecReadByteArrayOp FloatVec 8 W32) = 964 -primOpTag (VecReadByteArrayOp FloatVec 4 W64) = 965 -primOpTag (VecReadByteArrayOp FloatVec 16 W32) = 966 -primOpTag (VecReadByteArrayOp FloatVec 8 W64) = 967 -primOpTag (VecWriteByteArrayOp IntVec 16 W8) = 968 -primOpTag (VecWriteByteArrayOp IntVec 8 W16) = 969 -primOpTag (VecWriteByteArrayOp IntVec 4 W32) = 970 -primOpTag (VecWriteByteArrayOp IntVec 2 W64) = 971 -primOpTag (VecWriteByteArrayOp IntVec 32 W8) = 972 -primOpTag (VecWriteByteArrayOp IntVec 16 W16) = 973 -primOpTag (VecWriteByteArrayOp IntVec 8 W32) = 974 -primOpTag (VecWriteByteArrayOp IntVec 4 W64) = 975 -primOpTag (VecWriteByteArrayOp IntVec 64 W8) = 976 -primOpTag (VecWriteByteArrayOp IntVec 32 W16) = 977 -primOpTag (VecWriteByteArrayOp IntVec 16 W32) = 978 -primOpTag (VecWriteByteArrayOp IntVec 8 W64) = 979 -primOpTag (VecWriteByteArrayOp WordVec 16 W8) = 980 -primOpTag (VecWriteByteArrayOp WordVec 8 W16) = 981 -primOpTag (VecWriteByteArrayOp WordVec 4 W32) = 982 -primOpTag (VecWriteByteArrayOp WordVec 2 W64) = 983 -primOpTag (VecWriteByteArrayOp WordVec 32 W8) = 984 -primOpTag (VecWriteByteArrayOp WordVec 16 W16) = 985 -primOpTag (VecWriteByteArrayOp WordVec 8 W32) = 986 -primOpTag (VecWriteByteArrayOp WordVec 4 W64) = 987 -primOpTag (VecWriteByteArrayOp WordVec 64 W8) = 988 -primOpTag (VecWriteByteArrayOp WordVec 32 W16) = 989 -primOpTag (VecWriteByteArrayOp WordVec 16 W32) = 990 -primOpTag (VecWriteByteArrayOp WordVec 8 W64) = 991 -primOpTag (VecWriteByteArrayOp FloatVec 4 W32) = 992 -primOpTag (VecWriteByteArrayOp FloatVec 2 W64) = 993 -primOpTag (VecWriteByteArrayOp FloatVec 8 W32) = 994 -primOpTag (VecWriteByteArrayOp FloatVec 4 W64) = 995 -primOpTag (VecWriteByteArrayOp FloatVec 16 W32) = 996 -primOpTag (VecWriteByteArrayOp FloatVec 8 W64) = 997 -primOpTag (VecIndexOffAddrOp IntVec 16 W8) = 998 -primOpTag (VecIndexOffAddrOp IntVec 8 W16) = 999 -primOpTag (VecIndexOffAddrOp IntVec 4 W32) = 1000 -primOpTag (VecIndexOffAddrOp IntVec 2 W64) = 1001 -primOpTag (VecIndexOffAddrOp IntVec 32 W8) = 1002 -primOpTag (VecIndexOffAddrOp IntVec 16 W16) = 1003 -primOpTag (VecIndexOffAddrOp IntVec 8 W32) = 1004 -primOpTag (VecIndexOffAddrOp IntVec 4 W64) = 1005 -primOpTag (VecIndexOffAddrOp IntVec 64 W8) = 1006 -primOpTag (VecIndexOffAddrOp IntVec 32 W16) = 1007 -primOpTag (VecIndexOffAddrOp IntVec 16 W32) = 1008 -primOpTag (VecIndexOffAddrOp IntVec 8 W64) = 1009 -primOpTag (VecIndexOffAddrOp WordVec 16 W8) = 1010 -primOpTag (VecIndexOffAddrOp WordVec 8 W16) = 1011 -primOpTag (VecIndexOffAddrOp WordVec 4 W32) = 1012 -primOpTag (VecIndexOffAddrOp WordVec 2 W64) = 1013 -primOpTag (VecIndexOffAddrOp WordVec 32 W8) = 1014 -primOpTag (VecIndexOffAddrOp WordVec 16 W16) = 1015 -primOpTag (VecIndexOffAddrOp WordVec 8 W32) = 1016 -primOpTag (VecIndexOffAddrOp WordVec 4 W64) = 1017 -primOpTag (VecIndexOffAddrOp WordVec 64 W8) = 1018 -primOpTag (VecIndexOffAddrOp WordVec 32 W16) = 1019 -primOpTag (VecIndexOffAddrOp WordVec 16 W32) = 1020 -primOpTag (VecIndexOffAddrOp WordVec 8 W64) = 1021 -primOpTag (VecIndexOffAddrOp FloatVec 4 W32) = 1022 -primOpTag (VecIndexOffAddrOp FloatVec 2 W64) = 1023 -primOpTag (VecIndexOffAddrOp FloatVec 8 W32) = 1024 -primOpTag (VecIndexOffAddrOp FloatVec 4 W64) = 1025 -primOpTag (VecIndexOffAddrOp FloatVec 16 W32) = 1026 -primOpTag (VecIndexOffAddrOp FloatVec 8 W64) = 1027 -primOpTag (VecReadOffAddrOp IntVec 16 W8) = 1028 -primOpTag (VecReadOffAddrOp IntVec 8 W16) = 1029 -primOpTag (VecReadOffAddrOp IntVec 4 W32) = 1030 -primOpTag (VecReadOffAddrOp IntVec 2 W64) = 1031 -primOpTag (VecReadOffAddrOp IntVec 32 W8) = 1032 -primOpTag (VecReadOffAddrOp IntVec 16 W16) = 1033 -primOpTag (VecReadOffAddrOp IntVec 8 W32) = 1034 -primOpTag (VecReadOffAddrOp IntVec 4 W64) = 1035 -primOpTag (VecReadOffAddrOp IntVec 64 W8) = 1036 -primOpTag (VecReadOffAddrOp IntVec 32 W16) = 1037 -primOpTag (VecReadOffAddrOp IntVec 16 W32) = 1038 -primOpTag (VecReadOffAddrOp IntVec 8 W64) = 1039 -primOpTag (VecReadOffAddrOp WordVec 16 W8) = 1040 -primOpTag (VecReadOffAddrOp WordVec 8 W16) = 1041 -primOpTag (VecReadOffAddrOp WordVec 4 W32) = 1042 -primOpTag (VecReadOffAddrOp WordVec 2 W64) = 1043 -primOpTag (VecReadOffAddrOp WordVec 32 W8) = 1044 -primOpTag (VecReadOffAddrOp WordVec 16 W16) = 1045 -primOpTag (VecReadOffAddrOp WordVec 8 W32) = 1046 -primOpTag (VecReadOffAddrOp WordVec 4 W64) = 1047 -primOpTag (VecReadOffAddrOp WordVec 64 W8) = 1048 -primOpTag (VecReadOffAddrOp WordVec 32 W16) = 1049 -primOpTag (VecReadOffAddrOp WordVec 16 W32) = 1050 -primOpTag (VecReadOffAddrOp WordVec 8 W64) = 1051 -primOpTag (VecReadOffAddrOp FloatVec 4 W32) = 1052 -primOpTag (VecReadOffAddrOp FloatVec 2 W64) = 1053 -primOpTag (VecReadOffAddrOp FloatVec 8 W32) = 1054 -primOpTag (VecReadOffAddrOp FloatVec 4 W64) = 1055 -primOpTag (VecReadOffAddrOp FloatVec 16 W32) = 1056 -primOpTag (VecReadOffAddrOp FloatVec 8 W64) = 1057 -primOpTag (VecWriteOffAddrOp IntVec 16 W8) = 1058 -primOpTag (VecWriteOffAddrOp IntVec 8 W16) = 1059 -primOpTag (VecWriteOffAddrOp IntVec 4 W32) = 1060 -primOpTag (VecWriteOffAddrOp IntVec 2 W64) = 1061 -primOpTag (VecWriteOffAddrOp IntVec 32 W8) = 1062 -primOpTag (VecWriteOffAddrOp IntVec 16 W16) = 1063 -primOpTag (VecWriteOffAddrOp IntVec 8 W32) = 1064 -primOpTag (VecWriteOffAddrOp IntVec 4 W64) = 1065 -primOpTag (VecWriteOffAddrOp IntVec 64 W8) = 1066 -primOpTag (VecWriteOffAddrOp IntVec 32 W16) = 1067 -primOpTag (VecWriteOffAddrOp IntVec 16 W32) = 1068 -primOpTag (VecWriteOffAddrOp IntVec 8 W64) = 1069 -primOpTag (VecWriteOffAddrOp WordVec 16 W8) = 1070 -primOpTag (VecWriteOffAddrOp WordVec 8 W16) = 1071 -primOpTag (VecWriteOffAddrOp WordVec 4 W32) = 1072 -primOpTag (VecWriteOffAddrOp WordVec 2 W64) = 1073 -primOpTag (VecWriteOffAddrOp WordVec 32 W8) = 1074 -primOpTag (VecWriteOffAddrOp WordVec 16 W16) = 1075 -primOpTag (VecWriteOffAddrOp WordVec 8 W32) = 1076 -primOpTag (VecWriteOffAddrOp WordVec 4 W64) = 1077 -primOpTag (VecWriteOffAddrOp WordVec 64 W8) = 1078 -primOpTag (VecWriteOffAddrOp WordVec 32 W16) = 1079 -primOpTag (VecWriteOffAddrOp WordVec 16 W32) = 1080 -primOpTag (VecWriteOffAddrOp WordVec 8 W64) = 1081 -primOpTag (VecWriteOffAddrOp FloatVec 4 W32) = 1082 -primOpTag (VecWriteOffAddrOp FloatVec 2 W64) = 1083 -primOpTag (VecWriteOffAddrOp FloatVec 8 W32) = 1084 -primOpTag (VecWriteOffAddrOp FloatVec 4 W64) = 1085 -primOpTag (VecWriteOffAddrOp FloatVec 16 W32) = 1086 -primOpTag (VecWriteOffAddrOp FloatVec 8 W64) = 1087 -primOpTag (VecIndexScalarByteArrayOp IntVec 16 W8) = 1088 -primOpTag (VecIndexScalarByteArrayOp IntVec 8 W16) = 1089 -primOpTag (VecIndexScalarByteArrayOp IntVec 4 W32) = 1090 -primOpTag (VecIndexScalarByteArrayOp IntVec 2 W64) = 1091 -primOpTag (VecIndexScalarByteArrayOp IntVec 32 W8) = 1092 -primOpTag (VecIndexScalarByteArrayOp IntVec 16 W16) = 1093 -primOpTag (VecIndexScalarByteArrayOp IntVec 8 W32) = 1094 -primOpTag (VecIndexScalarByteArrayOp IntVec 4 W64) = 1095 -primOpTag (VecIndexScalarByteArrayOp IntVec 64 W8) = 1096 -primOpTag (VecIndexScalarByteArrayOp IntVec 32 W16) = 1097 -primOpTag (VecIndexScalarByteArrayOp IntVec 16 W32) = 1098 -primOpTag (VecIndexScalarByteArrayOp IntVec 8 W64) = 1099 -primOpTag (VecIndexScalarByteArrayOp WordVec 16 W8) = 1100 -primOpTag (VecIndexScalarByteArrayOp WordVec 8 W16) = 1101 -primOpTag (VecIndexScalarByteArrayOp WordVec 4 W32) = 1102 -primOpTag (VecIndexScalarByteArrayOp WordVec 2 W64) = 1103 -primOpTag (VecIndexScalarByteArrayOp WordVec 32 W8) = 1104 -primOpTag (VecIndexScalarByteArrayOp WordVec 16 W16) = 1105 -primOpTag (VecIndexScalarByteArrayOp WordVec 8 W32) = 1106 -primOpTag (VecIndexScalarByteArrayOp WordVec 4 W64) = 1107 -primOpTag (VecIndexScalarByteArrayOp WordVec 64 W8) = 1108 -primOpTag (VecIndexScalarByteArrayOp WordVec 32 W16) = 1109 -primOpTag (VecIndexScalarByteArrayOp WordVec 16 W32) = 1110 -primOpTag (VecIndexScalarByteArrayOp WordVec 8 W64) = 1111 -primOpTag (VecIndexScalarByteArrayOp FloatVec 4 W32) = 1112 -primOpTag (VecIndexScalarByteArrayOp FloatVec 2 W64) = 1113 -primOpTag (VecIndexScalarByteArrayOp FloatVec 8 W32) = 1114 -primOpTag (VecIndexScalarByteArrayOp FloatVec 4 W64) = 1115 -primOpTag (VecIndexScalarByteArrayOp FloatVec 16 W32) = 1116 -primOpTag (VecIndexScalarByteArrayOp FloatVec 8 W64) = 1117 -primOpTag (VecReadScalarByteArrayOp IntVec 16 W8) = 1118 -primOpTag (VecReadScalarByteArrayOp IntVec 8 W16) = 1119 -primOpTag (VecReadScalarByteArrayOp IntVec 4 W32) = 1120 -primOpTag (VecReadScalarByteArrayOp IntVec 2 W64) = 1121 -primOpTag (VecReadScalarByteArrayOp IntVec 32 W8) = 1122 -primOpTag (VecReadScalarByteArrayOp IntVec 16 W16) = 1123 -primOpTag (VecReadScalarByteArrayOp IntVec 8 W32) = 1124 -primOpTag (VecReadScalarByteArrayOp IntVec 4 W64) = 1125 -primOpTag (VecReadScalarByteArrayOp IntVec 64 W8) = 1126 -primOpTag (VecReadScalarByteArrayOp IntVec 32 W16) = 1127 -primOpTag (VecReadScalarByteArrayOp IntVec 16 W32) = 1128 -primOpTag (VecReadScalarByteArrayOp IntVec 8 W64) = 1129 -primOpTag (VecReadScalarByteArrayOp WordVec 16 W8) = 1130 -primOpTag (VecReadScalarByteArrayOp WordVec 8 W16) = 1131 -primOpTag (VecReadScalarByteArrayOp WordVec 4 W32) = 1132 -primOpTag (VecReadScalarByteArrayOp WordVec 2 W64) = 1133 -primOpTag (VecReadScalarByteArrayOp WordVec 32 W8) = 1134 -primOpTag (VecReadScalarByteArrayOp WordVec 16 W16) = 1135 -primOpTag (VecReadScalarByteArrayOp WordVec 8 W32) = 1136 -primOpTag (VecReadScalarByteArrayOp WordVec 4 W64) = 1137 -primOpTag (VecReadScalarByteArrayOp WordVec 64 W8) = 1138 -primOpTag (VecReadScalarByteArrayOp WordVec 32 W16) = 1139 -primOpTag (VecReadScalarByteArrayOp WordVec 16 W32) = 1140 -primOpTag (VecReadScalarByteArrayOp WordVec 8 W64) = 1141 -primOpTag (VecReadScalarByteArrayOp FloatVec 4 W32) = 1142 -primOpTag (VecReadScalarByteArrayOp FloatVec 2 W64) = 1143 -primOpTag (VecReadScalarByteArrayOp FloatVec 8 W32) = 1144 -primOpTag (VecReadScalarByteArrayOp FloatVec 4 W64) = 1145 -primOpTag (VecReadScalarByteArrayOp FloatVec 16 W32) = 1146 -primOpTag (VecReadScalarByteArrayOp FloatVec 8 W64) = 1147 -primOpTag (VecWriteScalarByteArrayOp IntVec 16 W8) = 1148 -primOpTag (VecWriteScalarByteArrayOp IntVec 8 W16) = 1149 -primOpTag (VecWriteScalarByteArrayOp IntVec 4 W32) = 1150 -primOpTag (VecWriteScalarByteArrayOp IntVec 2 W64) = 1151 -primOpTag (VecWriteScalarByteArrayOp IntVec 32 W8) = 1152 -primOpTag (VecWriteScalarByteArrayOp IntVec 16 W16) = 1153 -primOpTag (VecWriteScalarByteArrayOp IntVec 8 W32) = 1154 -primOpTag (VecWriteScalarByteArrayOp IntVec 4 W64) = 1155 -primOpTag (VecWriteScalarByteArrayOp IntVec 64 W8) = 1156 -primOpTag (VecWriteScalarByteArrayOp IntVec 32 W16) = 1157 -primOpTag (VecWriteScalarByteArrayOp IntVec 16 W32) = 1158 -primOpTag (VecWriteScalarByteArrayOp IntVec 8 W64) = 1159 -primOpTag (VecWriteScalarByteArrayOp WordVec 16 W8) = 1160 -primOpTag (VecWriteScalarByteArrayOp WordVec 8 W16) = 1161 -primOpTag (VecWriteScalarByteArrayOp WordVec 4 W32) = 1162 -primOpTag (VecWriteScalarByteArrayOp WordVec 2 W64) = 1163 -primOpTag (VecWriteScalarByteArrayOp WordVec 32 W8) = 1164 -primOpTag (VecWriteScalarByteArrayOp WordVec 16 W16) = 1165 -primOpTag (VecWriteScalarByteArrayOp WordVec 8 W32) = 1166 -primOpTag (VecWriteScalarByteArrayOp WordVec 4 W64) = 1167 -primOpTag (VecWriteScalarByteArrayOp WordVec 64 W8) = 1168 -primOpTag (VecWriteScalarByteArrayOp WordVec 32 W16) = 1169 -primOpTag (VecWriteScalarByteArrayOp WordVec 16 W32) = 1170 -primOpTag (VecWriteScalarByteArrayOp WordVec 8 W64) = 1171 -primOpTag (VecWriteScalarByteArrayOp FloatVec 4 W32) = 1172 -primOpTag (VecWriteScalarByteArrayOp FloatVec 2 W64) = 1173 -primOpTag (VecWriteScalarByteArrayOp FloatVec 8 W32) = 1174 -primOpTag (VecWriteScalarByteArrayOp FloatVec 4 W64) = 1175 -primOpTag (VecWriteScalarByteArrayOp FloatVec 16 W32) = 1176 -primOpTag (VecWriteScalarByteArrayOp FloatVec 8 W64) = 1177 -primOpTag (VecIndexScalarOffAddrOp IntVec 16 W8) = 1178 -primOpTag (VecIndexScalarOffAddrOp IntVec 8 W16) = 1179 -primOpTag (VecIndexScalarOffAddrOp IntVec 4 W32) = 1180 -primOpTag (VecIndexScalarOffAddrOp IntVec 2 W64) = 1181 -primOpTag (VecIndexScalarOffAddrOp IntVec 32 W8) = 1182 -primOpTag (VecIndexScalarOffAddrOp IntVec 16 W16) = 1183 -primOpTag (VecIndexScalarOffAddrOp IntVec 8 W32) = 1184 -primOpTag (VecIndexScalarOffAddrOp IntVec 4 W64) = 1185 -primOpTag (VecIndexScalarOffAddrOp IntVec 64 W8) = 1186 -primOpTag (VecIndexScalarOffAddrOp IntVec 32 W16) = 1187 -primOpTag (VecIndexScalarOffAddrOp IntVec 16 W32) = 1188 -primOpTag (VecIndexScalarOffAddrOp IntVec 8 W64) = 1189 -primOpTag (VecIndexScalarOffAddrOp WordVec 16 W8) = 1190 -primOpTag (VecIndexScalarOffAddrOp WordVec 8 W16) = 1191 -primOpTag (VecIndexScalarOffAddrOp WordVec 4 W32) = 1192 -primOpTag (VecIndexScalarOffAddrOp WordVec 2 W64) = 1193 -primOpTag (VecIndexScalarOffAddrOp WordVec 32 W8) = 1194 -primOpTag (VecIndexScalarOffAddrOp WordVec 16 W16) = 1195 -primOpTag (VecIndexScalarOffAddrOp WordVec 8 W32) = 1196 -primOpTag (VecIndexScalarOffAddrOp WordVec 4 W64) = 1197 -primOpTag (VecIndexScalarOffAddrOp WordVec 64 W8) = 1198 -primOpTag (VecIndexScalarOffAddrOp WordVec 32 W16) = 1199 -primOpTag (VecIndexScalarOffAddrOp WordVec 16 W32) = 1200 -primOpTag (VecIndexScalarOffAddrOp WordVec 8 W64) = 1201 -primOpTag (VecIndexScalarOffAddrOp FloatVec 4 W32) = 1202 -primOpTag (VecIndexScalarOffAddrOp FloatVec 2 W64) = 1203 -primOpTag (VecIndexScalarOffAddrOp FloatVec 8 W32) = 1204 -primOpTag (VecIndexScalarOffAddrOp FloatVec 4 W64) = 1205 -primOpTag (VecIndexScalarOffAddrOp FloatVec 16 W32) = 1206 -primOpTag (VecIndexScalarOffAddrOp FloatVec 8 W64) = 1207 -primOpTag (VecReadScalarOffAddrOp IntVec 16 W8) = 1208 -primOpTag (VecReadScalarOffAddrOp IntVec 8 W16) = 1209 -primOpTag (VecReadScalarOffAddrOp IntVec 4 W32) = 1210 -primOpTag (VecReadScalarOffAddrOp IntVec 2 W64) = 1211 -primOpTag (VecReadScalarOffAddrOp IntVec 32 W8) = 1212 -primOpTag (VecReadScalarOffAddrOp IntVec 16 W16) = 1213 -primOpTag (VecReadScalarOffAddrOp IntVec 8 W32) = 1214 -primOpTag (VecReadScalarOffAddrOp IntVec 4 W64) = 1215 -primOpTag (VecReadScalarOffAddrOp IntVec 64 W8) = 1216 -primOpTag (VecReadScalarOffAddrOp IntVec 32 W16) = 1217 -primOpTag (VecReadScalarOffAddrOp IntVec 16 W32) = 1218 -primOpTag (VecReadScalarOffAddrOp IntVec 8 W64) = 1219 -primOpTag (VecReadScalarOffAddrOp WordVec 16 W8) = 1220 -primOpTag (VecReadScalarOffAddrOp WordVec 8 W16) = 1221 -primOpTag (VecReadScalarOffAddrOp WordVec 4 W32) = 1222 -primOpTag (VecReadScalarOffAddrOp WordVec 2 W64) = 1223 -primOpTag (VecReadScalarOffAddrOp WordVec 32 W8) = 1224 -primOpTag (VecReadScalarOffAddrOp WordVec 16 W16) = 1225 -primOpTag (VecReadScalarOffAddrOp WordVec 8 W32) = 1226 -primOpTag (VecReadScalarOffAddrOp WordVec 4 W64) = 1227 -primOpTag (VecReadScalarOffAddrOp WordVec 64 W8) = 1228 -primOpTag (VecReadScalarOffAddrOp WordVec 32 W16) = 1229 -primOpTag (VecReadScalarOffAddrOp WordVec 16 W32) = 1230 -primOpTag (VecReadScalarOffAddrOp WordVec 8 W64) = 1231 -primOpTag (VecReadScalarOffAddrOp FloatVec 4 W32) = 1232 -primOpTag (VecReadScalarOffAddrOp FloatVec 2 W64) = 1233 -primOpTag (VecReadScalarOffAddrOp FloatVec 8 W32) = 1234 -primOpTag (VecReadScalarOffAddrOp FloatVec 4 W64) = 1235 -primOpTag (VecReadScalarOffAddrOp FloatVec 16 W32) = 1236 -primOpTag (VecReadScalarOffAddrOp FloatVec 8 W64) = 1237 -primOpTag (VecWriteScalarOffAddrOp IntVec 16 W8) = 1238 -primOpTag (VecWriteScalarOffAddrOp IntVec 8 W16) = 1239 -primOpTag (VecWriteScalarOffAddrOp IntVec 4 W32) = 1240 -primOpTag (VecWriteScalarOffAddrOp IntVec 2 W64) = 1241 -primOpTag (VecWriteScalarOffAddrOp IntVec 32 W8) = 1242 -primOpTag (VecWriteScalarOffAddrOp IntVec 16 W16) = 1243 -primOpTag (VecWriteScalarOffAddrOp IntVec 8 W32) = 1244 -primOpTag (VecWriteScalarOffAddrOp IntVec 4 W64) = 1245 -primOpTag (VecWriteScalarOffAddrOp IntVec 64 W8) = 1246 -primOpTag (VecWriteScalarOffAddrOp IntVec 32 W16) = 1247 -primOpTag (VecWriteScalarOffAddrOp IntVec 16 W32) = 1248 -primOpTag (VecWriteScalarOffAddrOp IntVec 8 W64) = 1249 -primOpTag (VecWriteScalarOffAddrOp WordVec 16 W8) = 1250 -primOpTag (VecWriteScalarOffAddrOp WordVec 8 W16) = 1251 -primOpTag (VecWriteScalarOffAddrOp WordVec 4 W32) = 1252 -primOpTag (VecWriteScalarOffAddrOp WordVec 2 W64) = 1253 -primOpTag (VecWriteScalarOffAddrOp WordVec 32 W8) = 1254 -primOpTag (VecWriteScalarOffAddrOp WordVec 16 W16) = 1255 -primOpTag (VecWriteScalarOffAddrOp WordVec 8 W32) = 1256 -primOpTag (VecWriteScalarOffAddrOp WordVec 4 W64) = 1257 -primOpTag (VecWriteScalarOffAddrOp WordVec 64 W8) = 1258 -primOpTag (VecWriteScalarOffAddrOp WordVec 32 W16) = 1259 -primOpTag (VecWriteScalarOffAddrOp WordVec 16 W32) = 1260 -primOpTag (VecWriteScalarOffAddrOp WordVec 8 W64) = 1261 -primOpTag (VecWriteScalarOffAddrOp FloatVec 4 W32) = 1262 -primOpTag (VecWriteScalarOffAddrOp FloatVec 2 W64) = 1263 -primOpTag (VecWriteScalarOffAddrOp FloatVec 8 W32) = 1264 -primOpTag (VecWriteScalarOffAddrOp FloatVec 4 W64) = 1265 -primOpTag (VecWriteScalarOffAddrOp FloatVec 16 W32) = 1266 -primOpTag (VecWriteScalarOffAddrOp FloatVec 8 W64) = 1267 -primOpTag PrefetchByteArrayOp3 = 1268 -primOpTag PrefetchMutableByteArrayOp3 = 1269 -primOpTag PrefetchAddrOp3 = 1270 -primOpTag PrefetchValueOp3 = 1271 -primOpTag PrefetchByteArrayOp2 = 1272 -primOpTag PrefetchMutableByteArrayOp2 = 1273 -primOpTag PrefetchAddrOp2 = 1274 -primOpTag PrefetchValueOp2 = 1275 -primOpTag PrefetchByteArrayOp1 = 1276 -primOpTag PrefetchMutableByteArrayOp1 = 1277 -primOpTag PrefetchAddrOp1 = 1278 -primOpTag PrefetchValueOp1 = 1279 -primOpTag PrefetchByteArrayOp0 = 1280 -primOpTag PrefetchMutableByteArrayOp0 = 1281 -primOpTag PrefetchAddrOp0 = 1282 -primOpTag PrefetchValueOp0 = 1283 +maxPrimOpTag = 1274 +primOpTag :: PrimOp -> Int +primOpTag CharGtOp = 1 +primOpTag CharGeOp = 2 +primOpTag CharEqOp = 3 +primOpTag CharNeOp = 4 +primOpTag CharLtOp = 5 +primOpTag CharLeOp = 6 +primOpTag OrdOp = 7 +primOpTag Int8ToIntOp = 8 +primOpTag IntToInt8Op = 9 +primOpTag Int8NegOp = 10 +primOpTag Int8AddOp = 11 +primOpTag Int8SubOp = 12 +primOpTag Int8MulOp = 13 +primOpTag Int8QuotOp = 14 +primOpTag Int8RemOp = 15 +primOpTag Int8QuotRemOp = 16 +primOpTag Int8SllOp = 17 +primOpTag Int8SraOp = 18 +primOpTag Int8SrlOp = 19 +primOpTag Int8ToWord8Op = 20 +primOpTag Int8EqOp = 21 +primOpTag Int8GeOp = 22 +primOpTag Int8GtOp = 23 +primOpTag Int8LeOp = 24 +primOpTag Int8LtOp = 25 +primOpTag Int8NeOp = 26 +primOpTag Word8ToWordOp = 27 +primOpTag WordToWord8Op = 28 +primOpTag Word8AddOp = 29 +primOpTag Word8SubOp = 30 +primOpTag Word8MulOp = 31 +primOpTag Word8QuotOp = 32 +primOpTag Word8RemOp = 33 +primOpTag Word8QuotRemOp = 34 +primOpTag Word8AndOp = 35 +primOpTag Word8OrOp = 36 +primOpTag Word8XorOp = 37 +primOpTag Word8NotOp = 38 +primOpTag Word8SllOp = 39 +primOpTag Word8SrlOp = 40 +primOpTag Word8ToInt8Op = 41 +primOpTag Word8EqOp = 42 +primOpTag Word8GeOp = 43 +primOpTag Word8GtOp = 44 +primOpTag Word8LeOp = 45 +primOpTag Word8LtOp = 46 +primOpTag Word8NeOp = 47 +primOpTag Int16ToIntOp = 48 +primOpTag IntToInt16Op = 49 +primOpTag Int16NegOp = 50 +primOpTag Int16AddOp = 51 +primOpTag Int16SubOp = 52 +primOpTag Int16MulOp = 53 +primOpTag Int16QuotOp = 54 +primOpTag Int16RemOp = 55 +primOpTag Int16QuotRemOp = 56 +primOpTag Int16SllOp = 57 +primOpTag Int16SraOp = 58 +primOpTag Int16SrlOp = 59 +primOpTag Int16ToWord16Op = 60 +primOpTag Int16EqOp = 61 +primOpTag Int16GeOp = 62 +primOpTag Int16GtOp = 63 +primOpTag Int16LeOp = 64 +primOpTag Int16LtOp = 65 +primOpTag Int16NeOp = 66 +primOpTag Word16ToWordOp = 67 +primOpTag WordToWord16Op = 68 +primOpTag Word16AddOp = 69 +primOpTag Word16SubOp = 70 +primOpTag Word16MulOp = 71 +primOpTag Word16QuotOp = 72 +primOpTag Word16RemOp = 73 +primOpTag Word16QuotRemOp = 74 +primOpTag Word16AndOp = 75 +primOpTag Word16OrOp = 76 +primOpTag Word16XorOp = 77 +primOpTag Word16NotOp = 78 +primOpTag Word16SllOp = 79 +primOpTag Word16SrlOp = 80 +primOpTag Word16ToInt16Op = 81 +primOpTag Word16EqOp = 82 +primOpTag Word16GeOp = 83 +primOpTag Word16GtOp = 84 +primOpTag Word16LeOp = 85 +primOpTag Word16LtOp = 86 +primOpTag Word16NeOp = 87 +primOpTag Int32ToIntOp = 88 +primOpTag IntToInt32Op = 89 +primOpTag Int32NegOp = 90 +primOpTag Int32AddOp = 91 +primOpTag Int32SubOp = 92 +primOpTag Int32MulOp = 93 +primOpTag Int32QuotOp = 94 +primOpTag Int32RemOp = 95 +primOpTag Int32QuotRemOp = 96 +primOpTag Int32SllOp = 97 +primOpTag Int32SraOp = 98 +primOpTag Int32SrlOp = 99 +primOpTag Int32ToWord32Op = 100 +primOpTag Int32EqOp = 101 +primOpTag Int32GeOp = 102 +primOpTag Int32GtOp = 103 +primOpTag Int32LeOp = 104 +primOpTag Int32LtOp = 105 +primOpTag Int32NeOp = 106 +primOpTag Word32ToWordOp = 107 +primOpTag WordToWord32Op = 108 +primOpTag Word32AddOp = 109 +primOpTag Word32SubOp = 110 +primOpTag Word32MulOp = 111 +primOpTag Word32QuotOp = 112 +primOpTag Word32RemOp = 113 +primOpTag Word32QuotRemOp = 114 +primOpTag Word32AndOp = 115 +primOpTag Word32OrOp = 116 +primOpTag Word32XorOp = 117 +primOpTag Word32NotOp = 118 +primOpTag Word32SllOp = 119 +primOpTag Word32SrlOp = 120 +primOpTag Word32ToInt32Op = 121 +primOpTag Word32EqOp = 122 +primOpTag Word32GeOp = 123 +primOpTag Word32GtOp = 124 +primOpTag Word32LeOp = 125 +primOpTag Word32LtOp = 126 +primOpTag Word32NeOp = 127 +primOpTag IntAddOp = 128 +primOpTag IntSubOp = 129 +primOpTag IntMulOp = 130 +primOpTag IntMul2Op = 131 +primOpTag IntMulMayOfloOp = 132 +primOpTag IntQuotOp = 133 +primOpTag IntRemOp = 134 +primOpTag IntQuotRemOp = 135 +primOpTag IntAndOp = 136 +primOpTag IntOrOp = 137 +primOpTag IntXorOp = 138 +primOpTag IntNotOp = 139 +primOpTag IntNegOp = 140 +primOpTag IntAddCOp = 141 +primOpTag IntSubCOp = 142 +primOpTag IntGtOp = 143 +primOpTag IntGeOp = 144 +primOpTag IntEqOp = 145 +primOpTag IntNeOp = 146 +primOpTag IntLtOp = 147 +primOpTag IntLeOp = 148 +primOpTag ChrOp = 149 +primOpTag IntToWordOp = 150 +primOpTag IntToFloatOp = 151 +primOpTag IntToDoubleOp = 152 +primOpTag WordToFloatOp = 153 +primOpTag WordToDoubleOp = 154 +primOpTag IntSllOp = 155 +primOpTag IntSraOp = 156 +primOpTag IntSrlOp = 157 +primOpTag WordAddOp = 158 +primOpTag WordAddCOp = 159 +primOpTag WordSubCOp = 160 +primOpTag WordAdd2Op = 161 +primOpTag WordSubOp = 162 +primOpTag WordMulOp = 163 +primOpTag WordMul2Op = 164 +primOpTag WordQuotOp = 165 +primOpTag WordRemOp = 166 +primOpTag WordQuotRemOp = 167 +primOpTag WordQuotRem2Op = 168 +primOpTag WordAndOp = 169 +primOpTag WordOrOp = 170 +primOpTag WordXorOp = 171 +primOpTag WordNotOp = 172 +primOpTag WordSllOp = 173 +primOpTag WordSrlOp = 174 +primOpTag WordToIntOp = 175 +primOpTag WordGtOp = 176 +primOpTag WordGeOp = 177 +primOpTag WordEqOp = 178 +primOpTag WordNeOp = 179 +primOpTag WordLtOp = 180 +primOpTag WordLeOp = 181 +primOpTag PopCnt8Op = 182 +primOpTag PopCnt16Op = 183 +primOpTag PopCnt32Op = 184 +primOpTag PopCnt64Op = 185 +primOpTag PopCntOp = 186 +primOpTag Pdep8Op = 187 +primOpTag Pdep16Op = 188 +primOpTag Pdep32Op = 189 +primOpTag Pdep64Op = 190 +primOpTag PdepOp = 191 +primOpTag Pext8Op = 192 +primOpTag Pext16Op = 193 +primOpTag Pext32Op = 194 +primOpTag Pext64Op = 195 +primOpTag PextOp = 196 +primOpTag Clz8Op = 197 +primOpTag Clz16Op = 198 +primOpTag Clz32Op = 199 +primOpTag Clz64Op = 200 +primOpTag ClzOp = 201 +primOpTag Ctz8Op = 202 +primOpTag Ctz16Op = 203 +primOpTag Ctz32Op = 204 +primOpTag Ctz64Op = 205 +primOpTag CtzOp = 206 +primOpTag BSwap16Op = 207 +primOpTag BSwap32Op = 208 +primOpTag BSwap64Op = 209 +primOpTag BSwapOp = 210 +primOpTag BRev8Op = 211 +primOpTag BRev16Op = 212 +primOpTag BRev32Op = 213 +primOpTag BRev64Op = 214 +primOpTag BRevOp = 215 +primOpTag Narrow8IntOp = 216 +primOpTag Narrow16IntOp = 217 +primOpTag Narrow32IntOp = 218 +primOpTag Narrow8WordOp = 219 +primOpTag Narrow16WordOp = 220 +primOpTag Narrow32WordOp = 221 +primOpTag DoubleGtOp = 222 +primOpTag DoubleGeOp = 223 +primOpTag DoubleEqOp = 224 +primOpTag DoubleNeOp = 225 +primOpTag DoubleLtOp = 226 +primOpTag DoubleLeOp = 227 +primOpTag DoubleAddOp = 228 +primOpTag DoubleSubOp = 229 +primOpTag DoubleMulOp = 230 +primOpTag DoubleDivOp = 231 +primOpTag DoubleNegOp = 232 +primOpTag DoubleFabsOp = 233 +primOpTag DoubleToIntOp = 234 +primOpTag DoubleToFloatOp = 235 +primOpTag DoubleExpOp = 236 +primOpTag DoubleExpM1Op = 237 +primOpTag DoubleLogOp = 238 +primOpTag DoubleLog1POp = 239 +primOpTag DoubleSqrtOp = 240 +primOpTag DoubleSinOp = 241 +primOpTag DoubleCosOp = 242 +primOpTag DoubleTanOp = 243 +primOpTag DoubleAsinOp = 244 +primOpTag DoubleAcosOp = 245 +primOpTag DoubleAtanOp = 246 +primOpTag DoubleSinhOp = 247 +primOpTag DoubleCoshOp = 248 +primOpTag DoubleTanhOp = 249 +primOpTag DoubleAsinhOp = 250 +primOpTag DoubleAcoshOp = 251 +primOpTag DoubleAtanhOp = 252 +primOpTag DoublePowerOp = 253 +primOpTag DoubleDecode_2IntOp = 254 +primOpTag DoubleDecode_Int64Op = 255 +primOpTag FloatGtOp = 256 +primOpTag FloatGeOp = 257 +primOpTag FloatEqOp = 258 +primOpTag FloatNeOp = 259 +primOpTag FloatLtOp = 260 +primOpTag FloatLeOp = 261 +primOpTag FloatAddOp = 262 +primOpTag FloatSubOp = 263 +primOpTag FloatMulOp = 264 +primOpTag FloatDivOp = 265 +primOpTag FloatNegOp = 266 +primOpTag FloatFabsOp = 267 +primOpTag FloatToIntOp = 268 +primOpTag FloatExpOp = 269 +primOpTag FloatExpM1Op = 270 +primOpTag FloatLogOp = 271 +primOpTag FloatLog1POp = 272 +primOpTag FloatSqrtOp = 273 +primOpTag FloatSinOp = 274 +primOpTag FloatCosOp = 275 +primOpTag FloatTanOp = 276 +primOpTag FloatAsinOp = 277 +primOpTag FloatAcosOp = 278 +primOpTag FloatAtanOp = 279 +primOpTag FloatSinhOp = 280 +primOpTag FloatCoshOp = 281 +primOpTag FloatTanhOp = 282 +primOpTag FloatAsinhOp = 283 +primOpTag FloatAcoshOp = 284 +primOpTag FloatAtanhOp = 285 +primOpTag FloatPowerOp = 286 +primOpTag FloatToDoubleOp = 287 +primOpTag FloatDecode_IntOp = 288 +primOpTag NewArrayOp = 289 +primOpTag ReadArrayOp = 290 +primOpTag WriteArrayOp = 291 +primOpTag SizeofArrayOp = 292 +primOpTag SizeofMutableArrayOp = 293 +primOpTag IndexArrayOp = 294 +primOpTag UnsafeFreezeArrayOp = 295 +primOpTag UnsafeThawArrayOp = 296 +primOpTag CopyArrayOp = 297 +primOpTag CopyMutableArrayOp = 298 +primOpTag CloneArrayOp = 299 +primOpTag CloneMutableArrayOp = 300 +primOpTag FreezeArrayOp = 301 +primOpTag ThawArrayOp = 302 +primOpTag CasArrayOp = 303 +primOpTag NewSmallArrayOp = 304 +primOpTag ShrinkSmallMutableArrayOp_Char = 305 +primOpTag ReadSmallArrayOp = 306 +primOpTag WriteSmallArrayOp = 307 +primOpTag SizeofSmallArrayOp = 308 +primOpTag SizeofSmallMutableArrayOp = 309 +primOpTag GetSizeofSmallMutableArrayOp = 310 +primOpTag IndexSmallArrayOp = 311 +primOpTag UnsafeFreezeSmallArrayOp = 312 +primOpTag UnsafeThawSmallArrayOp = 313 +primOpTag CopySmallArrayOp = 314 +primOpTag CopySmallMutableArrayOp = 315 +primOpTag CloneSmallArrayOp = 316 +primOpTag CloneSmallMutableArrayOp = 317 +primOpTag FreezeSmallArrayOp = 318 +primOpTag ThawSmallArrayOp = 319 +primOpTag CasSmallArrayOp = 320 +primOpTag NewByteArrayOp_Char = 321 +primOpTag NewPinnedByteArrayOp_Char = 322 +primOpTag NewAlignedPinnedByteArrayOp_Char = 323 +primOpTag MutableByteArrayIsPinnedOp = 324 +primOpTag ByteArrayIsPinnedOp = 325 +primOpTag ByteArrayContents_Char = 326 +primOpTag MutableByteArrayContents_Char = 327 +primOpTag ShrinkMutableByteArrayOp_Char = 328 +primOpTag ResizeMutableByteArrayOp_Char = 329 +primOpTag UnsafeFreezeByteArrayOp = 330 +primOpTag SizeofByteArrayOp = 331 +primOpTag SizeofMutableByteArrayOp = 332 +primOpTag GetSizeofMutableByteArrayOp = 333 +primOpTag IndexByteArrayOp_Char = 334 +primOpTag IndexByteArrayOp_WideChar = 335 +primOpTag IndexByteArrayOp_Int = 336 +primOpTag IndexByteArrayOp_Word = 337 +primOpTag IndexByteArrayOp_Addr = 338 +primOpTag IndexByteArrayOp_Float = 339 +primOpTag IndexByteArrayOp_Double = 340 +primOpTag IndexByteArrayOp_StablePtr = 341 +primOpTag IndexByteArrayOp_Int8 = 342 +primOpTag IndexByteArrayOp_Int16 = 343 +primOpTag IndexByteArrayOp_Int32 = 344 +primOpTag IndexByteArrayOp_Int64 = 345 +primOpTag IndexByteArrayOp_Word8 = 346 +primOpTag IndexByteArrayOp_Word16 = 347 +primOpTag IndexByteArrayOp_Word32 = 348 +primOpTag IndexByteArrayOp_Word64 = 349 +primOpTag IndexByteArrayOp_Word8AsChar = 350 +primOpTag IndexByteArrayOp_Word8AsWideChar = 351 +primOpTag IndexByteArrayOp_Word8AsInt = 352 +primOpTag IndexByteArrayOp_Word8AsWord = 353 +primOpTag IndexByteArrayOp_Word8AsAddr = 354 +primOpTag IndexByteArrayOp_Word8AsFloat = 355 +primOpTag IndexByteArrayOp_Word8AsDouble = 356 +primOpTag IndexByteArrayOp_Word8AsStablePtr = 357 +primOpTag IndexByteArrayOp_Word8AsInt16 = 358 +primOpTag IndexByteArrayOp_Word8AsInt32 = 359 +primOpTag IndexByteArrayOp_Word8AsInt64 = 360 +primOpTag IndexByteArrayOp_Word8AsWord16 = 361 +primOpTag IndexByteArrayOp_Word8AsWord32 = 362 +primOpTag IndexByteArrayOp_Word8AsWord64 = 363 +primOpTag ReadByteArrayOp_Char = 364 +primOpTag ReadByteArrayOp_WideChar = 365 +primOpTag ReadByteArrayOp_Int = 366 +primOpTag ReadByteArrayOp_Word = 367 +primOpTag ReadByteArrayOp_Addr = 368 +primOpTag ReadByteArrayOp_Float = 369 +primOpTag ReadByteArrayOp_Double = 370 +primOpTag ReadByteArrayOp_StablePtr = 371 +primOpTag ReadByteArrayOp_Int8 = 372 +primOpTag ReadByteArrayOp_Int16 = 373 +primOpTag ReadByteArrayOp_Int32 = 374 +primOpTag ReadByteArrayOp_Int64 = 375 +primOpTag ReadByteArrayOp_Word8 = 376 +primOpTag ReadByteArrayOp_Word16 = 377 +primOpTag ReadByteArrayOp_Word32 = 378 +primOpTag ReadByteArrayOp_Word64 = 379 +primOpTag ReadByteArrayOp_Word8AsChar = 380 +primOpTag ReadByteArrayOp_Word8AsWideChar = 381 +primOpTag ReadByteArrayOp_Word8AsInt = 382 +primOpTag ReadByteArrayOp_Word8AsWord = 383 +primOpTag ReadByteArrayOp_Word8AsAddr = 384 +primOpTag ReadByteArrayOp_Word8AsFloat = 385 +primOpTag ReadByteArrayOp_Word8AsDouble = 386 +primOpTag ReadByteArrayOp_Word8AsStablePtr = 387 +primOpTag ReadByteArrayOp_Word8AsInt16 = 388 +primOpTag ReadByteArrayOp_Word8AsInt32 = 389 +primOpTag ReadByteArrayOp_Word8AsInt64 = 390 +primOpTag ReadByteArrayOp_Word8AsWord16 = 391 +primOpTag ReadByteArrayOp_Word8AsWord32 = 392 +primOpTag ReadByteArrayOp_Word8AsWord64 = 393 +primOpTag WriteByteArrayOp_Char = 394 +primOpTag WriteByteArrayOp_WideChar = 395 +primOpTag WriteByteArrayOp_Int = 396 +primOpTag WriteByteArrayOp_Word = 397 +primOpTag WriteByteArrayOp_Addr = 398 +primOpTag WriteByteArrayOp_Float = 399 +primOpTag WriteByteArrayOp_Double = 400 +primOpTag WriteByteArrayOp_StablePtr = 401 +primOpTag WriteByteArrayOp_Int8 = 402 +primOpTag WriteByteArrayOp_Int16 = 403 +primOpTag WriteByteArrayOp_Int32 = 404 +primOpTag WriteByteArrayOp_Int64 = 405 +primOpTag WriteByteArrayOp_Word8 = 406 +primOpTag WriteByteArrayOp_Word16 = 407 +primOpTag WriteByteArrayOp_Word32 = 408 +primOpTag WriteByteArrayOp_Word64 = 409 +primOpTag WriteByteArrayOp_Word8AsChar = 410 +primOpTag WriteByteArrayOp_Word8AsWideChar = 411 +primOpTag WriteByteArrayOp_Word8AsInt = 412 +primOpTag WriteByteArrayOp_Word8AsWord = 413 +primOpTag WriteByteArrayOp_Word8AsAddr = 414 +primOpTag WriteByteArrayOp_Word8AsFloat = 415 +primOpTag WriteByteArrayOp_Word8AsDouble = 416 +primOpTag WriteByteArrayOp_Word8AsStablePtr = 417 +primOpTag WriteByteArrayOp_Word8AsInt16 = 418 +primOpTag WriteByteArrayOp_Word8AsInt32 = 419 +primOpTag WriteByteArrayOp_Word8AsInt64 = 420 +primOpTag WriteByteArrayOp_Word8AsWord16 = 421 +primOpTag WriteByteArrayOp_Word8AsWord32 = 422 +primOpTag WriteByteArrayOp_Word8AsWord64 = 423 +primOpTag CompareByteArraysOp = 424 +primOpTag CopyByteArrayOp = 425 +primOpTag CopyMutableByteArrayOp = 426 +primOpTag CopyByteArrayToAddrOp = 427 +primOpTag CopyMutableByteArrayToAddrOp = 428 +primOpTag CopyAddrToByteArrayOp = 429 +primOpTag SetByteArrayOp = 430 +primOpTag AtomicReadByteArrayOp_Int = 431 +primOpTag AtomicWriteByteArrayOp_Int = 432 +primOpTag CasByteArrayOp_Int = 433 +primOpTag FetchAddByteArrayOp_Int = 434 +primOpTag FetchSubByteArrayOp_Int = 435 +primOpTag FetchAndByteArrayOp_Int = 436 +primOpTag FetchNandByteArrayOp_Int = 437 +primOpTag FetchOrByteArrayOp_Int = 438 +primOpTag FetchXorByteArrayOp_Int = 439 +primOpTag NewArrayArrayOp = 440 +primOpTag UnsafeFreezeArrayArrayOp = 441 +primOpTag SizeofArrayArrayOp = 442 +primOpTag SizeofMutableArrayArrayOp = 443 +primOpTag IndexArrayArrayOp_ByteArray = 444 +primOpTag IndexArrayArrayOp_ArrayArray = 445 +primOpTag ReadArrayArrayOp_ByteArray = 446 +primOpTag ReadArrayArrayOp_MutableByteArray = 447 +primOpTag ReadArrayArrayOp_ArrayArray = 448 +primOpTag ReadArrayArrayOp_MutableArrayArray = 449 +primOpTag WriteArrayArrayOp_ByteArray = 450 +primOpTag WriteArrayArrayOp_MutableByteArray = 451 +primOpTag WriteArrayArrayOp_ArrayArray = 452 +primOpTag WriteArrayArrayOp_MutableArrayArray = 453 +primOpTag CopyArrayArrayOp = 454 +primOpTag CopyMutableArrayArrayOp = 455 +primOpTag AddrAddOp = 456 +primOpTag AddrSubOp = 457 +primOpTag AddrRemOp = 458 +primOpTag AddrToIntOp = 459 +primOpTag IntToAddrOp = 460 +primOpTag AddrGtOp = 461 +primOpTag AddrGeOp = 462 +primOpTag AddrEqOp = 463 +primOpTag AddrNeOp = 464 +primOpTag AddrLtOp = 465 +primOpTag AddrLeOp = 466 +primOpTag IndexOffAddrOp_Char = 467 +primOpTag IndexOffAddrOp_WideChar = 468 +primOpTag IndexOffAddrOp_Int = 469 +primOpTag IndexOffAddrOp_Word = 470 +primOpTag IndexOffAddrOp_Addr = 471 +primOpTag IndexOffAddrOp_Float = 472 +primOpTag IndexOffAddrOp_Double = 473 +primOpTag IndexOffAddrOp_StablePtr = 474 +primOpTag IndexOffAddrOp_Int8 = 475 +primOpTag IndexOffAddrOp_Int16 = 476 +primOpTag IndexOffAddrOp_Int32 = 477 +primOpTag IndexOffAddrOp_Int64 = 478 +primOpTag IndexOffAddrOp_Word8 = 479 +primOpTag IndexOffAddrOp_Word16 = 480 +primOpTag IndexOffAddrOp_Word32 = 481 +primOpTag IndexOffAddrOp_Word64 = 482 +primOpTag ReadOffAddrOp_Char = 483 +primOpTag ReadOffAddrOp_WideChar = 484 +primOpTag ReadOffAddrOp_Int = 485 +primOpTag ReadOffAddrOp_Word = 486 +primOpTag ReadOffAddrOp_Addr = 487 +primOpTag ReadOffAddrOp_Float = 488 +primOpTag ReadOffAddrOp_Double = 489 +primOpTag ReadOffAddrOp_StablePtr = 490 +primOpTag ReadOffAddrOp_Int8 = 491 +primOpTag ReadOffAddrOp_Int16 = 492 +primOpTag ReadOffAddrOp_Int32 = 493 +primOpTag ReadOffAddrOp_Int64 = 494 +primOpTag ReadOffAddrOp_Word8 = 495 +primOpTag ReadOffAddrOp_Word16 = 496 +primOpTag ReadOffAddrOp_Word32 = 497 +primOpTag ReadOffAddrOp_Word64 = 498 +primOpTag WriteOffAddrOp_Char = 499 +primOpTag WriteOffAddrOp_WideChar = 500 +primOpTag WriteOffAddrOp_Int = 501 +primOpTag WriteOffAddrOp_Word = 502 +primOpTag WriteOffAddrOp_Addr = 503 +primOpTag WriteOffAddrOp_Float = 504 +primOpTag WriteOffAddrOp_Double = 505 +primOpTag WriteOffAddrOp_StablePtr = 506 +primOpTag WriteOffAddrOp_Int8 = 507 +primOpTag WriteOffAddrOp_Int16 = 508 +primOpTag WriteOffAddrOp_Int32 = 509 +primOpTag WriteOffAddrOp_Int64 = 510 +primOpTag WriteOffAddrOp_Word8 = 511 +primOpTag WriteOffAddrOp_Word16 = 512 +primOpTag WriteOffAddrOp_Word32 = 513 +primOpTag WriteOffAddrOp_Word64 = 514 +primOpTag InterlockedExchange_Addr = 515 +primOpTag InterlockedExchange_Word = 516 +primOpTag CasAddrOp_Addr = 517 +primOpTag CasAddrOp_Word = 518 +primOpTag FetchAddAddrOp_Word = 519 +primOpTag FetchSubAddrOp_Word = 520 +primOpTag FetchAndAddrOp_Word = 521 +primOpTag FetchNandAddrOp_Word = 522 +primOpTag FetchOrAddrOp_Word = 523 +primOpTag FetchXorAddrOp_Word = 524 +primOpTag AtomicReadAddrOp_Word = 525 +primOpTag AtomicWriteAddrOp_Word = 526 +primOpTag NewMutVarOp = 527 +primOpTag ReadMutVarOp = 528 +primOpTag WriteMutVarOp = 529 +primOpTag AtomicModifyMutVar2Op = 530 +primOpTag AtomicModifyMutVar_Op = 531 +primOpTag CasMutVarOp = 532 +primOpTag CatchOp = 533 +primOpTag RaiseOp = 534 +primOpTag RaiseIOOp = 535 +primOpTag MaskAsyncExceptionsOp = 536 +primOpTag MaskUninterruptibleOp = 537 +primOpTag UnmaskAsyncExceptionsOp = 538 +primOpTag MaskStatus = 539 +primOpTag AtomicallyOp = 540 +primOpTag RetryOp = 541 +primOpTag CatchRetryOp = 542 +primOpTag CatchSTMOp = 543 +primOpTag NewTVarOp = 544 +primOpTag ReadTVarOp = 545 +primOpTag ReadTVarIOOp = 546 +primOpTag WriteTVarOp = 547 +primOpTag NewMVarOp = 548 +primOpTag TakeMVarOp = 549 +primOpTag TryTakeMVarOp = 550 +primOpTag PutMVarOp = 551 +primOpTag TryPutMVarOp = 552 +primOpTag ReadMVarOp = 553 +primOpTag TryReadMVarOp = 554 +primOpTag IsEmptyMVarOp = 555 +primOpTag NewIOPortrOp = 556 +primOpTag ReadIOPortOp = 557 +primOpTag WriteIOPortOp = 558 +primOpTag DelayOp = 559 +primOpTag WaitReadOp = 560 +primOpTag WaitWriteOp = 561 +primOpTag ForkOp = 562 +primOpTag ForkOnOp = 563 +primOpTag KillThreadOp = 564 +primOpTag YieldOp = 565 +primOpTag MyThreadIdOp = 566 +primOpTag LabelThreadOp = 567 +primOpTag IsCurrentThreadBoundOp = 568 +primOpTag NoDuplicateOp = 569 +primOpTag ThreadStatusOp = 570 +primOpTag MkWeakOp = 571 +primOpTag MkWeakNoFinalizerOp = 572 +primOpTag AddCFinalizerToWeakOp = 573 +primOpTag DeRefWeakOp = 574 +primOpTag FinalizeWeakOp = 575 +primOpTag TouchOp = 576 +primOpTag MakeStablePtrOp = 577 +primOpTag DeRefStablePtrOp = 578 +primOpTag EqStablePtrOp = 579 +primOpTag MakeStableNameOp = 580 +primOpTag StableNameToIntOp = 581 +primOpTag CompactNewOp = 582 +primOpTag CompactResizeOp = 583 +primOpTag CompactContainsOp = 584 +primOpTag CompactContainsAnyOp = 585 +primOpTag CompactGetFirstBlockOp = 586 +primOpTag CompactGetNextBlockOp = 587 +primOpTag CompactAllocateBlockOp = 588 +primOpTag CompactFixupPointersOp = 589 +primOpTag CompactAdd = 590 +primOpTag CompactAddWithSharing = 591 +primOpTag CompactSize = 592 +primOpTag ReallyUnsafePtrEqualityOp = 593 +primOpTag ParOp = 594 +primOpTag SparkOp = 595 +primOpTag SeqOp = 596 +primOpTag GetSparkOp = 597 +primOpTag NumSparks = 598 +primOpTag KeepAliveOp = 599 +primOpTag DataToTagOp = 600 +primOpTag TagToEnumOp = 601 +primOpTag AddrToAnyOp = 602 +primOpTag AnyToAddrOp = 603 +primOpTag MkApUpd0_Op = 604 +primOpTag NewBCOOp = 605 +primOpTag UnpackClosureOp = 606 +primOpTag ClosureSizeOp = 607 +primOpTag GetApStackValOp = 608 +primOpTag GetCCSOfOp = 609 +primOpTag GetCurrentCCSOp = 610 +primOpTag ClearCCSOp = 611 +primOpTag WhereFromOp = 612 +primOpTag TraceEventOp = 613 +primOpTag TraceEventBinaryOp = 614 +primOpTag TraceMarkerOp = 615 +primOpTag SetThreadAllocationCounter = 616 +primOpTag (VecBroadcastOp IntVec 16 W8) = 617 +primOpTag (VecBroadcastOp IntVec 8 W16) = 618 +primOpTag (VecBroadcastOp IntVec 4 W32) = 619 +primOpTag (VecBroadcastOp IntVec 2 W64) = 620 +primOpTag (VecBroadcastOp IntVec 32 W8) = 621 +primOpTag (VecBroadcastOp IntVec 16 W16) = 622 +primOpTag (VecBroadcastOp IntVec 8 W32) = 623 +primOpTag (VecBroadcastOp IntVec 4 W64) = 624 +primOpTag (VecBroadcastOp IntVec 64 W8) = 625 +primOpTag (VecBroadcastOp IntVec 32 W16) = 626 +primOpTag (VecBroadcastOp IntVec 16 W32) = 627 +primOpTag (VecBroadcastOp IntVec 8 W64) = 628 +primOpTag (VecBroadcastOp WordVec 16 W8) = 629 +primOpTag (VecBroadcastOp WordVec 8 W16) = 630 +primOpTag (VecBroadcastOp WordVec 4 W32) = 631 +primOpTag (VecBroadcastOp WordVec 2 W64) = 632 +primOpTag (VecBroadcastOp WordVec 32 W8) = 633 +primOpTag (VecBroadcastOp WordVec 16 W16) = 634 +primOpTag (VecBroadcastOp WordVec 8 W32) = 635 +primOpTag (VecBroadcastOp WordVec 4 W64) = 636 +primOpTag (VecBroadcastOp WordVec 64 W8) = 637 +primOpTag (VecBroadcastOp WordVec 32 W16) = 638 +primOpTag (VecBroadcastOp WordVec 16 W32) = 639 +primOpTag (VecBroadcastOp WordVec 8 W64) = 640 +primOpTag (VecBroadcastOp FloatVec 4 W32) = 641 +primOpTag (VecBroadcastOp FloatVec 2 W64) = 642 +primOpTag (VecBroadcastOp FloatVec 8 W32) = 643 +primOpTag (VecBroadcastOp FloatVec 4 W64) = 644 +primOpTag (VecBroadcastOp FloatVec 16 W32) = 645 +primOpTag (VecBroadcastOp FloatVec 8 W64) = 646 +primOpTag (VecPackOp IntVec 16 W8) = 647 +primOpTag (VecPackOp IntVec 8 W16) = 648 +primOpTag (VecPackOp IntVec 4 W32) = 649 +primOpTag (VecPackOp IntVec 2 W64) = 650 +primOpTag (VecPackOp IntVec 32 W8) = 651 +primOpTag (VecPackOp IntVec 16 W16) = 652 +primOpTag (VecPackOp IntVec 8 W32) = 653 +primOpTag (VecPackOp IntVec 4 W64) = 654 +primOpTag (VecPackOp IntVec 64 W8) = 655 +primOpTag (VecPackOp IntVec 32 W16) = 656 +primOpTag (VecPackOp IntVec 16 W32) = 657 +primOpTag (VecPackOp IntVec 8 W64) = 658 +primOpTag (VecPackOp WordVec 16 W8) = 659 +primOpTag (VecPackOp WordVec 8 W16) = 660 +primOpTag (VecPackOp WordVec 4 W32) = 661 +primOpTag (VecPackOp WordVec 2 W64) = 662 +primOpTag (VecPackOp WordVec 32 W8) = 663 +primOpTag (VecPackOp WordVec 16 W16) = 664 +primOpTag (VecPackOp WordVec 8 W32) = 665 +primOpTag (VecPackOp WordVec 4 W64) = 666 +primOpTag (VecPackOp WordVec 64 W8) = 667 +primOpTag (VecPackOp WordVec 32 W16) = 668 +primOpTag (VecPackOp WordVec 16 W32) = 669 +primOpTag (VecPackOp WordVec 8 W64) = 670 +primOpTag (VecPackOp FloatVec 4 W32) = 671 +primOpTag (VecPackOp FloatVec 2 W64) = 672 +primOpTag (VecPackOp FloatVec 8 W32) = 673 +primOpTag (VecPackOp FloatVec 4 W64) = 674 +primOpTag (VecPackOp FloatVec 16 W32) = 675 +primOpTag (VecPackOp FloatVec 8 W64) = 676 +primOpTag (VecUnpackOp IntVec 16 W8) = 677 +primOpTag (VecUnpackOp IntVec 8 W16) = 678 +primOpTag (VecUnpackOp IntVec 4 W32) = 679 +primOpTag (VecUnpackOp IntVec 2 W64) = 680 +primOpTag (VecUnpackOp IntVec 32 W8) = 681 +primOpTag (VecUnpackOp IntVec 16 W16) = 682 +primOpTag (VecUnpackOp IntVec 8 W32) = 683 +primOpTag (VecUnpackOp IntVec 4 W64) = 684 +primOpTag (VecUnpackOp IntVec 64 W8) = 685 +primOpTag (VecUnpackOp IntVec 32 W16) = 686 +primOpTag (VecUnpackOp IntVec 16 W32) = 687 +primOpTag (VecUnpackOp IntVec 8 W64) = 688 +primOpTag (VecUnpackOp WordVec 16 W8) = 689 +primOpTag (VecUnpackOp WordVec 8 W16) = 690 +primOpTag (VecUnpackOp WordVec 4 W32) = 691 +primOpTag (VecUnpackOp WordVec 2 W64) = 692 +primOpTag (VecUnpackOp WordVec 32 W8) = 693 +primOpTag (VecUnpackOp WordVec 16 W16) = 694 +primOpTag (VecUnpackOp WordVec 8 W32) = 695 +primOpTag (VecUnpackOp WordVec 4 W64) = 696 +primOpTag (VecUnpackOp WordVec 64 W8) = 697 +primOpTag (VecUnpackOp WordVec 32 W16) = 698 +primOpTag (VecUnpackOp WordVec 16 W32) = 699 +primOpTag (VecUnpackOp WordVec 8 W64) = 700 +primOpTag (VecUnpackOp FloatVec 4 W32) = 701 +primOpTag (VecUnpackOp FloatVec 2 W64) = 702 +primOpTag (VecUnpackOp FloatVec 8 W32) = 703 +primOpTag (VecUnpackOp FloatVec 4 W64) = 704 +primOpTag (VecUnpackOp FloatVec 16 W32) = 705 +primOpTag (VecUnpackOp FloatVec 8 W64) = 706 +primOpTag (VecInsertOp IntVec 16 W8) = 707 +primOpTag (VecInsertOp IntVec 8 W16) = 708 +primOpTag (VecInsertOp IntVec 4 W32) = 709 +primOpTag (VecInsertOp IntVec 2 W64) = 710 +primOpTag (VecInsertOp IntVec 32 W8) = 711 +primOpTag (VecInsertOp IntVec 16 W16) = 712 +primOpTag (VecInsertOp IntVec 8 W32) = 713 +primOpTag (VecInsertOp IntVec 4 W64) = 714 +primOpTag (VecInsertOp IntVec 64 W8) = 715 +primOpTag (VecInsertOp IntVec 32 W16) = 716 +primOpTag (VecInsertOp IntVec 16 W32) = 717 +primOpTag (VecInsertOp IntVec 8 W64) = 718 +primOpTag (VecInsertOp WordVec 16 W8) = 719 +primOpTag (VecInsertOp WordVec 8 W16) = 720 +primOpTag (VecInsertOp WordVec 4 W32) = 721 +primOpTag (VecInsertOp WordVec 2 W64) = 722 +primOpTag (VecInsertOp WordVec 32 W8) = 723 +primOpTag (VecInsertOp WordVec 16 W16) = 724 +primOpTag (VecInsertOp WordVec 8 W32) = 725 +primOpTag (VecInsertOp WordVec 4 W64) = 726 +primOpTag (VecInsertOp WordVec 64 W8) = 727 +primOpTag (VecInsertOp WordVec 32 W16) = 728 +primOpTag (VecInsertOp WordVec 16 W32) = 729 +primOpTag (VecInsertOp WordVec 8 W64) = 730 +primOpTag (VecInsertOp FloatVec 4 W32) = 731 +primOpTag (VecInsertOp FloatVec 2 W64) = 732 +primOpTag (VecInsertOp FloatVec 8 W32) = 733 +primOpTag (VecInsertOp FloatVec 4 W64) = 734 +primOpTag (VecInsertOp FloatVec 16 W32) = 735 +primOpTag (VecInsertOp FloatVec 8 W64) = 736 +primOpTag (VecAddOp IntVec 16 W8) = 737 +primOpTag (VecAddOp IntVec 8 W16) = 738 +primOpTag (VecAddOp IntVec 4 W32) = 739 +primOpTag (VecAddOp IntVec 2 W64) = 740 +primOpTag (VecAddOp IntVec 32 W8) = 741 +primOpTag (VecAddOp IntVec 16 W16) = 742 +primOpTag (VecAddOp IntVec 8 W32) = 743 +primOpTag (VecAddOp IntVec 4 W64) = 744 +primOpTag (VecAddOp IntVec 64 W8) = 745 +primOpTag (VecAddOp IntVec 32 W16) = 746 +primOpTag (VecAddOp IntVec 16 W32) = 747 +primOpTag (VecAddOp IntVec 8 W64) = 748 +primOpTag (VecAddOp WordVec 16 W8) = 749 +primOpTag (VecAddOp WordVec 8 W16) = 750 +primOpTag (VecAddOp WordVec 4 W32) = 751 +primOpTag (VecAddOp WordVec 2 W64) = 752 +primOpTag (VecAddOp WordVec 32 W8) = 753 +primOpTag (VecAddOp WordVec 16 W16) = 754 +primOpTag (VecAddOp WordVec 8 W32) = 755 +primOpTag (VecAddOp WordVec 4 W64) = 756 +primOpTag (VecAddOp WordVec 64 W8) = 757 +primOpTag (VecAddOp WordVec 32 W16) = 758 +primOpTag (VecAddOp WordVec 16 W32) = 759 +primOpTag (VecAddOp WordVec 8 W64) = 760 +primOpTag (VecAddOp FloatVec 4 W32) = 761 +primOpTag (VecAddOp FloatVec 2 W64) = 762 +primOpTag (VecAddOp FloatVec 8 W32) = 763 +primOpTag (VecAddOp FloatVec 4 W64) = 764 +primOpTag (VecAddOp FloatVec 16 W32) = 765 +primOpTag (VecAddOp FloatVec 8 W64) = 766 +primOpTag (VecSubOp IntVec 16 W8) = 767 +primOpTag (VecSubOp IntVec 8 W16) = 768 +primOpTag (VecSubOp IntVec 4 W32) = 769 +primOpTag (VecSubOp IntVec 2 W64) = 770 +primOpTag (VecSubOp IntVec 32 W8) = 771 +primOpTag (VecSubOp IntVec 16 W16) = 772 +primOpTag (VecSubOp IntVec 8 W32) = 773 +primOpTag (VecSubOp IntVec 4 W64) = 774 +primOpTag (VecSubOp IntVec 64 W8) = 775 +primOpTag (VecSubOp IntVec 32 W16) = 776 +primOpTag (VecSubOp IntVec 16 W32) = 777 +primOpTag (VecSubOp IntVec 8 W64) = 778 +primOpTag (VecSubOp WordVec 16 W8) = 779 +primOpTag (VecSubOp WordVec 8 W16) = 780 +primOpTag (VecSubOp WordVec 4 W32) = 781 +primOpTag (VecSubOp WordVec 2 W64) = 782 +primOpTag (VecSubOp WordVec 32 W8) = 783 +primOpTag (VecSubOp WordVec 16 W16) = 784 +primOpTag (VecSubOp WordVec 8 W32) = 785 +primOpTag (VecSubOp WordVec 4 W64) = 786 +primOpTag (VecSubOp WordVec 64 W8) = 787 +primOpTag (VecSubOp WordVec 32 W16) = 788 +primOpTag (VecSubOp WordVec 16 W32) = 789 +primOpTag (VecSubOp WordVec 8 W64) = 790 +primOpTag (VecSubOp FloatVec 4 W32) = 791 +primOpTag (VecSubOp FloatVec 2 W64) = 792 +primOpTag (VecSubOp FloatVec 8 W32) = 793 +primOpTag (VecSubOp FloatVec 4 W64) = 794 +primOpTag (VecSubOp FloatVec 16 W32) = 795 +primOpTag (VecSubOp FloatVec 8 W64) = 796 +primOpTag (VecMulOp IntVec 16 W8) = 797 +primOpTag (VecMulOp IntVec 8 W16) = 798 +primOpTag (VecMulOp IntVec 4 W32) = 799 +primOpTag (VecMulOp IntVec 2 W64) = 800 +primOpTag (VecMulOp IntVec 32 W8) = 801 +primOpTag (VecMulOp IntVec 16 W16) = 802 +primOpTag (VecMulOp IntVec 8 W32) = 803 +primOpTag (VecMulOp IntVec 4 W64) = 804 +primOpTag (VecMulOp IntVec 64 W8) = 805 +primOpTag (VecMulOp IntVec 32 W16) = 806 +primOpTag (VecMulOp IntVec 16 W32) = 807 +primOpTag (VecMulOp IntVec 8 W64) = 808 +primOpTag (VecMulOp WordVec 16 W8) = 809 +primOpTag (VecMulOp WordVec 8 W16) = 810 +primOpTag (VecMulOp WordVec 4 W32) = 811 +primOpTag (VecMulOp WordVec 2 W64) = 812 +primOpTag (VecMulOp WordVec 32 W8) = 813 +primOpTag (VecMulOp WordVec 16 W16) = 814 +primOpTag (VecMulOp WordVec 8 W32) = 815 +primOpTag (VecMulOp WordVec 4 W64) = 816 +primOpTag (VecMulOp WordVec 64 W8) = 817 +primOpTag (VecMulOp WordVec 32 W16) = 818 +primOpTag (VecMulOp WordVec 16 W32) = 819 +primOpTag (VecMulOp WordVec 8 W64) = 820 +primOpTag (VecMulOp FloatVec 4 W32) = 821 +primOpTag (VecMulOp FloatVec 2 W64) = 822 +primOpTag (VecMulOp FloatVec 8 W32) = 823 +primOpTag (VecMulOp FloatVec 4 W64) = 824 +primOpTag (VecMulOp FloatVec 16 W32) = 825 +primOpTag (VecMulOp FloatVec 8 W64) = 826 +primOpTag (VecDivOp FloatVec 4 W32) = 827 +primOpTag (VecDivOp FloatVec 2 W64) = 828 +primOpTag (VecDivOp FloatVec 8 W32) = 829 +primOpTag (VecDivOp FloatVec 4 W64) = 830 +primOpTag (VecDivOp FloatVec 16 W32) = 831 +primOpTag (VecDivOp FloatVec 8 W64) = 832 +primOpTag (VecQuotOp IntVec 16 W8) = 833 +primOpTag (VecQuotOp IntVec 8 W16) = 834 +primOpTag (VecQuotOp IntVec 4 W32) = 835 +primOpTag (VecQuotOp IntVec 2 W64) = 836 +primOpTag (VecQuotOp IntVec 32 W8) = 837 +primOpTag (VecQuotOp IntVec 16 W16) = 838 +primOpTag (VecQuotOp IntVec 8 W32) = 839 +primOpTag (VecQuotOp IntVec 4 W64) = 840 +primOpTag (VecQuotOp IntVec 64 W8) = 841 +primOpTag (VecQuotOp IntVec 32 W16) = 842 +primOpTag (VecQuotOp IntVec 16 W32) = 843 +primOpTag (VecQuotOp IntVec 8 W64) = 844 +primOpTag (VecQuotOp WordVec 16 W8) = 845 +primOpTag (VecQuotOp WordVec 8 W16) = 846 +primOpTag (VecQuotOp WordVec 4 W32) = 847 +primOpTag (VecQuotOp WordVec 2 W64) = 848 +primOpTag (VecQuotOp WordVec 32 W8) = 849 +primOpTag (VecQuotOp WordVec 16 W16) = 850 +primOpTag (VecQuotOp WordVec 8 W32) = 851 +primOpTag (VecQuotOp WordVec 4 W64) = 852 +primOpTag (VecQuotOp WordVec 64 W8) = 853 +primOpTag (VecQuotOp WordVec 32 W16) = 854 +primOpTag (VecQuotOp WordVec 16 W32) = 855 +primOpTag (VecQuotOp WordVec 8 W64) = 856 +primOpTag (VecRemOp IntVec 16 W8) = 857 +primOpTag (VecRemOp IntVec 8 W16) = 858 +primOpTag (VecRemOp IntVec 4 W32) = 859 +primOpTag (VecRemOp IntVec 2 W64) = 860 +primOpTag (VecRemOp IntVec 32 W8) = 861 +primOpTag (VecRemOp IntVec 16 W16) = 862 +primOpTag (VecRemOp IntVec 8 W32) = 863 +primOpTag (VecRemOp IntVec 4 W64) = 864 +primOpTag (VecRemOp IntVec 64 W8) = 865 +primOpTag (VecRemOp IntVec 32 W16) = 866 +primOpTag (VecRemOp IntVec 16 W32) = 867 +primOpTag (VecRemOp IntVec 8 W64) = 868 +primOpTag (VecRemOp WordVec 16 W8) = 869 +primOpTag (VecRemOp WordVec 8 W16) = 870 +primOpTag (VecRemOp WordVec 4 W32) = 871 +primOpTag (VecRemOp WordVec 2 W64) = 872 +primOpTag (VecRemOp WordVec 32 W8) = 873 +primOpTag (VecRemOp WordVec 16 W16) = 874 +primOpTag (VecRemOp WordVec 8 W32) = 875 +primOpTag (VecRemOp WordVec 4 W64) = 876 +primOpTag (VecRemOp WordVec 64 W8) = 877 +primOpTag (VecRemOp WordVec 32 W16) = 878 +primOpTag (VecRemOp WordVec 16 W32) = 879 +primOpTag (VecRemOp WordVec 8 W64) = 880 +primOpTag (VecNegOp IntVec 16 W8) = 881 +primOpTag (VecNegOp IntVec 8 W16) = 882 +primOpTag (VecNegOp IntVec 4 W32) = 883 +primOpTag (VecNegOp IntVec 2 W64) = 884 +primOpTag (VecNegOp IntVec 32 W8) = 885 +primOpTag (VecNegOp IntVec 16 W16) = 886 +primOpTag (VecNegOp IntVec 8 W32) = 887 +primOpTag (VecNegOp IntVec 4 W64) = 888 +primOpTag (VecNegOp IntVec 64 W8) = 889 +primOpTag (VecNegOp IntVec 32 W16) = 890 +primOpTag (VecNegOp IntVec 16 W32) = 891 +primOpTag (VecNegOp IntVec 8 W64) = 892 +primOpTag (VecNegOp FloatVec 4 W32) = 893 +primOpTag (VecNegOp FloatVec 2 W64) = 894 +primOpTag (VecNegOp FloatVec 8 W32) = 895 +primOpTag (VecNegOp FloatVec 4 W64) = 896 +primOpTag (VecNegOp FloatVec 16 W32) = 897 +primOpTag (VecNegOp FloatVec 8 W64) = 898 +primOpTag (VecIndexByteArrayOp IntVec 16 W8) = 899 +primOpTag (VecIndexByteArrayOp IntVec 8 W16) = 900 +primOpTag (VecIndexByteArrayOp IntVec 4 W32) = 901 +primOpTag (VecIndexByteArrayOp IntVec 2 W64) = 902 +primOpTag (VecIndexByteArrayOp IntVec 32 W8) = 903 +primOpTag (VecIndexByteArrayOp IntVec 16 W16) = 904 +primOpTag (VecIndexByteArrayOp IntVec 8 W32) = 905 +primOpTag (VecIndexByteArrayOp IntVec 4 W64) = 906 +primOpTag (VecIndexByteArrayOp IntVec 64 W8) = 907 +primOpTag (VecIndexByteArrayOp IntVec 32 W16) = 908 +primOpTag (VecIndexByteArrayOp IntVec 16 W32) = 909 +primOpTag (VecIndexByteArrayOp IntVec 8 W64) = 910 +primOpTag (VecIndexByteArrayOp WordVec 16 W8) = 911 +primOpTag (VecIndexByteArrayOp WordVec 8 W16) = 912 +primOpTag (VecIndexByteArrayOp WordVec 4 W32) = 913 +primOpTag (VecIndexByteArrayOp WordVec 2 W64) = 914 +primOpTag (VecIndexByteArrayOp WordVec 32 W8) = 915 +primOpTag (VecIndexByteArrayOp WordVec 16 W16) = 916 +primOpTag (VecIndexByteArrayOp WordVec 8 W32) = 917 +primOpTag (VecIndexByteArrayOp WordVec 4 W64) = 918 +primOpTag (VecIndexByteArrayOp WordVec 64 W8) = 919 +primOpTag (VecIndexByteArrayOp WordVec 32 W16) = 920 +primOpTag (VecIndexByteArrayOp WordVec 16 W32) = 921 +primOpTag (VecIndexByteArrayOp WordVec 8 W64) = 922 +primOpTag (VecIndexByteArrayOp FloatVec 4 W32) = 923 +primOpTag (VecIndexByteArrayOp FloatVec 2 W64) = 924 +primOpTag (VecIndexByteArrayOp FloatVec 8 W32) = 925 +primOpTag (VecIndexByteArrayOp FloatVec 4 W64) = 926 +primOpTag (VecIndexByteArrayOp FloatVec 16 W32) = 927 +primOpTag (VecIndexByteArrayOp FloatVec 8 W64) = 928 +primOpTag (VecReadByteArrayOp IntVec 16 W8) = 929 +primOpTag (VecReadByteArrayOp IntVec 8 W16) = 930 +primOpTag (VecReadByteArrayOp IntVec 4 W32) = 931 +primOpTag (VecReadByteArrayOp IntVec 2 W64) = 932 +primOpTag (VecReadByteArrayOp IntVec 32 W8) = 933 +primOpTag (VecReadByteArrayOp IntVec 16 W16) = 934 +primOpTag (VecReadByteArrayOp IntVec 8 W32) = 935 +primOpTag (VecReadByteArrayOp IntVec 4 W64) = 936 +primOpTag (VecReadByteArrayOp IntVec 64 W8) = 937 +primOpTag (VecReadByteArrayOp IntVec 32 W16) = 938 +primOpTag (VecReadByteArrayOp IntVec 16 W32) = 939 +primOpTag (VecReadByteArrayOp IntVec 8 W64) = 940 +primOpTag (VecReadByteArrayOp WordVec 16 W8) = 941 +primOpTag (VecReadByteArrayOp WordVec 8 W16) = 942 +primOpTag (VecReadByteArrayOp WordVec 4 W32) = 943 +primOpTag (VecReadByteArrayOp WordVec 2 W64) = 944 +primOpTag (VecReadByteArrayOp WordVec 32 W8) = 945 +primOpTag (VecReadByteArrayOp WordVec 16 W16) = 946 +primOpTag (VecReadByteArrayOp WordVec 8 W32) = 947 +primOpTag (VecReadByteArrayOp WordVec 4 W64) = 948 +primOpTag (VecReadByteArrayOp WordVec 64 W8) = 949 +primOpTag (VecReadByteArrayOp WordVec 32 W16) = 950 +primOpTag (VecReadByteArrayOp WordVec 16 W32) = 951 +primOpTag (VecReadByteArrayOp WordVec 8 W64) = 952 +primOpTag (VecReadByteArrayOp FloatVec 4 W32) = 953 +primOpTag (VecReadByteArrayOp FloatVec 2 W64) = 954 +primOpTag (VecReadByteArrayOp FloatVec 8 W32) = 955 +primOpTag (VecReadByteArrayOp FloatVec 4 W64) = 956 +primOpTag (VecReadByteArrayOp FloatVec 16 W32) = 957 +primOpTag (VecReadByteArrayOp FloatVec 8 W64) = 958 +primOpTag (VecWriteByteArrayOp IntVec 16 W8) = 959 +primOpTag (VecWriteByteArrayOp IntVec 8 W16) = 960 +primOpTag (VecWriteByteArrayOp IntVec 4 W32) = 961 +primOpTag (VecWriteByteArrayOp IntVec 2 W64) = 962 +primOpTag (VecWriteByteArrayOp IntVec 32 W8) = 963 +primOpTag (VecWriteByteArrayOp IntVec 16 W16) = 964 +primOpTag (VecWriteByteArrayOp IntVec 8 W32) = 965 +primOpTag (VecWriteByteArrayOp IntVec 4 W64) = 966 +primOpTag (VecWriteByteArrayOp IntVec 64 W8) = 967 +primOpTag (VecWriteByteArrayOp IntVec 32 W16) = 968 +primOpTag (VecWriteByteArrayOp IntVec 16 W32) = 969 +primOpTag (VecWriteByteArrayOp IntVec 8 W64) = 970 +primOpTag (VecWriteByteArrayOp WordVec 16 W8) = 971 +primOpTag (VecWriteByteArrayOp WordVec 8 W16) = 972 +primOpTag (VecWriteByteArrayOp WordVec 4 W32) = 973 +primOpTag (VecWriteByteArrayOp WordVec 2 W64) = 974 +primOpTag (VecWriteByteArrayOp WordVec 32 W8) = 975 +primOpTag (VecWriteByteArrayOp WordVec 16 W16) = 976 +primOpTag (VecWriteByteArrayOp WordVec 8 W32) = 977 +primOpTag (VecWriteByteArrayOp WordVec 4 W64) = 978 +primOpTag (VecWriteByteArrayOp WordVec 64 W8) = 979 +primOpTag (VecWriteByteArrayOp WordVec 32 W16) = 980 +primOpTag (VecWriteByteArrayOp WordVec 16 W32) = 981 +primOpTag (VecWriteByteArrayOp WordVec 8 W64) = 982 +primOpTag (VecWriteByteArrayOp FloatVec 4 W32) = 983 +primOpTag (VecWriteByteArrayOp FloatVec 2 W64) = 984 +primOpTag (VecWriteByteArrayOp FloatVec 8 W32) = 985 +primOpTag (VecWriteByteArrayOp FloatVec 4 W64) = 986 +primOpTag (VecWriteByteArrayOp FloatVec 16 W32) = 987 +primOpTag (VecWriteByteArrayOp FloatVec 8 W64) = 988 +primOpTag (VecIndexOffAddrOp IntVec 16 W8) = 989 +primOpTag (VecIndexOffAddrOp IntVec 8 W16) = 990 +primOpTag (VecIndexOffAddrOp IntVec 4 W32) = 991 +primOpTag (VecIndexOffAddrOp IntVec 2 W64) = 992 +primOpTag (VecIndexOffAddrOp IntVec 32 W8) = 993 +primOpTag (VecIndexOffAddrOp IntVec 16 W16) = 994 +primOpTag (VecIndexOffAddrOp IntVec 8 W32) = 995 +primOpTag (VecIndexOffAddrOp IntVec 4 W64) = 996 +primOpTag (VecIndexOffAddrOp IntVec 64 W8) = 997 +primOpTag (VecIndexOffAddrOp IntVec 32 W16) = 998 +primOpTag (VecIndexOffAddrOp IntVec 16 W32) = 999 +primOpTag (VecIndexOffAddrOp IntVec 8 W64) = 1000 +primOpTag (VecIndexOffAddrOp WordVec 16 W8) = 1001 +primOpTag (VecIndexOffAddrOp WordVec 8 W16) = 1002 +primOpTag (VecIndexOffAddrOp WordVec 4 W32) = 1003 +primOpTag (VecIndexOffAddrOp WordVec 2 W64) = 1004 +primOpTag (VecIndexOffAddrOp WordVec 32 W8) = 1005 +primOpTag (VecIndexOffAddrOp WordVec 16 W16) = 1006 +primOpTag (VecIndexOffAddrOp WordVec 8 W32) = 1007 +primOpTag (VecIndexOffAddrOp WordVec 4 W64) = 1008 +primOpTag (VecIndexOffAddrOp WordVec 64 W8) = 1009 +primOpTag (VecIndexOffAddrOp WordVec 32 W16) = 1010 +primOpTag (VecIndexOffAddrOp WordVec 16 W32) = 1011 +primOpTag (VecIndexOffAddrOp WordVec 8 W64) = 1012 +primOpTag (VecIndexOffAddrOp FloatVec 4 W32) = 1013 +primOpTag (VecIndexOffAddrOp FloatVec 2 W64) = 1014 +primOpTag (VecIndexOffAddrOp FloatVec 8 W32) = 1015 +primOpTag (VecIndexOffAddrOp FloatVec 4 W64) = 1016 +primOpTag (VecIndexOffAddrOp FloatVec 16 W32) = 1017 +primOpTag (VecIndexOffAddrOp FloatVec 8 W64) = 1018 +primOpTag (VecReadOffAddrOp IntVec 16 W8) = 1019 +primOpTag (VecReadOffAddrOp IntVec 8 W16) = 1020 +primOpTag (VecReadOffAddrOp IntVec 4 W32) = 1021 +primOpTag (VecReadOffAddrOp IntVec 2 W64) = 1022 +primOpTag (VecReadOffAddrOp IntVec 32 W8) = 1023 +primOpTag (VecReadOffAddrOp IntVec 16 W16) = 1024 +primOpTag (VecReadOffAddrOp IntVec 8 W32) = 1025 +primOpTag (VecReadOffAddrOp IntVec 4 W64) = 1026 +primOpTag (VecReadOffAddrOp IntVec 64 W8) = 1027 +primOpTag (VecReadOffAddrOp IntVec 32 W16) = 1028 +primOpTag (VecReadOffAddrOp IntVec 16 W32) = 1029 +primOpTag (VecReadOffAddrOp IntVec 8 W64) = 1030 +primOpTag (VecReadOffAddrOp WordVec 16 W8) = 1031 +primOpTag (VecReadOffAddrOp WordVec 8 W16) = 1032 +primOpTag (VecReadOffAddrOp WordVec 4 W32) = 1033 +primOpTag (VecReadOffAddrOp WordVec 2 W64) = 1034 +primOpTag (VecReadOffAddrOp WordVec 32 W8) = 1035 +primOpTag (VecReadOffAddrOp WordVec 16 W16) = 1036 +primOpTag (VecReadOffAddrOp WordVec 8 W32) = 1037 +primOpTag (VecReadOffAddrOp WordVec 4 W64) = 1038 +primOpTag (VecReadOffAddrOp WordVec 64 W8) = 1039 +primOpTag (VecReadOffAddrOp WordVec 32 W16) = 1040 +primOpTag (VecReadOffAddrOp WordVec 16 W32) = 1041 +primOpTag (VecReadOffAddrOp WordVec 8 W64) = 1042 +primOpTag (VecReadOffAddrOp FloatVec 4 W32) = 1043 +primOpTag (VecReadOffAddrOp FloatVec 2 W64) = 1044 +primOpTag (VecReadOffAddrOp FloatVec 8 W32) = 1045 +primOpTag (VecReadOffAddrOp FloatVec 4 W64) = 1046 +primOpTag (VecReadOffAddrOp FloatVec 16 W32) = 1047 +primOpTag (VecReadOffAddrOp FloatVec 8 W64) = 1048 +primOpTag (VecWriteOffAddrOp IntVec 16 W8) = 1049 +primOpTag (VecWriteOffAddrOp IntVec 8 W16) = 1050 +primOpTag (VecWriteOffAddrOp IntVec 4 W32) = 1051 +primOpTag (VecWriteOffAddrOp IntVec 2 W64) = 1052 +primOpTag (VecWriteOffAddrOp IntVec 32 W8) = 1053 +primOpTag (VecWriteOffAddrOp IntVec 16 W16) = 1054 +primOpTag (VecWriteOffAddrOp IntVec 8 W32) = 1055 +primOpTag (VecWriteOffAddrOp IntVec 4 W64) = 1056 +primOpTag (VecWriteOffAddrOp IntVec 64 W8) = 1057 +primOpTag (VecWriteOffAddrOp IntVec 32 W16) = 1058 +primOpTag (VecWriteOffAddrOp IntVec 16 W32) = 1059 +primOpTag (VecWriteOffAddrOp IntVec 8 W64) = 1060 +primOpTag (VecWriteOffAddrOp WordVec 16 W8) = 1061 +primOpTag (VecWriteOffAddrOp WordVec 8 W16) = 1062 +primOpTag (VecWriteOffAddrOp WordVec 4 W32) = 1063 +primOpTag (VecWriteOffAddrOp WordVec 2 W64) = 1064 +primOpTag (VecWriteOffAddrOp WordVec 32 W8) = 1065 +primOpTag (VecWriteOffAddrOp WordVec 16 W16) = 1066 +primOpTag (VecWriteOffAddrOp WordVec 8 W32) = 1067 +primOpTag (VecWriteOffAddrOp WordVec 4 W64) = 1068 +primOpTag (VecWriteOffAddrOp WordVec 64 W8) = 1069 +primOpTag (VecWriteOffAddrOp WordVec 32 W16) = 1070 +primOpTag (VecWriteOffAddrOp WordVec 16 W32) = 1071 +primOpTag (VecWriteOffAddrOp WordVec 8 W64) = 1072 +primOpTag (VecWriteOffAddrOp FloatVec 4 W32) = 1073 +primOpTag (VecWriteOffAddrOp FloatVec 2 W64) = 1074 +primOpTag (VecWriteOffAddrOp FloatVec 8 W32) = 1075 +primOpTag (VecWriteOffAddrOp FloatVec 4 W64) = 1076 +primOpTag (VecWriteOffAddrOp FloatVec 16 W32) = 1077 +primOpTag (VecWriteOffAddrOp FloatVec 8 W64) = 1078 +primOpTag (VecIndexScalarByteArrayOp IntVec 16 W8) = 1079 +primOpTag (VecIndexScalarByteArrayOp IntVec 8 W16) = 1080 +primOpTag (VecIndexScalarByteArrayOp IntVec 4 W32) = 1081 +primOpTag (VecIndexScalarByteArrayOp IntVec 2 W64) = 1082 +primOpTag (VecIndexScalarByteArrayOp IntVec 32 W8) = 1083 +primOpTag (VecIndexScalarByteArrayOp IntVec 16 W16) = 1084 +primOpTag (VecIndexScalarByteArrayOp IntVec 8 W32) = 1085 +primOpTag (VecIndexScalarByteArrayOp IntVec 4 W64) = 1086 +primOpTag (VecIndexScalarByteArrayOp IntVec 64 W8) = 1087 +primOpTag (VecIndexScalarByteArrayOp IntVec 32 W16) = 1088 +primOpTag (VecIndexScalarByteArrayOp IntVec 16 W32) = 1089 +primOpTag (VecIndexScalarByteArrayOp IntVec 8 W64) = 1090 +primOpTag (VecIndexScalarByteArrayOp WordVec 16 W8) = 1091 +primOpTag (VecIndexScalarByteArrayOp WordVec 8 W16) = 1092 +primOpTag (VecIndexScalarByteArrayOp WordVec 4 W32) = 1093 +primOpTag (VecIndexScalarByteArrayOp WordVec 2 W64) = 1094 +primOpTag (VecIndexScalarByteArrayOp WordVec 32 W8) = 1095 +primOpTag (VecIndexScalarByteArrayOp WordVec 16 W16) = 1096 +primOpTag (VecIndexScalarByteArrayOp WordVec 8 W32) = 1097 +primOpTag (VecIndexScalarByteArrayOp WordVec 4 W64) = 1098 +primOpTag (VecIndexScalarByteArrayOp WordVec 64 W8) = 1099 +primOpTag (VecIndexScalarByteArrayOp WordVec 32 W16) = 1100 +primOpTag (VecIndexScalarByteArrayOp WordVec 16 W32) = 1101 +primOpTag (VecIndexScalarByteArrayOp WordVec 8 W64) = 1102 +primOpTag (VecIndexScalarByteArrayOp FloatVec 4 W32) = 1103 +primOpTag (VecIndexScalarByteArrayOp FloatVec 2 W64) = 1104 +primOpTag (VecIndexScalarByteArrayOp FloatVec 8 W32) = 1105 +primOpTag (VecIndexScalarByteArrayOp FloatVec 4 W64) = 1106 +primOpTag (VecIndexScalarByteArrayOp FloatVec 16 W32) = 1107 +primOpTag (VecIndexScalarByteArrayOp FloatVec 8 W64) = 1108 +primOpTag (VecReadScalarByteArrayOp IntVec 16 W8) = 1109 +primOpTag (VecReadScalarByteArrayOp IntVec 8 W16) = 1110 +primOpTag (VecReadScalarByteArrayOp IntVec 4 W32) = 1111 +primOpTag (VecReadScalarByteArrayOp IntVec 2 W64) = 1112 +primOpTag (VecReadScalarByteArrayOp IntVec 32 W8) = 1113 +primOpTag (VecReadScalarByteArrayOp IntVec 16 W16) = 1114 +primOpTag (VecReadScalarByteArrayOp IntVec 8 W32) = 1115 +primOpTag (VecReadScalarByteArrayOp IntVec 4 W64) = 1116 +primOpTag (VecReadScalarByteArrayOp IntVec 64 W8) = 1117 +primOpTag (VecReadScalarByteArrayOp IntVec 32 W16) = 1118 +primOpTag (VecReadScalarByteArrayOp IntVec 16 W32) = 1119 +primOpTag (VecReadScalarByteArrayOp IntVec 8 W64) = 1120 +primOpTag (VecReadScalarByteArrayOp WordVec 16 W8) = 1121 +primOpTag (VecReadScalarByteArrayOp WordVec 8 W16) = 1122 +primOpTag (VecReadScalarByteArrayOp WordVec 4 W32) = 1123 +primOpTag (VecReadScalarByteArrayOp WordVec 2 W64) = 1124 +primOpTag (VecReadScalarByteArrayOp WordVec 32 W8) = 1125 +primOpTag (VecReadScalarByteArrayOp WordVec 16 W16) = 1126 +primOpTag (VecReadScalarByteArrayOp WordVec 8 W32) = 1127 +primOpTag (VecReadScalarByteArrayOp WordVec 4 W64) = 1128 +primOpTag (VecReadScalarByteArrayOp WordVec 64 W8) = 1129 +primOpTag (VecReadScalarByteArrayOp WordVec 32 W16) = 1130 +primOpTag (VecReadScalarByteArrayOp WordVec 16 W32) = 1131 +primOpTag (VecReadScalarByteArrayOp WordVec 8 W64) = 1132 +primOpTag (VecReadScalarByteArrayOp FloatVec 4 W32) = 1133 +primOpTag (VecReadScalarByteArrayOp FloatVec 2 W64) = 1134 +primOpTag (VecReadScalarByteArrayOp FloatVec 8 W32) = 1135 +primOpTag (VecReadScalarByteArrayOp FloatVec 4 W64) = 1136 +primOpTag (VecReadScalarByteArrayOp FloatVec 16 W32) = 1137 +primOpTag (VecReadScalarByteArrayOp FloatVec 8 W64) = 1138 +primOpTag (VecWriteScalarByteArrayOp IntVec 16 W8) = 1139 +primOpTag (VecWriteScalarByteArrayOp IntVec 8 W16) = 1140 +primOpTag (VecWriteScalarByteArrayOp IntVec 4 W32) = 1141 +primOpTag (VecWriteScalarByteArrayOp IntVec 2 W64) = 1142 +primOpTag (VecWriteScalarByteArrayOp IntVec 32 W8) = 1143 +primOpTag (VecWriteScalarByteArrayOp IntVec 16 W16) = 1144 +primOpTag (VecWriteScalarByteArrayOp IntVec 8 W32) = 1145 +primOpTag (VecWriteScalarByteArrayOp IntVec 4 W64) = 1146 +primOpTag (VecWriteScalarByteArrayOp IntVec 64 W8) = 1147 +primOpTag (VecWriteScalarByteArrayOp IntVec 32 W16) = 1148 +primOpTag (VecWriteScalarByteArrayOp IntVec 16 W32) = 1149 +primOpTag (VecWriteScalarByteArrayOp IntVec 8 W64) = 1150 +primOpTag (VecWriteScalarByteArrayOp WordVec 16 W8) = 1151 +primOpTag (VecWriteScalarByteArrayOp WordVec 8 W16) = 1152 +primOpTag (VecWriteScalarByteArrayOp WordVec 4 W32) = 1153 +primOpTag (VecWriteScalarByteArrayOp WordVec 2 W64) = 1154 +primOpTag (VecWriteScalarByteArrayOp WordVec 32 W8) = 1155 +primOpTag (VecWriteScalarByteArrayOp WordVec 16 W16) = 1156 +primOpTag (VecWriteScalarByteArrayOp WordVec 8 W32) = 1157 +primOpTag (VecWriteScalarByteArrayOp WordVec 4 W64) = 1158 +primOpTag (VecWriteScalarByteArrayOp WordVec 64 W8) = 1159 +primOpTag (VecWriteScalarByteArrayOp WordVec 32 W16) = 1160 +primOpTag (VecWriteScalarByteArrayOp WordVec 16 W32) = 1161 +primOpTag (VecWriteScalarByteArrayOp WordVec 8 W64) = 1162 +primOpTag (VecWriteScalarByteArrayOp FloatVec 4 W32) = 1163 +primOpTag (VecWriteScalarByteArrayOp FloatVec 2 W64) = 1164 +primOpTag (VecWriteScalarByteArrayOp FloatVec 8 W32) = 1165 +primOpTag (VecWriteScalarByteArrayOp FloatVec 4 W64) = 1166 +primOpTag (VecWriteScalarByteArrayOp FloatVec 16 W32) = 1167 +primOpTag (VecWriteScalarByteArrayOp FloatVec 8 W64) = 1168 +primOpTag (VecIndexScalarOffAddrOp IntVec 16 W8) = 1169 +primOpTag (VecIndexScalarOffAddrOp IntVec 8 W16) = 1170 +primOpTag (VecIndexScalarOffAddrOp IntVec 4 W32) = 1171 +primOpTag (VecIndexScalarOffAddrOp IntVec 2 W64) = 1172 +primOpTag (VecIndexScalarOffAddrOp IntVec 32 W8) = 1173 +primOpTag (VecIndexScalarOffAddrOp IntVec 16 W16) = 1174 +primOpTag (VecIndexScalarOffAddrOp IntVec 8 W32) = 1175 +primOpTag (VecIndexScalarOffAddrOp IntVec 4 W64) = 1176 +primOpTag (VecIndexScalarOffAddrOp IntVec 64 W8) = 1177 +primOpTag (VecIndexScalarOffAddrOp IntVec 32 W16) = 1178 +primOpTag (VecIndexScalarOffAddrOp IntVec 16 W32) = 1179 +primOpTag (VecIndexScalarOffAddrOp IntVec 8 W64) = 1180 +primOpTag (VecIndexScalarOffAddrOp WordVec 16 W8) = 1181 +primOpTag (VecIndexScalarOffAddrOp WordVec 8 W16) = 1182 +primOpTag (VecIndexScalarOffAddrOp WordVec 4 W32) = 1183 +primOpTag (VecIndexScalarOffAddrOp WordVec 2 W64) = 1184 +primOpTag (VecIndexScalarOffAddrOp WordVec 32 W8) = 1185 +primOpTag (VecIndexScalarOffAddrOp WordVec 16 W16) = 1186 +primOpTag (VecIndexScalarOffAddrOp WordVec 8 W32) = 1187 +primOpTag (VecIndexScalarOffAddrOp WordVec 4 W64) = 1188 +primOpTag (VecIndexScalarOffAddrOp WordVec 64 W8) = 1189 +primOpTag (VecIndexScalarOffAddrOp WordVec 32 W16) = 1190 +primOpTag (VecIndexScalarOffAddrOp WordVec 16 W32) = 1191 +primOpTag (VecIndexScalarOffAddrOp WordVec 8 W64) = 1192 +primOpTag (VecIndexScalarOffAddrOp FloatVec 4 W32) = 1193 +primOpTag (VecIndexScalarOffAddrOp FloatVec 2 W64) = 1194 +primOpTag (VecIndexScalarOffAddrOp FloatVec 8 W32) = 1195 +primOpTag (VecIndexScalarOffAddrOp FloatVec 4 W64) = 1196 +primOpTag (VecIndexScalarOffAddrOp FloatVec 16 W32) = 1197 +primOpTag (VecIndexScalarOffAddrOp FloatVec 8 W64) = 1198 +primOpTag (VecReadScalarOffAddrOp IntVec 16 W8) = 1199 +primOpTag (VecReadScalarOffAddrOp IntVec 8 W16) = 1200 +primOpTag (VecReadScalarOffAddrOp IntVec 4 W32) = 1201 +primOpTag (VecReadScalarOffAddrOp IntVec 2 W64) = 1202 +primOpTag (VecReadScalarOffAddrOp IntVec 32 W8) = 1203 +primOpTag (VecReadScalarOffAddrOp IntVec 16 W16) = 1204 +primOpTag (VecReadScalarOffAddrOp IntVec 8 W32) = 1205 +primOpTag (VecReadScalarOffAddrOp IntVec 4 W64) = 1206 +primOpTag (VecReadScalarOffAddrOp IntVec 64 W8) = 1207 +primOpTag (VecReadScalarOffAddrOp IntVec 32 W16) = 1208 +primOpTag (VecReadScalarOffAddrOp IntVec 16 W32) = 1209 +primOpTag (VecReadScalarOffAddrOp IntVec 8 W64) = 1210 +primOpTag (VecReadScalarOffAddrOp WordVec 16 W8) = 1211 +primOpTag (VecReadScalarOffAddrOp WordVec 8 W16) = 1212 +primOpTag (VecReadScalarOffAddrOp WordVec 4 W32) = 1213 +primOpTag (VecReadScalarOffAddrOp WordVec 2 W64) = 1214 +primOpTag (VecReadScalarOffAddrOp WordVec 32 W8) = 1215 +primOpTag (VecReadScalarOffAddrOp WordVec 16 W16) = 1216 +primOpTag (VecReadScalarOffAddrOp WordVec 8 W32) = 1217 +primOpTag (VecReadScalarOffAddrOp WordVec 4 W64) = 1218 +primOpTag (VecReadScalarOffAddrOp WordVec 64 W8) = 1219 +primOpTag (VecReadScalarOffAddrOp WordVec 32 W16) = 1220 +primOpTag (VecReadScalarOffAddrOp WordVec 16 W32) = 1221 +primOpTag (VecReadScalarOffAddrOp WordVec 8 W64) = 1222 +primOpTag (VecReadScalarOffAddrOp FloatVec 4 W32) = 1223 +primOpTag (VecReadScalarOffAddrOp FloatVec 2 W64) = 1224 +primOpTag (VecReadScalarOffAddrOp FloatVec 8 W32) = 1225 +primOpTag (VecReadScalarOffAddrOp FloatVec 4 W64) = 1226 +primOpTag (VecReadScalarOffAddrOp FloatVec 16 W32) = 1227 +primOpTag (VecReadScalarOffAddrOp FloatVec 8 W64) = 1228 +primOpTag (VecWriteScalarOffAddrOp IntVec 16 W8) = 1229 +primOpTag (VecWriteScalarOffAddrOp IntVec 8 W16) = 1230 +primOpTag (VecWriteScalarOffAddrOp IntVec 4 W32) = 1231 +primOpTag (VecWriteScalarOffAddrOp IntVec 2 W64) = 1232 +primOpTag (VecWriteScalarOffAddrOp IntVec 32 W8) = 1233 +primOpTag (VecWriteScalarOffAddrOp IntVec 16 W16) = 1234 +primOpTag (VecWriteScalarOffAddrOp IntVec 8 W32) = 1235 +primOpTag (VecWriteScalarOffAddrOp IntVec 4 W64) = 1236 +primOpTag (VecWriteScalarOffAddrOp IntVec 64 W8) = 1237 +primOpTag (VecWriteScalarOffAddrOp IntVec 32 W16) = 1238 +primOpTag (VecWriteScalarOffAddrOp IntVec 16 W32) = 1239 +primOpTag (VecWriteScalarOffAddrOp IntVec 8 W64) = 1240 +primOpTag (VecWriteScalarOffAddrOp WordVec 16 W8) = 1241 +primOpTag (VecWriteScalarOffAddrOp WordVec 8 W16) = 1242 +primOpTag (VecWriteScalarOffAddrOp WordVec 4 W32) = 1243 +primOpTag (VecWriteScalarOffAddrOp WordVec 2 W64) = 1244 +primOpTag (VecWriteScalarOffAddrOp WordVec 32 W8) = 1245 +primOpTag (VecWriteScalarOffAddrOp WordVec 16 W16) = 1246 +primOpTag (VecWriteScalarOffAddrOp WordVec 8 W32) = 1247 +primOpTag (VecWriteScalarOffAddrOp WordVec 4 W64) = 1248 +primOpTag (VecWriteScalarOffAddrOp WordVec 64 W8) = 1249 +primOpTag (VecWriteScalarOffAddrOp WordVec 32 W16) = 1250 +primOpTag (VecWriteScalarOffAddrOp WordVec 16 W32) = 1251 +primOpTag (VecWriteScalarOffAddrOp WordVec 8 W64) = 1252 +primOpTag (VecWriteScalarOffAddrOp FloatVec 4 W32) = 1253 +primOpTag (VecWriteScalarOffAddrOp FloatVec 2 W64) = 1254 +primOpTag (VecWriteScalarOffAddrOp FloatVec 8 W32) = 1255 +primOpTag (VecWriteScalarOffAddrOp FloatVec 4 W64) = 1256 +primOpTag (VecWriteScalarOffAddrOp FloatVec 16 W32) = 1257 +primOpTag (VecWriteScalarOffAddrOp FloatVec 8 W64) = 1258 +primOpTag PrefetchByteArrayOp3 = 1259 +primOpTag PrefetchMutableByteArrayOp3 = 1260 +primOpTag PrefetchAddrOp3 = 1261 +primOpTag PrefetchValueOp3 = 1262 +primOpTag PrefetchByteArrayOp2 = 1263 +primOpTag PrefetchMutableByteArrayOp2 = 1264 +primOpTag PrefetchAddrOp2 = 1265 +primOpTag PrefetchValueOp2 = 1266 +primOpTag PrefetchByteArrayOp1 = 1267 +primOpTag PrefetchMutableByteArrayOp1 = 1268 +primOpTag PrefetchAddrOp1 = 1269 +primOpTag PrefetchValueOp1 = 1270 +primOpTag PrefetchByteArrayOp0 = 1271 +primOpTag PrefetchMutableByteArrayOp0 = 1272 +primOpTag PrefetchAddrOp0 = 1273 +primOpTag PrefetchValueOp0 = 1274 diff --git a/ghc-lib/stage0/lib/ghcautoconf.h b/ghc-lib/stage0/lib/ghcautoconf.h --- a/ghc-lib/stage0/lib/ghcautoconf.h +++ b/ghc-lib/stage0/lib/ghcautoconf.h @@ -482,6 +482,9 @@ macro is obsolete. */ #define TIME_WITH_SYS_TIME 1 +/* Compile-in ASSERTs in all ways. */ +/* #undef USE_ASSERTS_ALL_WAYS */ + /* Enable single heap address space support */ #define USE_LARGE_ADDRESS_SPACE 1 diff --git a/ghc-lib/stage0/libraries/ghc-boot/build/GHC/Version.hs b/ghc-lib/stage0/libraries/ghc-boot/build/GHC/Version.hs --- a/ghc-lib/stage0/libraries/ghc-boot/build/GHC/Version.hs +++ b/ghc-lib/stage0/libraries/ghc-boot/build/GHC/Version.hs @@ -3,19 +3,19 @@ import Prelude -- See Note [Why do we import Prelude here?] cProjectGitCommitId :: String -cProjectGitCommitId = "66bd59319a6506125758a1c876eba874bf4f1c86" +cProjectGitCommitId = "54d6b20192fe6fc244248c7766533a768c591bae" cProjectVersion :: String -cProjectVersion = "9.3.20210701" +cProjectVersion = "9.3.20210729" cProjectVersionInt :: String cProjectVersionInt = "903" cProjectPatchLevel :: String -cProjectPatchLevel = "20210701" +cProjectPatchLevel = "20210729" cProjectPatchLevel1 :: String -cProjectPatchLevel1 = "20210701" +cProjectPatchLevel1 = "20210729" cProjectPatchLevel2 :: String cProjectPatchLevel2 = "" diff --git a/libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs b/libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs --- a/libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs +++ b/libraries/ghc-boot-th/GHC/LanguageExtensions/Type.hs @@ -61,7 +61,7 @@ | NumDecimals | DisambiguateRecordFields | RecordWildCards - | RecordPuns + | NamedFieldPuns | ViewPatterns | GADTs | GADTSyntax diff --git a/libraries/ghci/GHCi/Message.hs b/libraries/ghci/GHCi/Message.hs --- a/libraries/ghci/GHCi/Message.hs +++ b/libraries/ghci/GHCi/Message.hs @@ -462,7 +462,7 @@ #define MIN_VERSION_ghc_heap(major1,major2,minor) (\ (major1) < 9 || \ (major1) == 9 && (major2) < 3 || \ - (major1) == 9 && (major2) == 3 && (minor) <= 20210701) + (major1) == 9 && (major2) == 3 && (minor) <= 20210729) #endif /* MIN_VERSION_ghc_heap */ #if MIN_VERSION_ghc_heap(8,11,0) instance Binary Heap.StgTSOProfInfo diff --git a/libraries/template-haskell/Language/Haskell/TH/Lib.hs b/libraries/template-haskell/Language/Haskell/TH/Lib.hs --- a/libraries/template-haskell/Language/Haskell/TH/Lib.hs +++ b/libraries/template-haskell/Language/Haskell/TH/Lib.hs @@ -103,6 +103,9 @@ -- **** Fixity infixLD, infixRD, infixND, + -- **** Default declaration + defaultD, + -- **** Foreign Function Interface (FFI) cCall, stdCall, cApi, prim, javaScript, unsafe, safe, interruptible, forImpD, diff --git a/libraries/template-haskell/Language/Haskell/TH/Lib/Internal.hs b/libraries/template-haskell/Language/Haskell/TH/Lib/Internal.hs --- a/libraries/template-haskell/Language/Haskell/TH/Lib/Internal.hs +++ b/libraries/template-haskell/Language/Haskell/TH/Lib/Internal.hs @@ -468,6 +468,9 @@ infixND :: Quote m => Int -> Name -> m Dec infixND prec nm = pure (InfixD (Fixity prec InfixN) nm) +defaultD :: Quote m => [m Type] -> m Dec +defaultD tys = DefaultD <$> sequenceA tys + pragInlD :: Quote m => Name -> Inline -> RuleMatch -> Phases -> m Dec pragInlD name inline rm phases = pure $ PragmaD $ InlineP name inline rm phases @@ -1030,6 +1033,7 @@ doc_loc (StandaloneDerivD _ _ _) = Nothing doc_loc (DefaultSigD _ _) = Nothing doc_loc (ImplicitParamBindD _ _) = Nothing + doc_loc (DefaultD _) = Nothing -- | Variant of 'withDecDoc' that applies the same documentation to -- multiple declarations. Useful for documenting quoted declarations. diff --git a/libraries/template-haskell/Language/Haskell/TH/Ppr.hs b/libraries/template-haskell/Language/Haskell/TH/Ppr.hs --- a/libraries/template-haskell/Language/Haskell/TH/Ppr.hs +++ b/libraries/template-haskell/Language/Haskell/TH/Ppr.hs @@ -361,6 +361,8 @@ ppr_dec _ (KiSigD f k) = text "type" <+> pprPrefixOcc f <+> dcolon <+> ppr k ppr_dec _ (ForeignD f) = ppr f ppr_dec _ (InfixD fx n) = pprFixity n fx +ppr_dec _ (DefaultD tys) = + text "default" <+> parens (sep $ punctuate comma $ map ppr tys) ppr_dec _ (PragmaD p) = ppr p ppr_dec isTop (DataFamilyD tc tvs kind) = text "data" <+> maybeFamily <+> ppr tc <+> hsep (map ppr tvs) <+> maybeKind diff --git a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs --- a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs +++ b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs @@ -2289,6 +2289,7 @@ --{ foreign export ... }@ | InfixD Fixity Name -- ^ @{ infix 3 foo }@ + | DefaultD [Type] -- ^ @{ default (Integer, Double) }@ -- | pragmas | PragmaD Pragma -- ^ @{ {\-\# INLINE [1] foo \#-\} }@