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 @@ -532,7 +532,7 @@ pRELUDE :: Module pRELUDE = mkBaseModule_ pRELUDE_NAME -gHC_PRIM, gHC_PRIM_PANIC, gHC_PRIM_EXCEPTION, +gHC_PRIM, gHC_PRIM_PANIC, gHC_TYPES, gHC_GENERICS, gHC_MAGIC, gHC_MAGIC_DICT, gHC_CLASSES, gHC_PRIMOPWRAPPERS, gHC_BASE, gHC_ENUM, gHC_GHCI, gHC_GHCI_HELPERS, gHC_CSTRING, @@ -552,7 +552,6 @@ gHC_PRIM = mkPrimModule (fsLit "GHC.Prim") -- Primitive types and values gHC_PRIM_PANIC = mkPrimModule (fsLit "GHC.Prim.Panic") -gHC_PRIM_EXCEPTION = mkPrimModule (fsLit "GHC.Prim.Exception") gHC_TYPES = mkPrimModule (fsLit "GHC.Types") gHC_MAGIC = mkPrimModule (fsLit "GHC.Magic") gHC_MAGIC_DICT = mkPrimModule (fsLit "GHC.Magic.Dict") @@ -2259,8 +2258,7 @@ unpackCStringUtf8IdKey, unpackCStringAppendUtf8IdKey, unpackCStringFoldrUtf8IdKey, unpackCStringIdKey, unpackCStringAppendIdKey, unpackCStringFoldrIdKey, typeErrorIdKey, divIntIdKey, modIntIdKey, - absentSumFieldErrorIdKey, cstringLengthIdKey, - raiseOverflowIdKey, raiseUnderflowIdKey, raiseDivZeroIdKey + absentSumFieldErrorIdKey, cstringLengthIdKey :: Unique wildCardKey = mkPreludeMiscIdUnique 0 -- See Note [WildCard binders] @@ -2293,9 +2291,6 @@ divIntIdKey = mkPreludeMiscIdUnique 25 modIntIdKey = mkPreludeMiscIdUnique 26 cstringLengthIdKey = mkPreludeMiscIdUnique 27 -raiseOverflowIdKey = mkPreludeMiscIdUnique 28 -raiseUnderflowIdKey = mkPreludeMiscIdUnique 29 -raiseDivZeroIdKey = mkPreludeMiscIdUnique 30 concatIdKey, filterIdKey, zipIdKey, bindIOIdKey, returnIOIdKey, newStablePtrIdKey, diff --git a/compiler/GHC/Cmm.hs b/compiler/GHC/Cmm.hs --- a/compiler/GHC/Cmm.hs +++ b/compiler/GHC/Cmm.hs @@ -301,6 +301,9 @@ -> CmmInfoTable -> CostCentreStack -> [CmmLit] -- Payload + -> [CmmLit] -- Non-pointers that go to the end of the closure + -- This is used by stg_unpack_cstring closures. + -- See Note [unpack_cstring closures] in StgStdThunks.cmm. -> GenCmmStatics 'False -- | Static data, after SRTs are generated @@ -432,8 +435,8 @@ -- pprStatics :: Platform -> GenCmmStatics a -> SDoc -pprStatics platform (CmmStatics lbl itbl ccs payload) = - pdoc platform lbl <> colon <+> pdoc platform itbl <+> ppr ccs <+> pdoc platform payload +pprStatics platform (CmmStatics lbl itbl ccs payload extras) = + pdoc platform lbl <> colon <+> pdoc platform itbl <+> ppr ccs <+> pdoc platform payload <+> ppr extras pprStatics platform (CmmStaticsRaw lbl ds) = vcat ((pdoc platform lbl <> colon) : map (pprStatic platform) ds) pprStatic :: Platform -> CmmStatic -> SDoc diff --git a/compiler/GHC/Cmm/CLabel.hs b/compiler/GHC/Cmm/CLabel.hs --- a/compiler/GHC/Cmm/CLabel.hs +++ b/compiler/GHC/Cmm/CLabel.hs @@ -72,6 +72,8 @@ mkCAFBlackHoleInfoTableLabel, mkRtsPrimOpLabel, mkRtsSlowFastTickyCtrLabel, + mkRtsUnpackCStringLabel, + mkRtsUnpackCStringUtf8Label, mkSelectorInfoLabel, mkSelectorEntryLabel, @@ -108,6 +110,7 @@ isLocalCLabel, mayRedirectTo, isInfoTableLabel, + isCmmInfoTableLabel, isConInfoTableLabel, isIdLabel, isTickyLabel, @@ -301,6 +304,7 @@ | MLK_InitializerArray | MLK_Finalizer String | MLK_FinalizerArray + | MLK_IPEBuffer deriving (Eq, Ord) instance Outputable ModuleLabelKind where @@ -308,6 +312,7 @@ ppr (MLK_Initializer s) = text ("init__" ++ s) ppr MLK_FinalizerArray = text "fini_arr" ppr (MLK_Finalizer s) = text ("fini__" ++ s) + ppr MLK_IPEBuffer = text "ipe_buf" isIdLabel :: CLabel -> Bool isIdLabel IdLabel{} = True @@ -450,7 +455,7 @@ -- The regular Outputable instance only shows the label name, and not its other info. -- pprDebugCLabel :: Platform -> CLabel -> SDoc -pprDebugCLabel platform lbl = pprCLabel platform AsmStyle lbl <> parens extra +pprDebugCLabel platform lbl = pprAsmLabel platform lbl <> parens extra where extra = case lbl of IdLabel _ _ info @@ -559,6 +564,8 @@ | RtsApInfoTable Bool{-updatable-} Int{-arity-} -- ^ AP thunks | RtsApEntry Bool{-updatable-} Int{-arity-} + | RtsUnpackCStringInfoTable + | RtsUnpackCStringUtf8InfoTable | RtsPrimOp PrimOp | RtsApFast NonDetFastString -- ^ _fast versions of generic apply | RtsSlowFastTickyCtr String @@ -731,7 +738,6 @@ assert (arity > 0 && arity <= pc_MAX_SPEC_AP_SIZE (platformConstants platform)) $ RtsLabel (RtsApEntry upd arity) - -- A call to some primitive hand written Cmm code mkPrimCallLabel :: PrimCall -> CLabel mkPrimCallLabel (PrimCall str pkg) @@ -794,8 +800,14 @@ isInfoTableLabel (IdLabel _ _ LocalInfoTable) = True isInfoTableLabel (IdLabel _ _ ConInfoTable {}) = True isInfoTableLabel (IdLabel _ _ BlockInfoTable) = True +isInfoTableLabel (CmmLabel _ _ _ CmmInfo) = True isInfoTableLabel _ = False +-- | Whether label points to an info table defined in Cmm +isCmmInfoTableLabel :: CLabel -> Bool +isCmmInfoTableLabel (CmmLabel _ _ _ CmmInfo) = True +isCmmInfoTableLabel _ = False + -- | Whether label is points to constructor info table isConInfoTableLabel :: CLabel -> Bool isConInfoTableLabel (IdLabel _ _ ConInfoTable {}) = True @@ -832,10 +844,10 @@ -- Constructing Cost Center Labels mkCCLabel :: CostCentre -> CLabel mkCCSLabel :: CostCentreStack -> CLabel -mkIPELabel :: InfoProvEnt -> CLabel +mkIPELabel :: Module -> CLabel mkCCLabel cc = CC_Label cc mkCCSLabel ccs = CCS_Label ccs -mkIPELabel ipe = IPE_Label ipe +mkIPELabel mod = ModuleLabel mod MLK_IPEBuffer mkRtsApFastLabel :: FastString -> CLabel mkRtsApFastLabel str = RtsLabel (RtsApFast (NonDetFastString str)) @@ -843,6 +855,11 @@ mkRtsSlowFastTickyCtrLabel :: String -> CLabel mkRtsSlowFastTickyCtrLabel pat = RtsLabel (RtsSlowFastTickyCtr pat) +-- | A standard string unpacking thunk. See Note [unpack_cstring closures] in +-- StgStdThunks.cmm. +mkRtsUnpackCStringLabel, mkRtsUnpackCStringUtf8Label :: CLabel +mkRtsUnpackCStringLabel = RtsLabel RtsUnpackCStringInfoTable +mkRtsUnpackCStringUtf8Label = RtsLabel RtsUnpackCStringUtf8InfoTable -- Constructing Code Coverage Labels mkHpcTicksLabel :: Module -> CLabel @@ -949,6 +966,9 @@ hasCAF :: CLabel -> Bool hasCAF (IdLabel _ _ (IdTickyInfo TickyRednCounts)) = False -- See Note [ticky for LNE] hasCAF (IdLabel _ MayHaveCafRefs _) = True +hasCAF (RtsLabel RtsUnpackCStringInfoTable) = True +hasCAF (RtsLabel RtsUnpackCStringUtf8InfoTable) = True + -- The info table stg_MK_STRING_info is for thunks hasCAF _ = False -- Note [ticky for LNE] @@ -1013,6 +1033,7 @@ -- Code for finalizers and initializers are emitted in stub objects modLabelNeedsCDecl (MLK_Initializer _) = True modLabelNeedsCDecl (MLK_Finalizer _) = True +modLabelNeedsCDecl MLK_IPEBuffer = True -- The finalizer and initializer arrays are emitted in the code of the module modLabelNeedsCDecl MLK_InitializerArray = False modLabelNeedsCDecl MLK_FinalizerArray = False @@ -1185,6 +1206,9 @@ labelType (RtsLabel (RtsSelectorInfoTable _ _)) = DataLabel labelType (RtsLabel (RtsApInfoTable _ _)) = DataLabel labelType (RtsLabel (RtsApFast _)) = CodeLabel +labelType (RtsLabel RtsUnpackCStringInfoTable) = CodeLabel +labelType (RtsLabel RtsUnpackCStringUtf8InfoTable) + = CodeLabel labelType (RtsLabel _) = DataLabel labelType (LocalBlockLabel _) = CodeLabel labelType (SRTLabel _) = DataLabel @@ -1210,6 +1234,7 @@ MLK_InitializerArray -> DataLabel MLK_Finalizer _ -> CodeLabel MLK_FinalizerArray -> DataLabel + MLK_IPEBuffer -> DataLabel idInfoLabelType :: IdLabelInfo -> CLabelType idInfoLabelType info = @@ -1391,18 +1416,33 @@ -} +-- | Style of label pretty-printing. +-- +-- When we produce C sources or headers, we have to take into account that C +-- compilers transform C labels when they convert them into symbols. For +-- example, they can add prefixes (e.g., "_" on Darwin) or suffixes (size for +-- stdcalls on Windows). So we provide two ways to pretty-print CLabels: C style +-- or Asm style. +-- +data LabelStyle + = CStyle -- ^ C label style (used by C and LLVM backends) + | AsmStyle -- ^ Asm label style (used by NCG backend) + pprAsmLabel :: Platform -> CLabel -> SDoc -pprAsmLabel platform lbl = pprCLabel platform AsmStyle lbl +pprAsmLabel platform lbl = pprCLabelStyle platform AsmStyle lbl +pprCLabel :: Platform -> CLabel -> SDoc +pprCLabel platform lbl = pprCLabelStyle platform CStyle lbl + instance OutputableP Platform CLabel where {-# INLINE pdoc #-} -- see Note [Bangs in CLabel] pdoc !platform lbl = getPprStyle $ \pp_sty -> case pp_sty of - PprDump{} -> pprCLabel platform CStyle lbl - _ -> pprPanic "Labels in code should be printed with pprCLabel" (pprCLabel platform CStyle lbl) + PprDump{} -> pprCLabel platform lbl + _ -> pprPanic "Labels in code should be printed with pprCLabel or pprAsmLabel" (pprCLabel platform lbl) -pprCLabel :: Platform -> LabelStyle -> CLabel -> SDoc -pprCLabel !platform !sty lbl = -- see Note [Bangs in CLabel] +pprCLabelStyle :: Platform -> LabelStyle -> CLabel -> SDoc +pprCLabelStyle !platform !sty lbl = -- see Note [Bangs in CLabel] let !use_leading_underscores = platformLeadingUnderscore platform @@ -1431,11 +1471,11 @@ -> asmTempLabelPrefix platform <> case l of AsmTempLabel u -> pprUniqueAlways u LocalBlockLabel u -> pprUniqueAlways u - _other -> pprCLabel platform sty l + _other -> pprCLabelStyle platform sty l <> ftext suf DynamicLinkerLabel info lbl - -> pprDynamicLinkerAsmLabel platform info (pprCLabel platform AsmStyle lbl) + -> pprDynamicLinkerAsmLabel platform info (pprAsmLabel platform lbl) PicBaseLabel -> text "1b" @@ -1448,7 +1488,7 @@ optional `_` (underscore) because this is how you mark non-temp symbols on some platforms (Darwin) -} - maybe_underscore $ text "dsp_" <> pprCLabel platform sty lbl <> text "_dsp" + maybe_underscore $ text "dsp_" <> pprCLabelStyle platform sty lbl <> text "_dsp" StringLitLabel u -> maybe_underscore $ pprUniqueAlways u <> text "_str" @@ -1514,6 +1554,11 @@ RtsLabel (RtsSlowFastTickyCtr pat) -> maybe_underscore $ text "SLOW_CALL_fast_" <> text pat <> text "_ctr" + RtsLabel RtsUnpackCStringInfoTable + -> maybe_underscore $ text "stg_unpack_cstring_info" + RtsLabel RtsUnpackCStringUtf8InfoTable + -> maybe_underscore $ text "stg_unpack_cstring_utf8_info" + LargeBitmapLabel u -> maybe_underscore $ tempLabelPrefixOrUnderscore <> char 'b' <> pprUniqueAlways u <> pp_cSEP <> text "btm" @@ -1526,7 +1571,7 @@ CC_Label cc -> maybe_underscore $ ppr cc CCS_Label ccs -> maybe_underscore $ ppr ccs - IPE_Label (InfoProvEnt l _ _ m _) -> maybe_underscore $ (pprCLabel platform CStyle l <> text "_" <> ppr m <> text "_ipe") + IPE_Label (InfoProvEnt l _ _ m _) -> maybe_underscore $ (pprCLabel platform l <> text "_" <> ppr m <> text "_ipe") ModuleLabel mod kind -> maybe_underscore $ ppr mod <> text "_" <> ppr kind CmmLabel _ _ fs CmmCode -> maybe_underscore $ ftext fs diff --git a/compiler/GHC/Cmm/CLabel.hs-boot b/compiler/GHC/Cmm/CLabel.hs-boot --- a/compiler/GHC/Cmm/CLabel.hs-boot +++ b/compiler/GHC/Cmm/CLabel.hs-boot @@ -5,5 +5,4 @@ data CLabel -pprCLabel :: Platform -> LabelStyle -> CLabel -> SDoc - +pprCLabel :: Platform -> CLabel -> SDoc diff --git a/compiler/GHC/Cmm/Dataflow/Label.hs b/compiler/GHC/Cmm/Dataflow/Label.hs --- a/compiler/GHC/Cmm/Dataflow/Label.hs +++ b/compiler/GHC/Cmm/Dataflow/Label.hs @@ -140,7 +140,6 @@ lookupTM k m = mapLookup k m alterTM k f m = mapAlter f k m foldTM k m z = mapFoldr k z m - mapTM f m = mapMap f m filterTM f m = mapFilter f m ----------------------------------------------------------------------------- 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 @@ -514,8 +514,11 @@ MO_FS_Conv from _ -> [from] MO_FF_Conv from _ -> [from] - MO_V_Insert l r -> [typeWidth (vec l (cmmBits r)),r,wordWidth platform] - MO_V_Extract l r -> [typeWidth (vec l (cmmBits r)),wordWidth platform] + MO_V_Insert l r -> [typeWidth (vec l (cmmBits r)),r, W32] + MO_V_Extract l r -> [typeWidth (vec l (cmmBits r)), W32] + MO_VF_Insert l r -> [typeWidth (vec l (cmmFloat r)),r,W32] + MO_VF_Extract l r -> [typeWidth (vec l (cmmFloat r)),W32] + -- SIMD vector indices are always 32 bit MO_V_Add _ r -> [r,r] MO_V_Sub _ r -> [r,r] @@ -527,9 +530,6 @@ MO_VU_Quot _ r -> [r,r] MO_VU_Rem _ r -> [r,r] - - MO_VF_Insert l r -> [typeWidth (vec l (cmmFloat r)),r,wordWidth platform] - MO_VF_Extract l r -> [typeWidth (vec l (cmmFloat r)),wordWidth platform] MO_VF_Add _ r -> [r,r] MO_VF_Sub _ r -> [r,r] diff --git a/compiler/GHC/Core.hs b/compiler/GHC/Core.hs --- a/compiler/GHC/Core.hs +++ b/compiler/GHC/Core.hs @@ -42,6 +42,7 @@ -- ** Simple 'Expr' access functions and predicates bindersOf, bindersOfBinds, rhssOfBind, rhssOfAlts, + foldBindersOfBindStrict, foldBindersOfBindsStrict, collectBinders, collectTyBinders, collectTyAndValBinders, collectNBinders, collectNValBinders_maybe, collectArgs, stripNArgs, collectArgsTicks, flattenBinds, @@ -1925,6 +1926,21 @@ -- | 'bindersOf' applied to a list of binding groups bindersOfBinds :: [Bind b] -> [b] bindersOfBinds binds = foldr ((++) . bindersOf) [] binds + +-- We inline this to avoid unknown function calls. +{-# INLINE foldBindersOfBindStrict #-} +foldBindersOfBindStrict :: (a -> b -> a) -> a -> Bind b -> a +foldBindersOfBindStrict f + = \z bind -> case bind of + NonRec b _rhs -> f z b + Rec pairs -> foldl' f z $ map fst pairs + +{-# INLINE foldBindersOfBindsStrict #-} +foldBindersOfBindsStrict :: (a -> b -> a) -> a -> [Bind b] -> a +foldBindersOfBindsStrict f = \z binds -> foldl' fold_bind z binds + where + fold_bind = (foldBindersOfBindStrict f) + rhssOfBind :: Bind b -> [Expr b] rhssOfBind (NonRec _ rhs) = [rhs] 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 @@ -2234,13 +2234,18 @@ liftEnvSubst :: (forall a. Pair a -> a) -> Subst -> LiftCoEnv -> Subst liftEnvSubst selector subst lc_env - = composeTCvSubst (Subst emptyInScopeSet emptyIdSubstEnv tenv cenv) subst + = composeTCvSubst (Subst in_scope emptyIdSubstEnv tenv cenv) subst where pairs = nonDetUFMToList lc_env -- It's OK to use nonDetUFMToList here because we -- immediately forget the ordering by creating -- a VarEnv (tpairs, cpairs) = partitionWith ty_or_co pairs + -- Make sure the in-scope set is wide enough to cover the range of the + -- substitution (#22235). + in_scope = mkInScopeSet $ + tyCoVarsOfTypes (map snd tpairs) `unionVarSet` + tyCoVarsOfCos (map snd cpairs) tenv = mkVarEnv_Directly tpairs cenv = mkVarEnv_Directly cpairs diff --git a/compiler/GHC/Core/InstEnv.hs b/compiler/GHC/Core/InstEnv.hs --- a/compiler/GHC/Core/InstEnv.hs +++ b/compiler/GHC/Core/InstEnv.hs @@ -32,7 +32,7 @@ isOverlappable, isOverlapping, isIncoherent ) where -import GHC.Prelude +import GHC.Prelude hiding ( head, init, last, tail ) import GHC.Tc.Utils.TcType -- InstEnv is really part of the type checker, -- and depends on TcType in many ways @@ -50,6 +50,8 @@ import GHC.Types.Basic import GHC.Types.Id import Data.Data ( Data ) +import Data.List.NonEmpty ( NonEmpty (..), nonEmpty ) +import qualified Data.List.NonEmpty as NE import Data.Maybe ( isJust ) import GHC.Utils.Outputable @@ -280,16 +282,18 @@ -- See Note [When exactly is an instance decl an orphan?] orph | is_local cls_name = NotOrphan (nameOccName cls_name) - | all notOrphan mb_ns = assert (not (null mb_ns)) $ head mb_ns + | all notOrphan mb_ns = NE.head mb_ns | otherwise = IsOrphan notOrphan NotOrphan{} = True notOrphan _ = False - mb_ns :: [IsOrphan] -- One for each fundep; a locally-defined name - -- that is not in the "determined" arguments - mb_ns | null fds = [choose_one arg_names] - | otherwise = map do_one fds + mb_ns :: NonEmpty IsOrphan + -- One for each fundep; a locally-defined name + -- that is not in the "determined" arguments + mb_ns = case nonEmpty fds of + Nothing -> NE.singleton (choose_one arg_names) + Just fds -> fmap do_one fds do_one (_ltvs, rtvs) = choose_one [ns | (tv,ns) <- cls_tvs `zip` arg_names , not (tv `elem` rtvs)] diff --git a/compiler/GHC/Core/Lint.hs b/compiler/GHC/Core/Lint.hs --- a/compiler/GHC/Core/Lint.hs +++ b/compiler/GHC/Core/Lint.hs @@ -3196,8 +3196,8 @@ dumpLoc (BodyOfLetRec []) = (noSrcLoc, text "In body of a letrec with no binders") -dumpLoc (BodyOfLetRec bs@(_:_)) - = ( getSrcLoc (head bs), text "In the body of letrec with binders" <+> pp_binders bs) +dumpLoc (BodyOfLetRec bs@(b:_)) + = ( getSrcLoc b, text "In the body of letrec with binders" <+> pp_binders bs) dumpLoc (AnExpr e) = (noSrcLoc, text "In the expression:" <+> ppr e) 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 @@ -768,10 +768,7 @@ rEC_SEL_ERROR_ID, aBSENT_ERROR_ID, aBSENT_SUM_FIELD_ERROR_ID, - tYPE_ERROR_ID, -- Used with Opt_DeferTypeErrors, see #10284 - rAISE_OVERFLOW_ID, - rAISE_UNDERFLOW_ID, - rAISE_DIVZERO_ID + tYPE_ERROR_ID -- Used with Opt_DeferTypeErrors, see #10284 ] recSelErrorName, runtimeErrorName, absentErrorName :: Name @@ -779,7 +776,6 @@ nonExhaustiveGuardsErrorName, noMethodBindingErrorName :: Name typeErrorName :: Name absentSumFieldErrorName :: Name -raiseOverflowName, raiseUnderflowName, raiseDivZeroName :: Name recSelErrorName = err_nm "recSelError" recSelErrorIdKey rEC_SEL_ERROR_ID runtimeErrorName = err_nm "runtimeError" runtimeErrorIdKey rUNTIME_ERROR_ID @@ -798,7 +794,6 @@ rEC_SEL_ERROR_ID, rUNTIME_ERROR_ID, rEC_CON_ERROR_ID :: Id pAT_ERROR_ID, nO_METHOD_BINDING_ERROR_ID, nON_EXHAUSTIVE_GUARDS_ERROR_ID :: Id tYPE_ERROR_ID, aBSENT_ERROR_ID, aBSENT_SUM_FIELD_ERROR_ID :: Id -rAISE_OVERFLOW_ID, rAISE_UNDERFLOW_ID, rAISE_DIVZERO_ID :: Id rEC_SEL_ERROR_ID = mkRuntimeErrorId recSelErrorName rUNTIME_ERROR_ID = mkRuntimeErrorId runtimeErrorName rEC_CON_ERROR_ID = mkRuntimeErrorId recConErrorName @@ -913,31 +908,7 @@ absentErrorIdKey aBSENT_ERROR_ID -raiseOverflowName - = mkWiredInIdName - gHC_PRIM_EXCEPTION - (fsLit "raiseOverflow") - raiseOverflowIdKey - rAISE_OVERFLOW_ID - -raiseUnderflowName - = mkWiredInIdName - gHC_PRIM_EXCEPTION - (fsLit "raiseUnderflow") - raiseUnderflowIdKey - rAISE_UNDERFLOW_ID - -raiseDivZeroName - = mkWiredInIdName - gHC_PRIM_EXCEPTION - (fsLit "raiseDivZero") - raiseDivZeroIdKey - rAISE_DIVZERO_ID - aBSENT_SUM_FIELD_ERROR_ID = mkExceptionId absentSumFieldErrorName -rAISE_OVERFLOW_ID = mkExceptionId raiseOverflowName -rAISE_UNDERFLOW_ID = mkExceptionId raiseUnderflowName -rAISE_DIVZERO_ID = mkExceptionId raiseDivZeroName -- | Exception with type \"forall a. a\" -- @@ -974,7 +945,7 @@ runtimeErrorTy = mkSpecForAllTys [runtimeRep1TyVar, openAlphaTyVar] (mkVisFunTyMany addrPrimTy openAlphaTy) --- | An 'IdInfo' for an Id, such as 'aBSENT_ERROR_ID' or 'raiseOverflow', that +-- | An 'IdInfo' for an Id, such as 'aBSENT_ERROR_ID', that -- throws an (imprecise) exception after being supplied one value arg for every -- argument 'Demand' in the list. The demands end up in the demand signature. -- diff --git a/compiler/GHC/Core/Map/Expr.hs b/compiler/GHC/Core/Map/Expr.hs --- a/compiler/GHC/Core/Map/Expr.hs +++ b/compiler/GHC/Core/Map/Expr.hs @@ -109,13 +109,17 @@ -- is the type you want. newtype CoreMap a = CoreMap (CoreMapG a) +-- TODO(22292): derive +instance Functor CoreMap where + fmap f = \ (CoreMap m) -> CoreMap (fmap f m) + {-# INLINE fmap #-} + instance TrieMap CoreMap where type Key CoreMap = CoreExpr emptyTM = CoreMap emptyTM lookupTM k (CoreMap m) = lookupTM (deBruijnize k) m alterTM k f (CoreMap m) = CoreMap (alterTM (deBruijnize k) f m) foldTM k (CoreMap m) = foldTM k m - mapTM f (CoreMap m) = CoreMap (mapTM f m) filterTM f (CoreMap m) = CoreMap (filterTM f m) -- | @CoreMapG a@ is a map from @DeBruijn CoreExpr@ to @a@. The extended @@ -248,30 +252,27 @@ , cm_letr = emptyTM, cm_case = emptyTM , cm_ecase = emptyTM, cm_tick = emptyTM } +-- TODO(22292): derive +instance Functor CoreMapX where + fmap f CM + { cm_var = cvar, cm_lit = clit, cm_co = cco, cm_type = ctype, cm_cast = ccast + , cm_app = capp, cm_lam = clam, cm_letn = cletn, cm_letr = cletr, cm_case = ccase + , cm_ecase = cecase, cm_tick = ctick } = CM + { cm_var = fmap f cvar, cm_lit = fmap f clit, cm_co = fmap f cco, cm_type = fmap f ctype + , cm_cast = fmap (fmap f) ccast, cm_app = fmap (fmap f) capp, cm_lam = fmap (fmap f) clam + , cm_letn = fmap (fmap (fmap f)) cletn, cm_letr = fmap (fmap (fmap f)) cletr + , cm_case = fmap (fmap f) ccase, cm_ecase = fmap (fmap f) cecase + , cm_tick = fmap (fmap f) ctick } + instance TrieMap CoreMapX where type Key CoreMapX = DeBruijn CoreExpr emptyTM = emptyE lookupTM = lkE alterTM = xtE foldTM = fdE - mapTM = mapE filterTM = ftE -------------------------- -mapE :: (a->b) -> CoreMapX a -> CoreMapX b -mapE f (CM { cm_var = cvar, cm_lit = clit - , cm_co = cco, cm_type = ctype - , cm_cast = ccast , cm_app = capp - , cm_lam = clam, cm_letn = cletn - , cm_letr = cletr, cm_case = ccase - , cm_ecase = cecase, cm_tick = ctick }) - = CM { cm_var = mapTM f cvar, cm_lit = mapTM f clit - , cm_co = mapTM f cco, cm_type = mapTM f ctype - , cm_cast = mapTM (mapTM f) ccast, cm_app = mapTM (mapTM f) capp - , cm_lam = mapTM (mapTM f) clam, cm_letn = mapTM (mapTM (mapTM f)) cletn - , cm_letr = mapTM (mapTM (mapTM f)) cletr, cm_case = mapTM (mapTM f) ccase - , cm_ecase = mapTM (mapTM f) cecase, cm_tick = mapTM (mapTM f) ctick } - ftE :: (a->Bool) -> CoreMapX a -> CoreMapX a ftE f (CM { cm_var = cvar, cm_lit = clit , cm_co = cco, cm_type = ctype @@ -281,10 +282,10 @@ , cm_ecase = cecase, cm_tick = ctick }) = CM { cm_var = filterTM f cvar, cm_lit = filterTM f clit , cm_co = filterTM f cco, cm_type = filterTM f ctype - , cm_cast = mapTM (filterTM f) ccast, cm_app = mapTM (filterTM f) capp - , cm_lam = mapTM (filterTM f) clam, cm_letn = mapTM (mapTM (filterTM f)) cletn - , cm_letr = mapTM (mapTM (filterTM f)) cletr, cm_case = mapTM (filterTM f) ccase - , cm_ecase = mapTM (filterTM f) cecase, cm_tick = mapTM (filterTM f) ctick } + , cm_cast = fmap (filterTM f) ccast, cm_app = fmap (filterTM f) capp + , cm_lam = fmap (filterTM f) clam, cm_letn = fmap (fmap (filterTM f)) cletn + , cm_letr = fmap (fmap (filterTM f)) cletr, cm_case = fmap (filterTM f) ccase + , cm_ecase = fmap (filterTM f) cecase, cm_tick = fmap (filterTM f) ctick } -------------------------- lookupCoreMap :: CoreMap a -> CoreExpr -> Maybe a @@ -394,6 +395,11 @@ , am_data :: DNameEnv (CoreMapG a) , am_lit :: LiteralMap (CoreMapG a) } +-- TODO(22292): derive +instance Functor AltMap where + fmap f AM { am_deflt = adeflt, am_data = adata, am_lit = alit } = AM + { am_deflt = fmap f adeflt, am_data = fmap (fmap f) adata, am_lit = fmap (fmap f) alit } + instance TrieMap AltMap where type Key AltMap = CoreAlt emptyTM = AM { am_deflt = emptyTM @@ -402,7 +408,6 @@ lookupTM = lkA emptyCME alterTM = xtA emptyCME foldTM = fdA - mapTM = mapA filterTM = ftA instance Eq (DeBruijn CoreAlt) where @@ -416,17 +421,11 @@ D (extendCMEs env1 bs1) rhs1 == D (extendCMEs env2 bs2) rhs2 go _ _ = False -mapA :: (a->b) -> AltMap a -> AltMap b -mapA f (AM { am_deflt = adeflt, am_data = adata, am_lit = alit }) - = AM { am_deflt = mapTM f adeflt - , am_data = mapTM (mapTM f) adata - , am_lit = mapTM (mapTM f) alit } - ftA :: (a->Bool) -> AltMap a -> AltMap a ftA f (AM { am_deflt = adeflt, am_data = adata, am_lit = alit }) = AM { am_deflt = filterTM f adeflt - , am_data = mapTM (filterTM f) adata - , am_lit = mapTM (filterTM f) alit } + , am_data = fmap (filterTM f) adata + , am_lit = fmap (filterTM f) alit } lkA :: CmEnv -> CoreAlt -> AltMap a -> Maybe a lkA env (Alt DEFAULT _ rhs) = am_deflt >.> lkG (D env rhs) diff --git a/compiler/GHC/Core/Map/Type.hs b/compiler/GHC/Core/Map/Type.hs --- a/compiler/GHC/Core/Map/Type.hs +++ b/compiler/GHC/Core/Map/Type.hs @@ -83,25 +83,33 @@ -- just look up the coercion's type. newtype CoercionMap a = CoercionMap (CoercionMapG a) +-- TODO(22292): derive +instance Functor CoercionMap where + fmap f = \ (CoercionMap m) -> CoercionMap (fmap f m) + {-# INLINE fmap #-} + instance TrieMap CoercionMap where type Key CoercionMap = Coercion emptyTM = CoercionMap emptyTM lookupTM k (CoercionMap m) = lookupTM (deBruijnize k) m alterTM k f (CoercionMap m) = CoercionMap (alterTM (deBruijnize k) f m) foldTM k (CoercionMap m) = foldTM k m - mapTM f (CoercionMap m) = CoercionMap (mapTM f m) filterTM f (CoercionMap m) = CoercionMap (filterTM f m) type CoercionMapG = GenMap CoercionMapX newtype CoercionMapX a = CoercionMapX (TypeMapX a) +-- TODO(22292): derive +instance Functor CoercionMapX where + fmap f = \ (CoercionMapX core_tm) -> CoercionMapX (fmap f core_tm) + {-# INLINE fmap #-} + instance TrieMap CoercionMapX where type Key CoercionMapX = DeBruijn Coercion emptyTM = CoercionMapX emptyTM lookupTM = lkC alterTM = xtC foldTM f (CoercionMapX core_tm) = foldTM f core_tm - mapTM f (CoercionMapX core_tm) = CoercionMapX (mapTM f core_tm) filterTM f (CoercionMapX core_tm) = CoercionMapX (filterTM f core_tm) instance Eq (DeBruijn Coercion) where @@ -172,13 +180,21 @@ | Just ty' <- tcView ty = Just ty' trieMapView _ = Nothing +-- TODO(22292): derive +instance Functor TypeMapX where + fmap f TM + { tm_var = tvar, tm_app = tapp, tm_tycon = ttycon, tm_funty = tfunty, tm_forall = tforall + , tm_tylit = tlit, tm_coerce = tcoerce } = TM + { tm_var = fmap f tvar, tm_app = fmap (fmap f) tapp, tm_tycon = fmap f ttycon + , tm_funty = fmap (fmap (fmap f)) tfunty, tm_forall = fmap (fmap f) tforall + , tm_tylit = fmap f tlit, tm_coerce = fmap f tcoerce } + instance TrieMap TypeMapX where type Key TypeMapX = DeBruijn Type emptyTM = emptyT lookupTM = lkT alterTM = xtT foldTM = fdT - mapTM = mapT filterTM = filterT instance Eq (DeBruijn Type) where @@ -195,10 +211,10 @@ 'Type'/'Constraint' distinction are low. (Not impossible to do. But doubtful anyone has ever done so in the history of Haskell.) -And it's actually all OK: 'eqExpr' is conservative: if `eqExpr e1 e2` returns +And it's actually all OK: 'eqCoreExpr' is conservative: if `eqCoreExpr e1 e2` returns 'True', thne it must be that `e1` behaves identically to `e2` in all contexts. -But if `eqExpr e1 e2` returns 'False', then we learn nothing. The use of -'tcView' where we expect 'coreView' means 'eqExpr' returns 'False' bit more +But if `eqCoreExpr e1 e2` returns 'False', then we learn nothing. The use of +'tcView' where we expect 'coreView' means 'eqCoreExpr' returns 'False' bit more often that it should. This might, say, stop a `RULE` from firing or CSE from optimizing an expression. Stopping `RULE` firing is good actually: `RULES` are written in Haskell, where `Type /= Constraint`. Stopping CSE is unfortunate, @@ -313,18 +329,6 @@ , tm_tylit = emptyTyLitMap , tm_coerce = Nothing } -mapT :: (a->b) -> TypeMapX a -> TypeMapX b -mapT f (TM { tm_var = tvar, tm_app = tapp, tm_tycon = ttycon - , tm_funty = tfunty, tm_forall = tforall, tm_tylit = tlit - , tm_coerce = tcoerce }) - = TM { tm_var = mapTM f tvar - , tm_app = mapTM (mapTM f) tapp - , tm_tycon = mapTM f ttycon - , tm_funty = mapTM (mapTM (mapTM f)) tfunty - , tm_forall = mapTM (mapTM f) tforall - , tm_tylit = mapTM f tlit - , tm_coerce = fmap f tcoerce } - ----------------- lkT :: DeBruijn Type -> TypeMapX a -> Maybe a lkT (D env ty) m = go ty m @@ -382,10 +386,10 @@ , tm_funty = tfunty, tm_forall = tforall, tm_tylit = tlit , tm_coerce = tcoerce }) = TM { tm_var = filterTM f tvar - , tm_app = mapTM (filterTM f) tapp + , tm_app = fmap (filterTM f) tapp , tm_tycon = filterTM f ttycon - , tm_funty = mapTM (mapTM (filterTM f)) tfunty - , tm_forall = mapTM (filterTM f) tforall + , tm_funty = fmap (fmap (filterTM f)) tfunty + , tm_forall = fmap (filterTM f) tforall , tm_tylit = filterTM f tlit , tm_coerce = filterMaybe f tcoerce } @@ -395,22 +399,22 @@ , tlm_char :: Map.Map Char a } +-- TODO(22292): derive +instance Functor TyLitMap where + fmap f TLM { tlm_number = tn, tlm_string = ts, tlm_char = tc } = TLM + { tlm_number = Map.map f tn, tlm_string = mapUFM f ts, tlm_char = Map.map f tc } + instance TrieMap TyLitMap where type Key TyLitMap = TyLit emptyTM = emptyTyLitMap lookupTM = lkTyLit alterTM = xtTyLit foldTM = foldTyLit - mapTM = mapTyLit filterTM = filterTyLit emptyTyLitMap :: TyLitMap a emptyTyLitMap = TLM { tlm_number = Map.empty, tlm_string = emptyUFM, tlm_char = Map.empty } -mapTyLit :: (a->b) -> TyLitMap a -> TyLitMap b -mapTyLit f (TLM { tlm_number = tn, tlm_string = ts, tlm_char = tc }) - = TLM { tlm_number = Map.map f tn, tlm_string = mapUFM f ts, tlm_char = Map.map f tc } - lkTyLit :: TyLit -> TyLitMap a -> Maybe a lkTyLit l = case l of @@ -439,6 +443,11 @@ -- is the type you want. The keys in this map may have different kinds. newtype TypeMap a = TypeMap (TypeMapG (TypeMapG a)) +-- TODO(22292): derive +instance Functor TypeMap where + fmap f = \ (TypeMap m) -> TypeMap (fmap (fmap f) m) + {-# INLINE fmap #-} + lkTT :: DeBruijn Type -> TypeMap a -> Maybe a lkTT (D env ty) (TypeMap m) = lkG (D env $ typeKind ty) m >>= lkG (D env ty) @@ -456,8 +465,7 @@ lookupTM k m = lkTT (deBruijnize k) m alterTM k f m = xtTT (deBruijnize k) f m foldTM k (TypeMap m) = foldTM (foldTM k) m - mapTM f (TypeMap m) = TypeMap (mapTM (mapTM f) m) - filterTM f (TypeMap m) = TypeMap (mapTM (filterTM f) m) + filterTM f (TypeMap m) = TypeMap (fmap (filterTM f) m) foldTypeMap :: (a -> b -> b) -> b -> TypeMap a -> b foldTypeMap k z m = foldTM k m z @@ -488,16 +496,19 @@ -- | A 'LooseTypeMap' doesn't do a kind-check. Thus, when lookup up (t |> g), -- you'll find entries inserted under (t), even if (g) is non-reflexive. -newtype LooseTypeMap a - = LooseTypeMap (TypeMapG a) +newtype LooseTypeMap a = LooseTypeMap (TypeMapG a) +-- TODO(22292): derive +instance Functor LooseTypeMap where + fmap f = \ (LooseTypeMap m) -> LooseTypeMap (fmap f m) + {-# INLINE fmap #-} + instance TrieMap LooseTypeMap where type Key LooseTypeMap = Type emptyTM = LooseTypeMap emptyTM lookupTM k (LooseTypeMap m) = lookupTM (deBruijnize k) m alterTM k f (LooseTypeMap m) = LooseTypeMap (alterTM (deBruijnize k) f m) foldTM f (LooseTypeMap m) = foldTM f m - mapTM f (LooseTypeMap m) = LooseTypeMap (mapTM f m) filterTM f (LooseTypeMap m) = LooseTypeMap (filterTM f m) {- @@ -566,18 +577,19 @@ -- of pairs are composition. data BndrMap a = BndrMap (TypeMapG (MaybeMap TypeMapG a)) +-- TODO(22292): derive +instance Functor BndrMap where + fmap f = \ (BndrMap tm) -> BndrMap (fmap (fmap f) tm) + {-# INLINE fmap #-} + instance TrieMap BndrMap where type Key BndrMap = Var emptyTM = BndrMap emptyTM lookupTM = lkBndr emptyCME alterTM = xtBndr emptyCME foldTM = fdBndrMap - mapTM = mapBndrMap filterTM = ftBndrMap -mapBndrMap :: (a -> b) -> BndrMap a -> BndrMap b -mapBndrMap f (BndrMap tm) = BndrMap (mapTM (mapTM f) tm) - fdBndrMap :: (a -> b -> b) -> BndrMap a -> b -> b fdBndrMap f (BndrMap tm) = foldTM (foldTM f) tm @@ -596,24 +608,23 @@ BndrMap (tymap |> xtG (D env (varType v)) |>> (alterTM (D env <$> varMultMaybe v) xt)) ftBndrMap :: (a -> Bool) -> BndrMap a -> BndrMap a -ftBndrMap f (BndrMap tm) = BndrMap (mapTM (filterTM f) tm) +ftBndrMap f (BndrMap tm) = BndrMap (fmap (filterTM f) tm) --------- Variable occurrence ------------- data VarMap a = VM { vm_bvar :: BoundVarMap a -- Bound variable , vm_fvar :: DVarEnv a } -- Free variable +-- TODO(22292): derive +instance Functor VarMap where + fmap f VM { vm_bvar = bv, vm_fvar = fv } = VM { vm_bvar = fmap f bv, vm_fvar = fmap f fv } + instance TrieMap VarMap where type Key VarMap = Var emptyTM = VM { vm_bvar = IntMap.empty, vm_fvar = emptyDVarEnv } lookupTM = lkVar emptyCME alterTM = xtVar emptyCME foldTM = fdVar - mapTM = mapVar filterTM = ftVar - -mapVar :: (a->b) -> VarMap a -> VarMap b -mapVar f (VM { vm_bvar = bv, vm_fvar = fv }) - = VM { vm_bvar = mapTM f bv, vm_fvar = mapTM f fv } lkVar :: CmEnv -> Var -> VarMap a -> Maybe a lkVar env v 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 @@ -2244,7 +2244,7 @@ -- We use a host Int to compute the popCount. If we compile on a 32-bit -- host for a 64-bit target, the result may be different than if computed -- by the target. So we disable this rule if sizes don't match. - guard (platformWordSizeInBits platform == finiteBitSize (0 :: Word)) + guard (platformWordSizeInBits platform <= finiteBitSize (0 :: Word)) [a0] <- getArgs x <- isBignumLiteral a0 pure $ Lit (mk_lit platform (fromIntegral (popCount x))) diff --git a/compiler/GHC/Core/Opt/Monad.hs b/compiler/GHC/Core/Opt/Monad.hs --- a/compiler/GHC/Core/Opt/Monad.hs +++ b/compiler/GHC/Core/Opt/Monad.hs @@ -70,6 +70,7 @@ import Data.Bifunctor ( bimap ) import Data.Dynamic +import Data.Maybe (listToMaybe) import Data.Word import Control.Monad import Control.Applicative ( Alternative(..) ) @@ -328,8 +329,8 @@ getFirstAnnotations deserialize guts = bimap mod name <$> getAnnotations deserialize guts where - mod = mapModuleEnv head . filterModuleEnv (const $ not . null) - name = mapNameEnv head . filterNameEnv (not . null) + mod = mapMaybeModuleEnv (const listToMaybe) + name = mapMaybeNameEnv listToMaybe {- Note [Annotations] 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 @@ -19,19 +19,20 @@ module GHC.Core.Opt.OccurAnal ( occurAnalysePgm, occurAnalyseExpr, - zapLambdaBndrs + zapLambdaBndrs, scrutBinderSwap_maybe ) where -import GHC.Prelude +import GHC.Prelude hiding ( head, init, last, tail ) import GHC.Core import GHC.Core.FVs import GHC.Core.Utils ( exprIsTrivial, isDefaultAlt, isExpandableApp, - stripTicksTopE, mkTicks ) + mkCastMCo, mkTicks ) import GHC.Core.Opt.Arity ( joinRhsArity, isOneShotBndr ) import GHC.Core.Coercion +import GHC.Core.Predicate ( isDictId ) import GHC.Core.Type -import GHC.Core.TyCo.FVs( tyCoVarsOfMCo ) +import GHC.Core.TyCo.FVs ( tyCoVarsOfMCo ) import GHC.Data.Maybe( isJust, orElse ) import GHC.Data.Graph.Directed ( SCC(..), Node(..) @@ -59,6 +60,8 @@ import GHC.Unit.Module( Module ) import Data.List (mapAccumL, mapAccumR) +import Data.List.NonEmpty (NonEmpty (..), nonEmpty) +import qualified Data.List.NonEmpty as NE {- ************************************************************************ @@ -2462,8 +2465,8 @@ -- See Note [The binder-swap substitution] -- 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) + -- then please replace x by (y |> mco) + -- Invariant of course: idType x = exprType (y |> mco) , 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 @@ -2669,7 +2672,7 @@ There are two main pieces: * Given case x |> co of b { alts } - we add [x :-> (b, co)] to the occ_bs_env environment; this is + we add [x :-> (b, sym co)] to the occ_bs_env environment; this is done by addBndrSwap. * Then, at an occurrence of a variable, we look up in the occ_bs_env @@ -2737,30 +2740,8 @@ (BS5) We have to apply the occ_bs_env substitution uniformly, including to (local) rules and unfoldings. -Historical note ---------------- -We used to do the binder-swap transformation by introducing -a proxy let-binding, thus; - - case x of b { pi -> ri } - ==> - case x of b { pi -> let x = b in ri } - -But that had two problems: - -1. If 'x' is an imported GlobalId, we'd end up with a GlobalId - on the LHS of a let-binding which isn't allowed. We worked - around this for a while by "localising" x, but it turned - out to be very painful #16296, - -2. In CorePrep we use the occurrence analyser to do dead-code - elimination (see Note [Dead code in CorePrep]). But that - occasionally led to an unlifted let-binding - case x of b { DEFAULT -> let x::Int# = b in ... } - which disobeys one of CorePrep's output invariants (no unlifted - let-bindings) -- see #5433. - -Doing a substitution (via occ_bs_env) is much better. +(BS6) We must be very careful with dictionaries. + See Note [Care with binder-swap on dictionaries] Note [Case of cast] ~~~~~~~~~~~~~~~~~~~ @@ -2770,6 +2751,54 @@ equation (2) in Note [Binder swap]. When we get to the inner case, we inline x, cancel the casts, and away we go. +Note [Care with binder-swap on dictionaries] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +This Note explains why we need isDictId in scrutBinderSwap_maybe. +Consider this tricky example (#21229, #21470): + + class Sing (b :: Bool) where sing :: Bool + instance Sing 'True where sing = True + instance Sing 'False where sing = False + + f :: forall a. Sing a => blah + + h = \ @(a :: Bool) ($dSing :: Sing a) + let the_co = Main.N:Sing[0] :: Sing a ~R# Bool + case ($dSing |> the_co) of wild + True -> f @'True (True |> sym the_co) + False -> f @a dSing + +Now do a binder-swap on the case-expression: + + h = \ @(a :: Bool) ($dSing :: Sing a) + let the_co = Main.N:Sing[0] :: Sing a ~R# Bool + case ($dSing |> the_co) of wild + True -> f @'True (True |> sym the_co) + False -> f @a (wild |> sym the_co) + +And now substitute `False` for `wild` (since wild=False in the False branch): + + h = \ @(a :: Bool) ($dSing :: Sing a) + let the_co = Main.N:Sing[0] :: Sing a ~R# Bool + case ($dSing |> the_co) of wild + True -> f @'True (True |> sym the_co) + False -> f @a (False |> sym the_co) + +And now we have a problem. The specialiser will specialise (f @a d)a (for all +vtypes a and dictionaries d!!) with the dictionary (False |> sym the_co), using +Note [Specialising polymorphic dictionaries] in GHC.Core.Opt.Specialise. + +The real problem is the binder-swap. It swaps a dictionary variable $dSing +(of kind Constraint) for a term variable wild (of kind Type). And that is +dangerous: a dictionary is a /singleton/ type whereas a general term variable is +not. In this particular example, Bool is most certainly not a singleton type! + +Conclusion: + for a /dictionary variable/ do not perform + the clever cast version of the binder-swap + +Hence the subtle isDictId in scrutBinderSwap_maybe. + Note [Zap case binders in proxy bindings] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ From the original @@ -2784,8 +2813,87 @@ NB: the OccInfo on /occurrences/ really doesn't matter much; the simplifier doesn't use it. So this is only to satisfy the perhaps-over-picky Lint. +-} + +addBndrSwap :: OutExpr -> Id -> OccEnv -> OccEnv +-- See Note [The binder-swap substitution] +addBndrSwap scrut case_bndr + env@(OccEnv { occ_bs_env = swap_env, occ_bs_rng = rng_vars }) + | Just (scrut_var, mco) <- scrutBinderSwap_maybe scrut + , scrut_var /= case_bndr + -- Consider: case x of x { ... } + -- Do not add [x :-> x] to occ_bs_env, else lookupBndrSwap will loop + = env { occ_bs_env = extendVarEnv swap_env scrut_var (case_bndr', mco) + , occ_bs_rng = rng_vars `extendVarSet` case_bndr' + `unionVarSet` tyCoVarsOfMCo mco } + + | otherwise + = env + where + case_bndr' = zapIdOccInfo case_bndr + -- See Note [Zap case binders in proxy bindings] + +scrutBinderSwap_maybe :: OutExpr -> Maybe (OutVar, MCoercion) +-- If (scrutBinderSwap_maybe e = Just (v, mco), then +-- v = e |> mco +-- See Note [Case of cast] +-- See Note [Care with binder-swap on dictionaries] +-- +-- We use this same function in SpecConstr, and Simplify.Iteration, +-- when something binder-swap-like is happening +scrutBinderSwap_maybe (Var v) = Just (v, MRefl) +scrutBinderSwap_maybe (Cast (Var v) co) + | not (isDictId v) = Just (v, MCo (mkSymCo co)) + -- Cast: see Note [Case of cast] + -- isDictId: see Note [Care with binder-swap on dictionaries] + -- The isDictId rejects a Constraint/Constraint binder-swap, perhaps + -- over-conservatively. But I have never seen one, so I'm leaving + -- the code as simple as possible. Losing the binder-swap in a + -- rare case probably has very low impact. +scrutBinderSwap_maybe (Tick _ e) = scrutBinderSwap_maybe e -- Drop ticks +scrutBinderSwap_maybe _ = Nothing + +lookupBndrSwap :: OccEnv -> Id -> (CoreExpr, Id) +-- See Note [The binder-swap substitution] +-- Returns an expression of the same type as Id +lookupBndrSwap env@(OccEnv { occ_bs_env = bs_env }) bndr + = case lookupVarEnv bs_env bndr of { + Nothing -> (Var bndr, bndr) ; + Just (bndr1, mco) -> + + -- Why do we iterate here? + -- See (BS2) in Note [The binder-swap substitution] + case lookupBndrSwap env bndr1 of + (fun, fun_id) -> (mkCastMCo fun mco, fun_id) } + + +{- Historical note [Proxy let-bindings] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We used to do the binder-swap transformation by introducing +a proxy let-binding, thus; + + case x of b { pi -> ri } + ==> + case x of b { pi -> let x = b in ri } + +But that had two problems: + +1. If 'x' is an imported GlobalId, we'd end up with a GlobalId + on the LHS of a let-binding which isn't allowed. We worked + around this for a while by "localising" x, but it turned + out to be very painful #16296, + +2. In CorePrep we use the occurrence analyser to do dead-code + elimination (see Note [Dead code in CorePrep]). But that + occasionally led to an unlifted let-binding + case x of b { DEFAULT -> let x::Int# = b in ... } + which disobeys one of CorePrep's output invariants (no unlifted + let-bindings) -- see #5433. + +Doing a substitution (via occ_bs_env) is much better. + Historical Note [no-case-of-case] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We *used* to suppress the binder-swap in case expressions when -fno-case-of-case is on. Old remarks: "This happens in the first simplifier pass, @@ -2844,53 +2952,8 @@ It's fixed by doing the binder-swap in OccAnal because we can do the binder-swap unconditionally and still get occurrence analysis information right. --} -addBndrSwap :: OutExpr -> Id -> OccEnv -> OccEnv --- See Note [The binder-swap substitution] -addBndrSwap scrut case_bndr - env@(OccEnv { occ_bs_env = swap_env, occ_bs_rng = rng_vars }) - | Just (scrut_var, mco) <- get_scrut_var (stripTicksTopE (const True) scrut) - , scrut_var /= case_bndr - -- Consider: case x of x { ... } - -- Do not add [x :-> x] to occ_bs_env, else lookupBndrSwap will loop - = env { occ_bs_env = extendVarEnv swap_env scrut_var (case_bndr', mco) - , occ_bs_rng = rng_vars `extendVarSet` case_bndr' - `unionVarSet` tyCoVarsOfMCo mco } - | otherwise - = env - where - get_scrut_var :: OutExpr -> Maybe (OutVar, MCoercion) - get_scrut_var (Var v) = Just (v, MRefl) - get_scrut_var (Cast (Var v) co) = Just (v, MCo co) -- See Note [Case of cast] - get_scrut_var _ = Nothing - - case_bndr' = zapIdOccInfo case_bndr - -- See Note [Zap case binders in proxy bindings] - -lookupBndrSwap :: OccEnv -> Id -> (CoreExpr, Id) --- See Note [The binder-swap substitution] --- Returns an expression of the same type as Id -lookupBndrSwap env@(OccEnv { occ_bs_env = bs_env }) bndr - = case lookupVarEnv bs_env bndr of { - Nothing -> (Var bndr, bndr) ; - Just (bndr1, mco) -> - - -- Why do we iterate here? - -- See (BS2) in Note [The binder-swap substitution] - case lookupBndrSwap env bndr1 of - (fun, fun_id) -> (add_cast fun mco, fun_id) } - - where - add_cast fun MRefl = fun - add_cast fun (MCo co) = Cast fun (mkSymCo co) - -- We must switch that 'co' to 'sym co'; - -- see the comment with occ_bs_env - -- No need to test for isReflCo, because 'co' came from - -- a (Cast e co) and hence is unlikely to be Refl - -{- ************************************************************************ * * \subsection[OccurAnal-types]{OccEnv} @@ -3129,7 +3192,7 @@ tagNonRecBinder lvl usage binder = let occ = lookupDetails usage binder - will_be_join = decideJoinPointHood lvl usage [binder] + will_be_join = decideJoinPointHood lvl usage (NE.singleton binder) occ' | will_be_join = -- must already be marked AlwaysTailCalled assert (isAlwaysTailCalled occ) occ | otherwise = markNonTail occ @@ -3154,8 +3217,12 @@ -- 1. Determine join-point-hood of whole group, as determined by -- the *unadjusted* usage details unadj_uds = foldr andUDs body_uds rhs_udss - will_be_joins = decideJoinPointHood lvl unadj_uds bndrs + -- This is only used in `mb_join_arity`, to adjust each `Details` in `details_s`, thus, + -- when `bndrs` is non-empty. So, we only write `maybe False` as `decideJoinPointHood` + -- takes a `NonEmpty CoreBndr`; the default value `False` won't affect program behavior. + will_be_joins = maybe False (decideJoinPointHood lvl unadj_uds) (nonEmpty bndrs) + -- 2. Adjust usage details of each RHS, taking into account the -- join-point-hood decision rhs_udss' = [ adjustRhsUsage (mb_join_arity bndr) rhs rhs_uds @@ -3210,12 +3277,12 @@ -- -- See Note [Invariants on join points] in "GHC.Core". decideJoinPointHood :: TopLevelFlag -> UsageDetails - -> [CoreBndr] + -> NonEmpty CoreBndr -> Bool decideJoinPointHood TopLevel _ _ = False decideJoinPointHood NotTopLevel usage bndrs - | isJoinId (head bndrs) + | isJoinId (NE.head bndrs) = warnPprTrace (not all_ok) "OccurAnal failed to rediscover join point(s)" (ppr bndrs) all_ok diff --git a/compiler/GHC/Core/Opt/Simplify/Env.hs b/compiler/GHC/Core/Opt/Simplify/Env.hs --- a/compiler/GHC/Core/Opt/Simplify/Env.hs +++ b/compiler/GHC/Core/Opt/Simplify/Env.hs @@ -71,7 +71,8 @@ import GHC.Builtin.Types import GHC.Core.TyCo.Rep ( TyCoBinder(..) ) import qualified GHC.Core.Type as Type -import GHC.Core.Type hiding ( substTy, substTyVar, substTyVarBndr, extendTvSubst, extendCvSubst ) +import GHC.Core.Type hiding ( substTy, substTyVar, substTyVarBndr, substCo + , extendTvSubst, extendCvSubst ) import qualified GHC.Core.Coercion as Coercion import GHC.Core.Coercion hiding ( substCo, substCoVar, substCoVarBndr ) import GHC.Platform ( Platform ) @@ -248,13 +249,16 @@ , sm_uf_opts :: !UnfoldingOpts -- ^ Unfolding options , sm_case_case :: !Bool -- ^ Whether case-of-case is enabled , sm_pre_inline :: !Bool -- ^ Whether pre-inlining is enabled - , sm_float_enable :: !FloatEnable -- ^ Whether to enable floating out + , sm_keep_exits :: !Bool -- ^ True <=> keep ExitJoinIds + -- See Note [Do not inline exit join points] + -- in GHC.Core.Opt.Exitify + , sm_float_enable :: !FloatEnable -- ^ Whether to enable floating out , sm_do_eta_reduction :: !Bool - , sm_arity_opts :: !ArityOpts - , sm_rule_opts :: !RuleOpts - , sm_case_folding :: !Bool - , sm_case_merge :: !Bool - , sm_co_opt_opts :: !OptCoercionOpts -- ^ Coercion optimiser options + , sm_arity_opts :: !ArityOpts + , sm_rule_opts :: !RuleOpts + , sm_case_folding :: !Bool + , sm_case_merge :: !Bool + , sm_co_opt_opts :: !OptCoercionOpts -- ^ Coercion optimiser options } instance Outputable SimplMode where @@ -811,10 +815,6 @@ = floats { sfJoinFloats = sfJoinFloats floats `addJoinFlts` join_floats , sfInScope = foldlOL extendInScopeSetBind (sfInScope floats) join_floats } - -extendInScopeSetBind :: InScopeSet -> CoreBind -> InScopeSet -extendInScopeSetBind in_scope bind - = extendInScopeSetList in_scope (bindersOf bind) addFloats :: SimplFloats -> SimplFloats -> SimplFloats -- Add both let-floats and join-floats for env2 to env1; diff --git a/compiler/GHC/Core/Opt/Simplify/Iteration.hs b/compiler/GHC/Core/Opt/Simplify/Iteration.hs --- a/compiler/GHC/Core/Opt/Simplify/Iteration.hs +++ b/compiler/GHC/Core/Opt/Simplify/Iteration.hs @@ -22,7 +22,7 @@ import GHC.Core.Type hiding ( substTy, substTyVar, extendTvSubst, extendCvSubst ) import GHC.Core.Opt.Simplify.Env import GHC.Core.Opt.Simplify.Utils -import GHC.Core.Opt.OccurAnal ( occurAnalyseExpr, zapLambdaBndrs ) +import GHC.Core.Opt.OccurAnal ( occurAnalyseExpr, zapLambdaBndrs, scrutBinderSwap_maybe ) import GHC.Core.Make ( FloatBind, mkImpossibleExpr, castBottomExpr ) import qualified GHC.Core.Make import GHC.Core.Coercion hiding ( substCo, substCoVar ) @@ -1919,7 +1919,9 @@ -------------------- -trimJoinCont :: Id -> Maybe JoinArity -> SimplCont -> SimplCont +trimJoinCont :: Id -- Used only in error message + -> Maybe JoinArity + -> SimplCont -> SimplCont -- Drop outer context from join point invocation (jump) -- See Note [Join points and case-of-case] @@ -2017,6 +2019,17 @@ Variables * * ************************************************************************ + +Note [zapSubstEnv] +~~~~~~~~~~~~~~~~~~ +When simplifying something that has already been simplified, be sure to +zap the SubstEnv. This is VITAL. Consider + let x = e in + let y = \z -> ...x... in + \ x -> ...y... + +We'll clone the inner \x, adding x->x' in the id_subst Then when we +inline y, we must *not* replace x by x' in the inlined copy!! -} simplVar :: SimplEnv -> InVar -> SimplM OutExpr @@ -2035,86 +2048,28 @@ simplIdF :: SimplEnv -> InId -> SimplCont -> SimplM (SimplFloats, OutExpr) simplIdF env var cont = case substId env var of - ContEx tvs cvs ids e -> - let env' = setSubstEnv env tvs cvs ids - in simplExprF env' e cont - -- Don't trim; haven't already simplified e, - -- so the cont is not embodied in e + ContEx tvs cvs ids e -> simplExprF env' e cont + -- Don't trimJoinCont; haven't already simplified e, + -- so the cont is not embodied in e + where + env' = setSubstEnv env tvs cvs ids - DoneId var1 -> do - logger <- getLogger - let cont' = trimJoinCont var (isJoinId_maybe var1) cont - completeCall logger env var1 cont' + DoneId var1 -> + do { rule_base <- getSimplRules + ; let cont' = trimJoinCont var1 (isJoinId_maybe var1) cont + info = mkArgInfo env rule_base var1 cont' + ; rebuildCall env info cont' } - DoneEx e mb_join -> - let env' = zapSubstEnv env - cont' = trimJoinCont var mb_join cont - in simplExprF env' e cont' - -- Note [zapSubstEnv] - -- ~~~~~~~~~~~~~~~~~~ - -- The template is already simplified, so don't re-substitute. - -- This is VITAL. Consider - -- let x = e in - -- let y = \z -> ...x... in - -- \ x -> ...y... - -- We'll clone the inner \x, adding x->x' in the id_subst - -- Then when we inline y, we must *not* replace x by x' in - -- the inlined copy!! + DoneEx e mb_join -> simplExprF env' e cont' + where + cont' = trimJoinCont var mb_join cont + env' = zapSubstEnv env -- See Note [zapSubstEnv] --------------------------------------------------------- -- Dealing with a call site -completeCall :: Logger -> SimplEnv -> OutId -> SimplCont -> SimplM (SimplFloats, OutExpr) -completeCall logger env var cont - | Just expr <- callSiteInline logger uf_opts case_depth var active_unf - lone_variable arg_infos interesting_cont - -- Inline the variable's RHS - = do { checkedTick (UnfoldingDone var) - ; dump_inline expr cont - ; let env1 = zapSubstEnv env - ; simplExprF env1 expr cont } - - | otherwise - -- Don't inline; instead rebuild the call - = do { rule_base <- getSimplRules - ; let rules = getRules rule_base var - info = mkArgInfo env var rules - n_val_args call_cont - ; rebuildCall env info cont } - - where - uf_opts = seUnfoldingOpts env - case_depth = seCaseDepth env - (lone_variable, arg_infos, call_cont) = contArgs cont - n_val_args = length arg_infos - interesting_cont = interestingCallContext env call_cont - active_unf = activeUnfolding (seMode env) var - - log_inlining doc - = liftIO $ logDumpFile logger (mkDumpStyle alwaysQualify) - Opt_D_dump_inlinings - "" FormatText doc - - dump_inline unfolding cont - | not (logHasDumpFlag logger Opt_D_dump_inlinings) = return () - | not (logHasDumpFlag logger Opt_D_verbose_core2core) - = when (isExternalName (idName var)) $ - log_inlining $ - sep [text "Inlining done:", nest 4 (ppr var)] - | otherwise - = log_inlining $ - sep [text "Inlining done: " <> ppr var, - nest 4 (vcat [text "Inlined fn: " <+> nest 2 (ppr unfolding), - text "Cont: " <+> ppr cont])] - -rebuildCall :: SimplEnv - -> ArgInfo - -> SimplCont +rebuildCall :: SimplEnv -> ArgInfo -> SimplCont -> SimplM (SimplFloats, OutExpr) --- We decided not to inline, so --- - simplify the arguments --- - try rewrite rules --- - and rebuild ---------- Bottoming applications -------------- rebuildCall env (ArgInfo { ai_fun = fun, ai_args = rev_args, ai_dmds = [] }) cont @@ -2137,27 +2092,48 @@ res = argInfoExpr fun rev_args cont_ty = contResultType cont ----------- Try rewrite RULES -------------- --- See Note [Trying rewrite rules] +---------- Try inlining, if ai_rewrite = TryInlining -------- +-- In the TryInlining case we try inlining immediately, before simplifying +-- any (more) arguments. Why? See Note [Rewrite rules and inlining]. +-- +-- If there are rewrite rules we'll skip this case until we have +-- simplified enough args to satisfy nr_wanted==0 in the TryRules case below +-- Then we'll try the rules, and if that fails, we'll do TryInlining rebuildCall env info@(ArgInfo { ai_fun = fun, ai_args = rev_args - , ai_rules = Just (nr_wanted, rules) }) cont + , ai_rewrite = TryInlining }) cont + = do { logger <- getLogger + ; let full_cont = pushSimplifiedRevArgs env rev_args cont + ; mb_inline <- tryInlining env logger fun full_cont + ; case mb_inline of + Just expr -> do { checkedTick (UnfoldingDone fun) + ; let env1 = zapSubstEnv env + ; simplExprF env1 expr full_cont } + Nothing -> rebuildCall env (info { ai_rewrite = TryNothing }) cont + } + +---------- Try rewrite RULES, if ai_rewrite = TryRules -------------- +-- See Note [Rewrite rules and inlining] +-- See also Note [Trying rewrite rules] +rebuildCall env info@(ArgInfo { ai_fun = fun, ai_args = rev_args + , ai_rewrite = TryRules nr_wanted rules }) cont | nr_wanted == 0 || no_more_args - , let info' = info { ai_rules = Nothing } = -- We've accumulated a simplified call in -- so try rewrite rules; see Note [RULES apply to simplified arguments] -- See also Note [Rules for recursive functions] do { mb_match <- tryRules env rules fun (reverse rev_args) cont ; case mb_match of Just (env', rhs, cont') -> simplExprF env' rhs cont' - Nothing -> rebuildCall env info' cont } + Nothing -> rebuildCall env (info { ai_rewrite = TryInlining }) cont } where + -- If we have run out of arguments, just try the rules; there might + -- be some with lower arity. Casts get in the way -- they aren't + -- allowed on rule LHSs no_more_args = case cont of ApplyToTy {} -> False ApplyToVal {} -> False _ -> True - ----------- Simplify applications and casts -------------- +---------- Simplify type applications and casts -------------- rebuildCall env info (CastIt co cont) = rebuildCall env (addCastTo info co) cont @@ -2202,6 +2178,7 @@ call' = mkApps (Var fun_id) [mkTyArg rr', mkTyArg ty', arg'] ; return (emptyFloats env, call') } +---------- Simplify value arguments -------------------- rebuildCall env fun_info (ApplyToVal { sc_arg = arg, sc_env = arg_se , sc_dup = dup_flag, sc_hole_ty = fun_ty @@ -2237,6 +2214,42 @@ rebuildCall env (ArgInfo { ai_fun = fun, ai_args = rev_args }) cont = rebuild env (argInfoExpr fun rev_args) cont +----------------------------------- +tryInlining :: SimplEnv -> Logger -> OutId -> SimplCont -> SimplM (Maybe OutExpr) +tryInlining env logger var cont + | Just expr <- callSiteInline logger uf_opts case_depth var active_unf + lone_variable arg_infos interesting_cont + = do { dump_inline expr cont + ; return (Just expr) } + + | otherwise + = return Nothing + + where + uf_opts = seUnfoldingOpts env + case_depth = seCaseDepth env + (lone_variable, arg_infos, call_cont) = contArgs cont + interesting_cont = interestingCallContext env call_cont + active_unf = activeUnfolding (seMode env) var + + log_inlining doc + = liftIO $ logDumpFile logger (mkDumpStyle alwaysQualify) + Opt_D_dump_inlinings + "" FormatText doc + + dump_inline unfolding cont + | not (logHasDumpFlag logger Opt_D_dump_inlinings) = return () + | not (logHasDumpFlag logger Opt_D_verbose_core2core) + = when (isExternalName (idName var)) $ + log_inlining $ + sep [text "Inlining done:", nest 4 (ppr var)] + | otherwise + = log_inlining $ + sep [text "Inlining done: " <> ppr var, + nest 4 (vcat [text "Inlined fn: " <+> nest 2 (ppr unfolding), + text "Cont: " <+> ppr cont])] + + {- Note [Trying rewrite rules] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider an application (f e1 e2 e3) where the e1,e2,e3 are not yet @@ -2272,6 +2285,38 @@ op ($p1 ($p2 (df d))) We want all this to unravel in one sweep. +Note [Rewrite rules and inlining] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +In general we try to arrange that inlining is disabled (via a pragma) if +a rewrite rule should apply, so that the rule has a decent chance to fire +before we inline the function. + +But it turns out that (especially when type-class specialisation or +SpecConstr is involved) it is very helpful for the the rewrite rule to +"win" over inlining when both are active at once: see #21851, #22097. + +The simplifier arranges to do this, as follows. In effect, the ai_rewrite +field of the ArgInfo record is the state of a little state-machine: + +* mkArgInfo sets the ai_rewrite field to TryRules if there are any rewrite + rules avaialable for that function. + +* rebuildCall simplifies arguments until enough are simplified to match the + rule with greatest arity. See Note [RULES apply to simplified arguments] + and the first field of `TryRules`. + + But no more! As soon as we have simplified enough arguments to satisfy the + maximum-arity rules, we try the rules; see Note [Trying rewrite rules]. + +* Once we have tried rules (or immediately if there are no rules) set + ai_rewrite to TryInlining, and the Simplifier will try to inline the + function. We want to try this immediately (before simplifying any (more) + arguments). Why? Consider + f BIG where f = \x{OneOcc}. ...x... + If we inline `f` before simplifying `BIG` well use preInlineUnconditionally, + and we'll simplify BIG once, at x's occurrence, rather than twice. + + Note [Avoid redundant simplification] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Because RULES apply to simplified arguments, there's a danger of repeatedly @@ -2327,7 +2372,8 @@ -} tryRules :: SimplEnv -> [CoreRule] - -> Id -> [ArgSpec] + -> Id + -> [ArgSpec] -- In /normal, forward/ order -> SimplCont -> SimplM (Maybe (SimplEnv, CoreExpr, SimplCont)) @@ -3240,19 +3286,21 @@ -- see Note [Case alternative occ info] addAltUnfoldings :: SimplEnv -> Maybe OutExpr -> OutId -> OutExpr -> SimplM SimplEnv -addAltUnfoldings env scrut case_bndr con_app +addAltUnfoldings env mb_scrut case_bndr con_app = do { let con_app_unf = mk_simple_unf con_app env1 = addBinderUnfolding env case_bndr con_app_unf -- See Note [Add unfolding for scrutinee] - env2 | Many <- idMult case_bndr = case scrut of - Just (Var v) -> addBinderUnfolding env1 v con_app_unf - Just (Cast (Var v) co) -> addBinderUnfolding env1 v $ - mk_simple_unf (Cast con_app (mkSymCo co)) - _ -> env1 + env2 | Just scrut <- mb_scrut + , Just (v,mco) <- scrutBinderSwap_maybe scrut + = addBinderUnfolding env1 v $ + if isReflMCo mco -- isReflMCo: avoid calling mk_simple_unf + then con_app_unf -- twice in the common case + else mk_simple_unf (mkCastMCo con_app mco) + | otherwise = env1 - ; traceSmpl "addAltUnf" (vcat [ppr case_bndr <+> ppr scrut, ppr con_app]) + ; traceSmpl "addAltUnf" (vcat [ppr case_bndr <+> ppr mb_scrut, ppr con_app]) ; return env2 } where -- Force the opts, so that the whole SimplEnv isn't retained @@ -3315,9 +3363,6 @@ and did multi-level case analysis, then we'd solve it in one simplifier sweep instead of two. -Exactly the same issue arises in GHC.Core.Opt.SpecConstr; -see Note [Add scrutinee to ValueEnv too] in GHC.Core.Opt.SpecConstr - HOWEVER, given case x of y { Just a -> r1; Nothing -> r2 } we do not want to add the unfolding x -> y to 'x', which might seem cool, @@ -3328,10 +3373,13 @@ So instead we add the unfolding x -> Just a, and x -> Nothing in the respective RHSs. -Since this transformation is tantamount to a binder swap, the same caveat as in -Note [Suppressing binder-swaps on linear case] in OccurAnal apply. +Since this transformation is tantamount to a binder swap, we use +GHC.Core.Opt.OccurAnal.scrutBinderSwap_maybe to do the check. +Exactly the same issue arises in GHC.Core.Opt.SpecConstr; +see Note [Add scrutinee to ValueEnv too] in GHC.Core.Opt.SpecConstr + ************************************************************************ * * \subsection{Known constructor} @@ -3668,7 +3716,7 @@ | otherwise = do { join_bndr <- newJoinId [arg_bndr] res_ty ; let arg_info = ArgInfo { ai_fun = join_bndr - , ai_rules = Nothing, ai_args = [] + , ai_rewrite = TryNothing, ai_args = [] , ai_encl = False, ai_dmds = repeat topDmd , ai_discs = repeat 0 } ; return ( addJoinFloats (emptyFloats env) $ diff --git a/compiler/GHC/Core/Opt/Simplify/Utils.hs b/compiler/GHC/Core/Opt/Simplify/Utils.hs --- a/compiler/GHC/Core/Opt/Simplify/Utils.hs +++ b/compiler/GHC/Core/Opt/Simplify/Utils.hs @@ -30,9 +30,10 @@ interestingCallContext, -- ArgInfo - ArgInfo(..), ArgSpec(..), mkArgInfo, + ArgInfo(..), ArgSpec(..), RewriteCall(..), mkArgInfo, addValArgTo, addCastTo, addTyArgTo, - argInfoExpr, argInfoAppArgs, pushSimplifiedArgs, + argInfoExpr, argInfoAppArgs, + pushSimplifiedArgs, pushSimplifiedRevArgs, isStrictArgInfo, lazyArgContext, abstractFloats, @@ -41,7 +42,7 @@ isExitJoinId ) where -import GHC.Prelude +import GHC.Prelude hiding (head, init, last, tail) import GHC.Core import GHC.Types.Literal ( isLitRubbish ) @@ -52,6 +53,7 @@ import GHC.Core.TyCo.Ppr ( pprParendType ) import GHC.Core.FVs import GHC.Core.Utils +import GHC.Core.Rules( getRules ) import GHC.Core.Opt.Arity import GHC.Core.Unfold import GHC.Core.Unfold.Make @@ -82,6 +84,7 @@ import Control.Monad ( when ) import Data.List ( sortBy ) +import qualified Data.List as Partial ( head ) {- ********************************************************************* * * @@ -210,6 +213,7 @@ type StaticEnv = SimplEnv -- Just the static part is relevant +-- See Note [DupFlag invariants] data DupFlag = NoDup -- Unsimplified, might be big | Simplified -- Simplified | OkToDup -- Simplified and small @@ -226,8 +230,9 @@ {- Note [StaticEnv invariant] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ We pair up an InExpr or InAlts with a StaticEnv, which establishes the -lexical scope for that InExpr. When we simplify that InExpr/InAlts, we -use +lexical scope for that InExpr. + +When we simplify that InExpr/InAlts, we use - Its captured StaticEnv - Overriding its InScopeSet with the larger one at the simplification point. @@ -244,13 +249,14 @@ Note [DupFlag invariants] ~~~~~~~~~~~~~~~~~~~~~~~~~ -In both (ApplyToVal dup _ env k) - and (Select dup _ _ env k) +In both ApplyToVal { se_dup = dup, se_env = env, se_cont = k} + and Select { se_dup = dup, se_env = env, se_cont = k} the following invariants hold (a) if dup = OkToDup, then continuation k is also ok-to-dup - (b) if dup = OkToDup or Simplified, the subst-env is empty - (and hence no need to re-simplify) + (b) if dup = OkToDup or Simplified, the subst-env is empty, + or at least is always ignored; the payload is + already an OutThing -} instance Outputable DupFlag where @@ -309,7 +315,8 @@ ai_fun :: OutId, -- The function ai_args :: [ArgSpec], -- ...applied to these args (which are in *reverse* order) - ai_rules :: FunRules, -- Rules for this function + ai_rewrite :: RewriteCall, -- What transformation to try next for this call + -- See Note [Rewrite rules and inlining] in GHC.Core.Opt.Simplify.Iteration ai_encl :: Bool, -- Flag saying whether this function -- or an enclosing one has rules (recursively) @@ -325,6 +332,12 @@ -- Always infinite } +data RewriteCall -- What rewriting to try next for this call + -- See Note [Rewrite rules and inlining] in GHC.Core.Opt.Simplify.Iteration + = TryRules FullArgCount [CoreRule] + | TryInlining + | TryNothing + data ArgSpec = ValArg { as_dmd :: Demand -- Demand placed on this argument , as_arg :: OutExpr -- Apply to this (coercion or value); c.f. ApplyToVal @@ -349,20 +362,20 @@ addValArgTo :: ArgInfo -> OutExpr -> OutType -> ArgInfo addValArgTo ai arg hole_ty - | ArgInfo { ai_dmds = dmd:dmds, ai_discs = _:discs, ai_rules = rules } <- ai + | ArgInfo { ai_dmds = dmd:dmds, ai_discs = _:discs, ai_rewrite = rew } <- ai -- Pop the top demand and and discounts off , let arg_spec = ValArg { as_arg = arg, as_hole_ty = hole_ty, as_dmd = dmd } - = ai { ai_args = arg_spec : ai_args ai - , ai_dmds = dmds - , ai_discs = discs - , ai_rules = decRules rules } + = ai { ai_args = arg_spec : ai_args ai + , ai_dmds = dmds + , ai_discs = discs + , ai_rewrite = decArgCount rew } | otherwise = pprPanic "addValArgTo" (ppr ai $$ ppr arg) -- There should always be enough demands and discounts addTyArgTo :: ArgInfo -> OutType -> OutType -> ArgInfo -addTyArgTo ai arg_ty hole_ty = ai { ai_args = arg_spec : ai_args ai - , ai_rules = decRules (ai_rules ai) } +addTyArgTo ai arg_ty hole_ty = ai { ai_args = arg_spec : ai_args ai + , ai_rewrite = decArgCount (ai_rewrite ai) } where arg_spec = TyArg { as_arg_ty = arg_ty, as_hole_ty = hole_ty } @@ -381,20 +394,23 @@ argInfoAppArgs (ValArg { as_arg = arg } : as) = arg : argInfoAppArgs as argInfoAppArgs (TyArg { as_arg_ty = ty } : as) = Type ty : argInfoAppArgs as -pushSimplifiedArgs :: SimplEnv -> [ArgSpec] -> SimplCont -> SimplCont -pushSimplifiedArgs _env [] k = k -pushSimplifiedArgs env (arg : args) k - = case arg of - TyArg { as_arg_ty = arg_ty, as_hole_ty = hole_ty } - -> ApplyToTy { sc_arg_ty = arg_ty, sc_hole_ty = hole_ty, sc_cont = rest } - ValArg { as_arg = arg, as_hole_ty = hole_ty } - -> ApplyToVal { sc_arg = arg, sc_env = env, sc_dup = Simplified - , sc_hole_ty = hole_ty, sc_cont = rest } - CastBy c -> CastIt c rest - where - rest = pushSimplifiedArgs env args k - -- The env has an empty SubstEnv +pushSimplifiedArgs, pushSimplifiedRevArgs + :: SimplEnv + -> [ArgSpec] -- In normal, forward order for pushSimplifiedArgs, + -- in /reverse/ order for pushSimplifiedRevArgs + -> SimplCont -> SimplCont +pushSimplifiedArgs env args cont = foldr (pushSimplifiedArg env) cont args +pushSimplifiedRevArgs env args cont = foldl' (\k a -> pushSimplifiedArg env a k) cont args +pushSimplifiedArg :: SimplEnv -> ArgSpec -> SimplCont -> SimplCont +pushSimplifiedArg _env (TyArg { as_arg_ty = arg_ty, as_hole_ty = hole_ty }) cont + = ApplyToTy { sc_arg_ty = arg_ty, sc_hole_ty = hole_ty, sc_cont = cont } +pushSimplifiedArg env (ValArg { as_arg = arg, as_hole_ty = hole_ty }) cont + = ApplyToVal { sc_arg = arg, sc_env = env, sc_dup = Simplified + -- The SubstEnv will be ignored since sc_dup=Simplified + , sc_hole_ty = hole_ty, sc_cont = cont } +pushSimplifiedArg _ (CastBy c) cont = CastIt c cont + argInfoExpr :: OutId -> [ArgSpec] -> OutExpr -- NB: the [ArgSpec] is reversed so that the first arg -- in the list is the last one in the application @@ -406,18 +422,14 @@ go (TyArg { as_arg_ty = ty } : as) = go as `App` Type ty go (CastBy co : as) = mkCast (go as) co - -type FunRules = Maybe (Int, [CoreRule]) -- Remaining rules for this function - -- Nothing => No rules - -- Just (n, rules) => some rules, requiring at least n more type/value args - -decRules :: FunRules -> FunRules -decRules (Just (n, rules)) = Just (n-1, rules) -decRules Nothing = Nothing +decArgCount :: RewriteCall -> RewriteCall +decArgCount (TryRules n rules) = TryRules (n-1) rules +decArgCount rew = rew -mkFunRules :: [CoreRule] -> FunRules -mkFunRules [] = Nothing -mkFunRules rs = Just (n_required, rs) +mkTryRules :: [CoreRule] -> RewriteCall +-- See Note [Rewrite rules and inlining] in GHC.Core.Opt.Simplify.Iteration +mkTryRules [] = TryInlining +mkTryRules rs = TryRules n_required rs where n_required = maximum (map ruleArity rs) @@ -439,7 +451,7 @@ mkLazyArgStop :: OutType -> ArgInfo -> SimplCont mkLazyArgStop ty fun_info = Stop ty (lazyArgContext fun_info) arg_sd where - arg_sd = subDemandIfEvaluated (head (ai_dmds fun_info)) + arg_sd = subDemandIfEvaluated (Partial.head (ai_dmds fun_info)) ------------------- contIsRhs :: SimplCont -> Maybe RecFlag @@ -516,6 +528,7 @@ contHoleScaling (ApplyToTy { sc_cont = k }) = contHoleScaling k contHoleScaling (ApplyToVal { sc_cont = k }) = contHoleScaling k contHoleScaling (TickIt _ k) = contHoleScaling k + ------------------- countArgs :: SimplCont -> Int -- Count all arguments, including types, coercions, @@ -525,6 +538,14 @@ countArgs (CastIt _ cont) = countArgs cont countArgs _ = 0 +countValArgs :: SimplCont -> Int +-- Count value arguments only +countValArgs (ApplyToTy { sc_cont = cont }) = 1 + countValArgs cont +countValArgs (ApplyToVal { sc_cont = cont }) = 1 + countValArgs cont +countValArgs (CastIt _ cont) = countValArgs cont +countValArgs _ = 0 + +------------------- contArgs :: SimplCont -> (Bool, [ArgSummary], SimplCont) -- Summarises value args, discards type args and coercions -- The returned continuation of the call is only used to @@ -572,36 +593,33 @@ -- then it *should* be "C(1,C(S,C(1,L))", so perhaps correct after all. -- But for now we just panic: ApplyToVal{} -> pprPanic "contEvalContext" (ppr k) - StrictArg{sc_fun=fun_info} -> subDemandIfEvaluated (head (ai_dmds fun_info)) + StrictArg{sc_fun=fun_info} -> subDemandIfEvaluated (Partial.head (ai_dmds fun_info)) StrictBind{sc_bndr=bndr} -> subDemandIfEvaluated (idDemandInfo bndr) Select{} -> topSubDmd -- Perhaps reconstruct the demand on the scrutinee by looking at field -- and case binder dmds, see addCaseBndrDmd. No priority right now. ------------------- -mkArgInfo :: SimplEnv - -> Id - -> [CoreRule] -- Rules for function - -> Int -- Number of value args - -> SimplCont -- Context of the call - -> ArgInfo +mkArgInfo :: SimplEnv -> RuleEnv -> Id -> SimplCont -> ArgInfo -mkArgInfo env fun rules n_val_args call_cont +mkArgInfo env rule_base fun cont | n_val_args < idArity fun -- Note [Unsaturated functions] = ArgInfo { ai_fun = fun, ai_args = [] - , ai_rules = fun_rules + , ai_rewrite = fun_rules , ai_encl = False , ai_dmds = vanilla_dmds , ai_discs = vanilla_discounts } | otherwise = ArgInfo { ai_fun = fun , ai_args = [] - , ai_rules = fun_rules - , ai_encl = interestingArgContext rules call_cont + , ai_rewrite = fun_rules + , ai_encl = notNull rules || contHasRules cont , ai_dmds = add_type_strictness (idType fun) arg_dmds , ai_discs = arg_discounts } where - fun_rules = mkFunRules rules + rules = getRules rule_base fun + fun_rules = mkTryRules rules + n_val_args = countValArgs cont vanilla_discounts, arg_discounts :: [Int] vanilla_discounts = repeat 0 @@ -814,7 +832,7 @@ -- a build it's *great* to inline it here. So we must ensure that -- the context for (f x) is not totally uninteresting. -interestingArgContext :: [CoreRule] -> SimplCont -> Bool +contHasRules :: SimplCont -> Bool -- If the argument has form (f x y), where x,y are boring, -- and f is marked INLINE, then we don't want to inline f. -- But if the context of the argument is @@ -822,33 +840,29 @@ -- where g has rules, then we *do* want to inline f, in case it -- exposes a rule that might fire. Similarly, if the context is -- h (g (f x x)) --- where h has rules, then we do want to inline f; hence the --- call_cont argument to interestingArgContext +-- where h has rules, then we do want to inline f. So contHasRules +-- tries to see if the context of the f-call is a call to a function +-- with rules. -- --- The ai-rules flag makes this happen; if it's +-- The ai_encl flag makes this happen; if it's -- set, the inliner gets just enough keener to inline f -- regardless of how boring f's arguments are, if it's marked INLINE -- -- The alternative would be to *always* inline an INLINE function, -- regardless of how boring its context is; but that seems overkill -- For example, it'd mean that wrapper functions were always inlined --- --- The call_cont passed to interestingArgContext is the context of --- the call itself, e.g. g in the example above -interestingArgContext rules call_cont - = notNull rules || enclosing_fn_has_rules +contHasRules cont + = go cont where - enclosing_fn_has_rules = go call_cont - - go (Select {}) = False - go (ApplyToVal {}) = False -- Shouldn't really happen - go (ApplyToTy {}) = False -- Ditto - go (StrictArg { sc_fun = fun }) = ai_encl fun - go (StrictBind {}) = False -- ?? - go (CastIt _ c) = go c - go (Stop _ RuleArgCtxt _) = True - go (Stop _ _ _) = False - go (TickIt _ c) = go c + go (ApplyToVal { sc_cont = cont }) = go cont + go (ApplyToTy { sc_cont = cont }) = go cont + go (CastIt _ cont) = go cont + go (StrictArg { sc_fun = fun }) = ai_encl fun + go (Stop _ RuleArgCtxt _) = True + go (TickIt _ c) = go c + go (Select {}) = False + go (StrictBind {}) = False -- ?? + go (Stop _ _ _) = False {- Note [Interesting arguments] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1320,11 +1334,11 @@ -- Reason: we don't want to inline single uses, or discard dead bindings, -- for unlifted, side-effect-ful bindings preInlineUnconditionally env top_lvl bndr rhs rhs_env - | not pre_inline_unconditionally = Nothing + | not pre_inline = Nothing | not active = Nothing | isTopLevel top_lvl && isDeadEndId bndr = Nothing -- Note [Top-level bottoming Ids] | isCoVar bndr = Nothing -- Note [Do not inline CoVars unconditionally] - | isExitJoinId bndr = Nothing -- Note [Do not inline exit join points] + | keep_exits, isExitJoinId bndr = Nothing -- Note [Do not inline exit join points] -- in module Exitify | not (one_occ (idOccInfo bndr)) = Nothing | not (isStableUnfolding unf) = Just $! (extend_subst_with rhs) @@ -1334,19 +1348,36 @@ , Just inl <- maybeUnfoldingTemplate unf = Just $! (extend_subst_with inl) | otherwise = Nothing where + mode = seMode env + phase = sm_phase mode + keep_exits = sm_keep_exits mode + pre_inline = sm_pre_inline mode + unf = idUnfolding bndr extend_subst_with inl_rhs = extendIdSubst env bndr $! (mkContEx rhs_env inl_rhs) one_occ IAmDead = True -- Happens in ((\x.1) v) + one_occ OneOcc{ occ_n_br = 1 , occ_in_lam = NotInsideLam } = isNotTopLevel top_lvl || early_phase + one_occ OneOcc{ occ_n_br = 1 , occ_in_lam = IsInsideLam , occ_int_cxt = IsInteresting } = canInlineInLam rhs - one_occ _ = False - pre_inline_unconditionally = sePreInline env - active = isActive (sePhase env) (inlinePragmaActivation inline_prag) + one_occ OneOcc{ occ_n_br = 1 } -- Inline join point that are used once, even inside + | isJoinId bndr = True -- lambdas (which are presumably other join points) + -- E.g. join j x = rhs in + -- joinrec k y = ....j x.... + -- Here j must be an exit for k, and we can safely inline it under the lambda + -- This includes the case where j is nullary: a nullary join point is just the + -- same as an arity-1 one. So we don't look at occ_int_cxt. + -- All of this only applies if keep_exits is False, otherwise the + -- earlier guard on preInlineUnconditionally would have fired + + one_occ _ = False + + active = isActive phase (inlinePragmaActivation inline_prag) -- See Note [pre/postInlineUnconditionally in gentle mode] inline_prag = idInlinePragma bndr @@ -1378,7 +1409,7 @@ -- not ticks. Counting ticks cannot be duplicated, and non-counting -- ticks around a Lam will disappear anyway. - early_phase = sePhase env /= FinalPhase + early_phase = phase /= FinalPhase -- If we don't have this early_phase test, consider -- x = length [1,2,3] -- The full laziness pass carefully floats all the cons cells to @@ -1635,7 +1666,7 @@ rebuildLam _env [] body _cont = return body -rebuildLam env bndrs body cont +rebuildLam env bndrs@(bndr:_) body cont = {-# SCC "rebuildLam" #-} try_eta bndrs body where rec_ids = seRecIds env @@ -1652,7 +1683,7 @@ | -- Try eta reduction seDoEtaReduction env , Just etad_lam <- tryEtaReduce rec_ids bndrs body eval_sd - = do { tick (EtaReduction (head bndrs)) + = do { tick (EtaReduction bndr) ; return etad_lam } | -- Try eta expansion @@ -1660,7 +1691,7 @@ , seEtaExpand env , any isRuntimeVar bndrs -- Only when there is at least one value lambda already , Just body_arity <- exprEtaExpandArity (seArityOpts env) body - = do { tick (EtaExpansion (head bndrs)) + = do { tick (EtaExpansion bndr) ; let body' = etaExpandAT in_scope body_arity body ; traceSmpl "eta expand" (vcat [text "before" <+> ppr body , text "after" <+> ppr body']) @@ -2361,12 +2392,12 @@ -- 2. Eliminate Identity Case -------------------------------------------------- -mkCase1 _mode scrut case_bndr _ alts@(Alt _ _ rhs1 : _) -- Identity case +mkCase1 _mode scrut case_bndr _ alts@(Alt _ _ rhs1 : alts') -- Identity case | all identity_alt alts = do { tick (CaseIdentity case_bndr) ; return (mkTicks ticks $ re_cast scrut rhs1) } where - ticks = concatMap (\(Alt _ _ rhs) -> stripTicksT tickishFloatable rhs) (tail alts) + ticks = concatMap (\(Alt _ _ rhs) -> stripTicksT tickishFloatable rhs) alts' identity_alt (Alt con args rhs) = check_eq rhs con args check_eq (Cast rhs co) con args -- See Note [RHS casts] diff --git a/compiler/GHC/Core/Opt/Stats.hs b/compiler/GHC/Core/Opt/Stats.hs --- a/compiler/GHC/Core/Opt/Stats.hs +++ b/compiler/GHC/Core/Opt/Stats.hs @@ -213,7 +213,7 @@ pprTickGroup :: NonEmpty (Tick, Int) -> SDoc pprTickGroup group@((tick1,_) :| _) - = hang (int (sum (fmap snd group)) <+> text (tickString tick1)) + = hang (int (sum (fmap snd group)) <+> pprTickType tick1) 2 (vcat [ int n <+> pprTickCts tick -- flip as we want largest first | (tick,n) <- sortOn (Down . snd) (NE.toList group)]) @@ -242,7 +242,7 @@ | SimplifierDone -- Ticked at each iteration of the simplifier instance Outputable Tick where - ppr tick = text (tickString tick) <+> pprTickCts tick + ppr tick = pprTickType tick <+> pprTickCts tick instance Eq Tick where a == b = case a `cmpTick` b of @@ -270,23 +270,23 @@ tickToTag SimplifierDone = 16 tickToTag (AltMerge _) = 17 -tickString :: Tick -> String -tickString (PreInlineUnconditionally _) = "PreInlineUnconditionally" -tickString (PostInlineUnconditionally _)= "PostInlineUnconditionally" -tickString (UnfoldingDone _) = "UnfoldingDone" -tickString (RuleFired _) = "RuleFired" -tickString LetFloatFromLet = "LetFloatFromLet" -tickString (EtaExpansion _) = "EtaExpansion" -tickString (EtaReduction _) = "EtaReduction" -tickString (BetaReduction _) = "BetaReduction" -tickString (CaseOfCase _) = "CaseOfCase" -tickString (KnownBranch _) = "KnownBranch" -tickString (CaseMerge _) = "CaseMerge" -tickString (AltMerge _) = "AltMerge" -tickString (CaseElim _) = "CaseElim" -tickString (CaseIdentity _) = "CaseIdentity" -tickString (FillInCaseDefault _) = "FillInCaseDefault" -tickString SimplifierDone = "SimplifierDone" +pprTickType :: Tick -> SDoc +pprTickType (PreInlineUnconditionally _) = text "PreInlineUnconditionally" +pprTickType (PostInlineUnconditionally _)= text "PostInlineUnconditionally" +pprTickType (UnfoldingDone _) = text "UnfoldingDone" +pprTickType (RuleFired _) = text "RuleFired" +pprTickType LetFloatFromLet = text "LetFloatFromLet" +pprTickType (EtaExpansion _) = text "EtaExpansion" +pprTickType (EtaReduction _) = text "EtaReduction" +pprTickType (BetaReduction _) = text "BetaReduction" +pprTickType (CaseOfCase _) = text "CaseOfCase" +pprTickType (KnownBranch _) = text "KnownBranch" +pprTickType (CaseMerge _) = text "CaseMerge" +pprTickType (AltMerge _) = text "AltMerge" +pprTickType (CaseElim _) = text "CaseElim" +pprTickType (CaseIdentity _) = text "CaseIdentity" +pprTickType (FillInCaseDefault _) = text "FillInCaseDefault" +pprTickType SimplifierDone = text "SimplifierDone" pprTickCts :: Tick -> SDoc pprTickCts (PreInlineUnconditionally v) = ppr v diff --git a/compiler/GHC/Core/Subst.hs b/compiler/GHC/Core/Subst.hs --- a/compiler/GHC/Core/Subst.hs +++ b/compiler/GHC/Core/Subst.hs @@ -26,7 +26,8 @@ extendIdSubstWithClone, extendSubst, extendSubstList, extendSubstWithVar, extendSubstInScope, extendSubstInScopeList, extendSubstInScopeSet, - isInScope, setInScope, extendTvSubst, extendCvSubst, + isInScope, setInScope, getSubstInScope, + extendTvSubst, extendCvSubst, delBndr, delBndrs, zapSubst, -- ** Substituting and cloning binders @@ -41,7 +42,6 @@ import GHC.Core.FVs import GHC.Core.Seq import GHC.Core.Utils -import GHC.Core.TyCo.Subst ( substCo ) -- We are defining local versions import GHC.Core.Type hiding ( substTy ) diff --git a/compiler/GHC/Core/TyCo/Subst.hs b/compiler/GHC/Core/TyCo/Subst.hs --- a/compiler/GHC/Core/TyCo/Subst.hs +++ b/compiler/GHC/Core/TyCo/Subst.hs @@ -245,8 +245,13 @@ = Subst is3 ids1 tenv3 cenv3 where is3 = is1 `unionInScope` is2 - tenv3 = tenv1 `plusVarEnv` mapVarEnv (substTy subst1) tenv2 - cenv3 = cenv1 `plusVarEnv` mapVarEnv (substCo subst1) cenv2 + tenv3 = tenv1 `plusVarEnv` mapVarEnv (substTy extended_subst1) tenv2 + cenv3 = cenv1 `plusVarEnv` mapVarEnv (substCo extended_subst1) cenv2 + + -- Make sure the in-scope set in the first substitution is wide enough to + -- cover the free variables in the range of the second substitution before + -- applying it (#22235). + extended_subst1 = subst1 `setInScope` is3 emptySubst :: Subst emptySubst = Subst emptyInScopeSet emptyVarEnv emptyVarEnv emptyVarEnv diff --git a/compiler/GHC/Core/Type.hs b/compiler/GHC/Core/Type.hs --- a/compiler/GHC/Core/Type.hs +++ b/compiler/GHC/Core/Type.hs @@ -219,7 +219,7 @@ substTyAddInScope, substTyUnchecked, substTysUnchecked, substScaledTyUnchecked, substScaledTysUnchecked, substThetaUnchecked, substTyWithUnchecked, - substCoUnchecked, substCoWithUnchecked, + substCo, substCoUnchecked, substCoWithUnchecked, substTyVarBndr, substTyVarBndrs, substTyVar, substTyVars, substVarBndr, substVarBndrs, substTyCoBndr, 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 @@ -227,14 +227,15 @@ This happens with Control.Monad.liftM3, and can cause a lot more allocation as a result (nofib n-body shows this). - Moreover, keeping the stable unfoldign isn't much help, because + Moreover, keeping the stable unfolding isn't much help, because the specialised function (probably) isn't overloaded any more. - TL;DR: we simply drop the stable unfolding when specialising. It's - not really a complete solution; ignoring specialisation for now, - INLINABLE functions don't get properly strictness analysed, for - example. But it works well for examples involving specialisation, - which is the dominant use of INLINABLE. + TL;DR: we simply drop the stable unfolding when specialising. It's not + really a complete solution; ignoring specialisation for now, INLINABLE + functions don't get properly strictness analysed, for example. + Moreover, it means that the specialised function has an INLINEABLE + pragma, but no stable unfolding. But it works well for examples + involving specialisation, which is the dominant use of INLINABLE. Note [Honour INLINE on 0-ary bindings] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ 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 @@ -34,8 +34,7 @@ altsAreExhaustive, etaExpansionTick, -- * Equality - cheapEqExpr, cheapEqExpr', eqExpr, - diffBinds, + cheapEqExpr, cheapEqExpr', diffBinds, -- * Manipulating data constructors and types exprToType, @@ -47,6 +46,9 @@ stripTicksTop, stripTicksTopE, stripTicksTopT, stripTicksE, stripTicksT, + -- * InScopeSet things which work over CoreBinds + mkInScopeSetBndrs, extendInScopeSetBind, extendInScopeSetBndrs, + -- * StaticPtr collectMakeStaticArgs, @@ -76,7 +78,6 @@ import GHC.Core.Reduction import GHC.Core.TyCon import GHC.Core.Multiplicity -import GHC.Core.Map.Expr ( eqCoreExpr ) import GHC.Builtin.Names ( makeStaticName, unsafeEqualityProofIdKey ) import GHC.Builtin.PrimOps @@ -2118,12 +2119,6 @@ -eqExpr :: InScopeSet -> CoreExpr -> CoreExpr -> Bool --- Compares for equality, modulo alpha --- TODO: remove eqExpr once GHC 9.4 is released -eqExpr _ = eqCoreExpr -{-# DEPRECATED eqExpr "Use 'GHC.Core.Map.Expr.eqCoreExpr', 'eqExpr' will be removed in GHC 9.6" #-} - -- Used by diffBinds, which is itself only used in GHC.Core.Lint.lintAnnots eqTickish :: RnEnv2 -> CoreTickish -> CoreTickish -> Bool eqTickish env (Breakpoint lext lid lids) (Breakpoint rext rid rids) @@ -2149,14 +2144,17 @@ diffBinds top env binds1 = go (length binds1) env binds1 where go _ env [] [] = ([], env) - go fuel env binds1 binds2 - -- No binds left to compare? Bail out early. - | null binds1 || null binds2 - = (warn env binds1 binds2, env) + go _fuel env [] binds2 + -- No binds remaining to compare on the left? Bail out early. + = (warn env [] binds2, env) + go _fuel env binds1 [] + -- No binds remaining to compare on the right? Bail out early. + = (warn env binds1 [], env) + go fuel env binds1@(bind1:_) binds2@(_:_) -- Iterated over all binds without finding a match? Then -- try speculatively matching binders by order. | fuel == 0 - = if not $ env `inRnEnvL` fst (head binds1) + = if not $ env `inRnEnvL` fst bind1 then let env' = uncurry (rnBndrs2 env) $ unzip $ zip (sort $ map fst binds1) (sort $ map fst binds2) in go (length binds1) env' binds1 binds2 @@ -2172,7 +2170,6 @@ binds1 (binds2l ++ binds2r) | otherwise -- No match, so push back (FIXME O(n^2)) = go (fuel-1) env (binds1++[(bndr1,expr1)]) binds2 - go _ _ _ _ = panic "diffBinds: impossible" -- GHC isn't smart enough -- We have tried everything, but couldn't find a good match. So -- now we just return the comparison results when we pair up @@ -2335,6 +2332,26 @@ , Just (tc, tc_args) <- splitTyConApp_maybe ty1 = Just (tc, tc_args, co) normSplitTyConApp_maybe _ _ = Nothing + +{- +***************************************************** +* +* InScopeSet things +* +***************************************************** +-} + + +extendInScopeSetBind :: InScopeSet -> CoreBind -> InScopeSet +extendInScopeSetBind (InScope in_scope) binds + = InScope $ foldBindersOfBindStrict extendVarSet in_scope binds + +extendInScopeSetBndrs :: InScopeSet -> [CoreBind] -> InScopeSet +extendInScopeSetBndrs (InScope in_scope) binds + = InScope $ foldBindersOfBindsStrict extendVarSet in_scope binds + +mkInScopeSetBndrs :: [CoreBind] -> InScopeSet +mkInScopeSetBndrs binds = foldBindersOfBindsStrict extendInScopeSet emptyInScopeSet binds {- ***************************************************** diff --git a/compiler/GHC/CoreToIface.hs b/compiler/GHC/CoreToIface.hs --- a/compiler/GHC/CoreToIface.hs +++ b/compiler/GHC/CoreToIface.hs @@ -7,6 +7,7 @@ , toIfaceTvBndrs , toIfaceIdBndr , toIfaceBndr + , toIfaceTopBndr , toIfaceForAllBndr , toIfaceTyCoVarBinders , toIfaceTyVar @@ -35,6 +36,7 @@ , toIfUnfolding , toIfaceTickish , toIfaceBind + , toIfaceTopBind , toIfaceAlt , toIfaceCon , toIfaceApp @@ -438,6 +440,15 @@ -- Put into the interface file any IdInfo that GHC.Core.Tidy.tidyLetBndr -- has left on the Id. See Note [IdInfo on nested let-bindings] in GHC.Iface.Syntax +toIfaceTopBndr :: Id -> IfaceTopBndrInfo +toIfaceTopBndr id + = if isExternalName name + then IfGblTopBndr name + else IfLclTopBndr (occNameFS (getOccName id)) (toIfaceType (idType id)) + (toIfaceIdInfo (idInfo id)) (toIfaceIdDetails (idDetails id)) + where + name = getName id + toIfaceIdDetails :: IdDetails -> IfaceIdDetails toIfaceIdDetails VanillaId = IfVanillaId toIfaceIdDetails (WorkerLikeId dmds) = IfWorkerLikeId dmds @@ -570,10 +581,33 @@ -- should not be serialised (#8333) --------------------- -toIfaceBind :: Bind Id -> IfaceBinding +toIfaceBind :: Bind Id -> IfaceBinding IfaceLetBndr toIfaceBind (NonRec b r) = IfaceNonRec (toIfaceLetBndr b) (toIfaceExpr r) toIfaceBind (Rec prs) = IfaceRec [(toIfaceLetBndr b, toIfaceExpr r) | (b,r) <- prs] +toIfaceTopBind :: Bind Id -> IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo +toIfaceTopBind b = + case b of + NonRec b r -> uncurry IfaceNonRec (do_one (b, r)) + Rec prs -> IfaceRec (map do_one prs) + where + do_one (b, rhs) = + let top_bndr = toIfaceTopBndr b + rhs' = case top_bndr of + -- Use the existing unfolding for a global binder if we store that anyway. + -- See Note [Interface File with Core: Sharing RHSs] + IfGblTopBndr {} -> if already_has_unfolding b then IfUseUnfoldingRhs else IfRhs (toIfaceExpr rhs) + -- Local binders will have had unfoldings trimmed so have + -- to serialise the whole RHS. + IfLclTopBndr {} -> IfRhs (toIfaceExpr rhs) + in (top_bndr, rhs') + + already_has_unfolding b = + -- The identifier has an unfolding, which we are going to serialise anyway + hasCoreUnfolding (realIdUnfolding b) + -- But not a stable unfolding, we want the optimised unfoldings. + && not (isStableUnfolding (realIdUnfolding b)) + --------------------- toIfaceAlt :: CoreAlt -> IfaceAlt toIfaceAlt (Alt c bs r) = IfaceAlt (toIfaceCon c) (map getOccFS bs) (toIfaceExpr r) @@ -717,5 +751,32 @@ slower by 8% overall (on #9872a-d, and T1969: the reason is that these NOINLINE'd functions now can't be profitably inlined outside of the hs-boot loop. + +Note [Interface File with Core: Sharing RHSs] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +In order to avoid duplicating definitions for bindings which already have unfoldings +we do some minor headstands to avoid serialising the RHS of a definition if it has +*any* unfolding. + +* Only global things have unfoldings, because local things have had their unfoldings stripped. +* For any global thing which has an unstable unfolding, we just use that. + +In order to implement this sharing: + +* When creating the interface, check the criteria above and don't serialise the RHS + if such a case. + See +* When reading an interface, look at the realIdUnfolding, and then the unfoldingTemplate. + See `tc_iface_binding` for where this happens. + +There are two main reasons why the mi_extra_decls field exists rather than shoe-horning +all the core bindings + +1. mi_extra_decls retains the recursive group structure of the original program which + is very convenient as otherwise we would have to do the analysis again when loading + the program. +2. There are additional local top-level bindings which don't make it into mi_decls. It's + best to keep these separate from mi_decls as mi_decls is used to compute the ABI hash. -} diff --git a/compiler/GHC/Data/Bag.hs b/compiler/GHC/Data/Bag.hs --- a/compiler/GHC/Data/Bag.hs +++ b/compiler/GHC/Data/Bag.hs @@ -18,7 +18,7 @@ concatBag, catBagMaybes, foldBag, isEmptyBag, isSingletonBag, consBag, snocBag, anyBag, allBag, listToBag, nonEmptyToBag, bagToList, headMaybe, mapAccumBagL, - concatMapBag, concatMapBagPair, mapMaybeBag, + concatMapBag, concatMapBagPair, mapMaybeBag, unzipBag, mapBagM, mapBagM_, flatMapBagM, flatMapBagPairM, mapAndUnzipBagM, mapAccumBagLM, @@ -33,9 +33,10 @@ import GHC.Utils.Monad import Control.Monad import Data.Data -import Data.Maybe( mapMaybe, listToMaybe ) +import Data.Maybe( mapMaybe ) import Data.List ( partition, mapAccumL ) import Data.List.NonEmpty ( NonEmpty(..) ) +import qualified Data.List.NonEmpty as NE import qualified Data.Semigroup ( (<>) ) infixr 3 `consBag` @@ -45,7 +46,7 @@ = EmptyBag | UnitBag a | TwoBags (Bag a) (Bag a) -- INVARIANT: neither branch is empty - | ListBag [a] -- INVARIANT: the list is non-empty + | ListBag (NonEmpty a) deriving (Foldable, Functor, Traversable) emptyBag :: Bag a @@ -90,7 +91,7 @@ isSingletonBag EmptyBag = False isSingletonBag (UnitBag _) = True isSingletonBag (TwoBags _ _) = False -- Neither is empty -isSingletonBag (ListBag xs) = isSingleton xs +isSingletonBag (ListBag (_:|xs)) = null xs filterBag :: (a -> Bool) -> Bag a -> Bag a filterBag _ EmptyBag = EmptyBag @@ -98,7 +99,7 @@ filterBag pred (TwoBags b1 b2) = sat1 `unionBags` sat2 where sat1 = filterBag pred b1 sat2 = filterBag pred b2 -filterBag pred (ListBag vs) = listToBag (filter pred vs) +filterBag pred (ListBag vs) = listToBag (filter pred (toList vs)) filterBagM :: Monad m => (a -> m Bool) -> Bag a -> m (Bag a) filterBagM _ EmptyBag = return EmptyBag @@ -111,7 +112,7 @@ sat2 <- filterBagM pred b2 return (sat1 `unionBags` sat2) filterBagM pred (ListBag vs) = do - sat <- filterM pred vs + sat <- filterM pred (toList vs) return (listToBag sat) allBag :: (a -> Bool) -> Bag a -> Bool @@ -135,9 +136,7 @@ anyBagM p (ListBag xs) = anyM p xs concatBag :: Bag (Bag a) -> Bag a -concatBag bss = foldr add emptyBag bss - where - add bs rs = bs `unionBags` rs +concatBag = foldr unionBags emptyBag catBagMaybes :: Bag (Maybe a) -> Bag a catBagMaybes bs = foldr add emptyBag bs @@ -155,7 +154,7 @@ where (sat1, fail1) = partitionBag pred b1 (sat2, fail2) = partitionBag pred b2 partitionBag pred (ListBag vs) = (listToBag sats, listToBag fails) - where (sats, fails) = partition pred vs + where (sats, fails) = partition pred (toList vs) partitionBagWith :: (a -> Either b c) -> Bag a @@ -171,7 +170,7 @@ where (sat1, fail1) = partitionBagWith pred b1 (sat2, fail2) = partitionBagWith pred b2 partitionBagWith pred (ListBag vs) = (listToBag sats, listToBag fails) - where (sats, fails) = partitionWith pred vs + where (sats, fails) = partitionWith pred (toList vs) foldBag :: (r -> r -> r) -- Replace TwoBags with this; should be associative -> (a -> r) -- Replace UnitBag with this @@ -220,7 +219,7 @@ Nothing -> EmptyBag Just y -> UnitBag y mapMaybeBag f (TwoBags b1 b2) = unionBags (mapMaybeBag f b1) (mapMaybeBag f b2) -mapMaybeBag f (ListBag xs) = ListBag (mapMaybe f xs) +mapMaybeBag f (ListBag xs) = listToBag $ mapMaybe f (toList xs) mapBagM :: Monad m => (a -> m b) -> Bag a -> m (Bag b) mapBagM _ EmptyBag = return EmptyBag @@ -267,7 +266,7 @@ (r2,s2) <- mapAndUnzipBagM f b2 return (TwoBags r1 r2, TwoBags s1 s2) mapAndUnzipBagM f (ListBag xs) = do ts <- mapM f xs - let (rs,ss) = unzip ts + let (rs,ss) = NE.unzip ts return (ListBag rs, ListBag ss) mapAccumBagL ::(acc -> x -> (acc, y)) -- ^ combining function @@ -298,20 +297,31 @@ listToBag :: [a] -> Bag a listToBag [] = EmptyBag listToBag [x] = UnitBag x -listToBag vs = ListBag vs +listToBag (x:xs) = ListBag (x:|xs) nonEmptyToBag :: NonEmpty a -> Bag a nonEmptyToBag (x :| []) = UnitBag x -nonEmptyToBag (x :| xs) = ListBag (x : xs) +nonEmptyToBag xs = ListBag xs bagToList :: Bag a -> [a] bagToList b = foldr (:) [] b +unzipBag :: Bag (a, b) -> (Bag a, Bag b) +unzipBag EmptyBag = (EmptyBag, EmptyBag) +unzipBag (UnitBag (a, b)) = (UnitBag a, UnitBag b) +unzipBag (TwoBags xs1 xs2) = (TwoBags as1 as2, TwoBags bs1 bs2) + where + (as1, bs1) = unzipBag xs1 + (as2, bs2) = unzipBag xs2 +unzipBag (ListBag xs) = (ListBag as, ListBag bs) + where + (as, bs) = NE.unzip xs + headMaybe :: Bag a -> Maybe a headMaybe EmptyBag = Nothing headMaybe (UnitBag v) = Just v headMaybe (TwoBags b1 _) = headMaybe b1 -headMaybe (ListBag l) = listToMaybe l +headMaybe (ListBag (v:|_)) = Just v instance (Outputable a) => Outputable (Bag a) where ppr bag = braces (pprWithCommas ppr (bagToList bag)) diff --git a/compiler/GHC/Data/BooleanFormula.hs b/compiler/GHC/Data/BooleanFormula.hs --- a/compiler/GHC/Data/BooleanFormula.hs +++ b/compiler/GHC/Data/BooleanFormula.hs @@ -25,7 +25,7 @@ import GHC.Utils.Monad import GHC.Utils.Outputable import GHC.Utils.Binary -import GHC.Parser.Annotation ( LocatedL ) +import GHC.Parser.Annotation ( LocatedL, noLocA ) import GHC.Types.SrcLoc import GHC.Types.Unique import GHC.Types.Unique.Set @@ -251,14 +251,14 @@ instance Binary a => Binary (BooleanFormula a) where put_ bh (Var x) = putByte bh 0 >> put_ bh x - put_ bh (And xs) = putByte bh 1 >> put_ bh xs - put_ bh (Or xs) = putByte bh 2 >> put_ bh xs - put_ bh (Parens x) = putByte bh 3 >> put_ bh x + put_ bh (And xs) = putByte bh 1 >> put_ bh (unLoc <$> xs) + put_ bh (Or xs) = putByte bh 2 >> put_ bh (unLoc <$> xs) + put_ bh (Parens x) = putByte bh 3 >> put_ bh (unLoc x) get bh = do h <- getByte bh case h of - 0 -> Var <$> get bh - 1 -> And <$> get bh - 2 -> Or <$> get bh - _ -> Parens <$> get bh + 0 -> Var <$> get bh + 1 -> And . fmap noLocA <$> get bh + 2 -> Or . fmap noLocA <$> get bh + _ -> Parens . noLocA <$> get bh diff --git a/compiler/GHC/Data/FastString.hs b/compiler/GHC/Data/FastString.hs --- a/compiler/GHC/Data/FastString.hs +++ b/compiler/GHC/Data/FastString.hs @@ -30,8 +30,8 @@ -- * Pointer and size of a Latin-1 encoded string. -- * Practically no operations. -- * Outputting them is fast. --- * Generated by 'mkPtrString'. --- * Length of string literals (mkPtrString "abc") is computed statically +-- * Generated by 'mkPtrString#'. +-- * Length of string literals (mkPtrString# "abc"#) is computed statically -- * Turn into 'GHC.Utils.Outputable.SDoc' with 'GHC.Utils.Outputable.ptext' -- * Requires manual memory management. -- Improper use may lead to memory leaks or dangling pointers. @@ -85,7 +85,6 @@ concatFS, consFS, nilFS, - isUnderscoreFS, lexicalCompareFS, uniqCompareFS, @@ -101,7 +100,6 @@ -- ** Construction mkPtrString#, - mkPtrString, -- ** Deconstruction unpackPtrString, @@ -134,7 +132,6 @@ import System.IO import Data.Data import Data.IORef -import Data.Char import Data.Semigroup as Semi import Foreign @@ -623,9 +620,6 @@ nilFS :: FastString nilFS = mkFastString "" -isUnderscoreFS :: FastString -> Bool -isUnderscoreFS fs = fs == fsLit "_" - -- ----------------------------------------------------------------------------- -- Stats @@ -666,30 +660,6 @@ mkPtrString# :: Addr# -> PtrString {-# INLINE mkPtrString# #-} mkPtrString# a# = PtrString (Ptr a#) (ptrStrLength (Ptr a#)) - --- | Encode a 'String' into a newly allocated 'PtrString' using Latin-1 --- encoding. The original string must not contain non-Latin-1 characters --- (above codepoint @0xff@). -{-# NOINLINE[0] mkPtrString #-} -- see rules below -mkPtrString :: String -> PtrString -mkPtrString s = - -- we don't use `unsafeDupablePerformIO` here to avoid potential memory leaks - -- and because someone might be using `eqAddr#` to check for string equality. - unsafePerformIO (do - let len = length s - p <- mallocBytes len - let - loop :: Int -> String -> IO () - loop !_ [] = return () - loop n (c:cs) = do - pokeByteOff p n (fromIntegral (ord c) :: Word8) - loop (1+n) cs - loop 0 s - return (PtrString p len) - ) - -{-# RULES "mkPtrString" - forall x . mkPtrString (unpackCString# x) = mkPtrString# x #-} -- | Decode a 'PtrString' back into a 'String' using Latin-1 encoding. -- This does not free the memory associated with 'PtrString'. diff --git a/compiler/GHC/Data/TrieMap.hs b/compiler/GHC/Data/TrieMap.hs --- a/compiler/GHC/Data/TrieMap.hs +++ b/compiler/GHC/Data/TrieMap.hs @@ -66,12 +66,11 @@ type XT a = Maybe a -> Maybe a -- How to alter a non-existent elt (Nothing) -- or an existing elt (Just) -class TrieMap m where +class Functor m => TrieMap m where type Key m :: Type emptyTM :: m a lookupTM :: forall b. Key m -> m b -> Maybe b alterTM :: forall b. Key m -> XT b -> m b -> m b - mapTM :: (a->b) -> m a -> m b filterTM :: (a -> Bool) -> m a -> m a foldTM :: (a -> b -> b) -> m a -> b -> b @@ -117,6 +116,25 @@ deMaybe (Just m) = m {- +Note [Every TrieMap is a Functor] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Every TrieMap T admits + fmap :: (a->b) -> T a -> T b +where (fmap f t) applies `f` to every element of the range of `t`. +Ergo, we make `Functor` a superclass of `TrieMap`. + +Moreover it is almost invariably possible to /derive/ Functor for each +particular instance. E.g. in the list instance we have + data ListMap m a + = LM { lm_nil :: Maybe a + , lm_cons :: m (ListMap m a) } + deriving (Functor) + instance TrieMap m => TrieMap (ListMap m) where { .. } + +Alas, we not yet derive `Functor` for reasons of performance; see #22292. +-} + +{- ************************************************************************ * * IntMaps @@ -130,7 +148,6 @@ lookupTM k m = IntMap.lookup k m alterTM = xtInt foldTM k m z = IntMap.foldr k z m - mapTM f m = IntMap.map f m filterTM f m = IntMap.filter f m xtInt :: Int -> XT a -> IntMap.IntMap a -> IntMap.IntMap a @@ -142,7 +159,6 @@ lookupTM = Map.lookup alterTM k f m = Map.alter f k m foldTM k m z = Map.foldr k z m - mapTM f m = Map.map f m filterTM f m = Map.filter f m @@ -219,7 +235,6 @@ lookupTM k m = lookupUDFM m k alterTM k f m = alterUDFM f m k foldTM k m z = foldUDFM k z m - mapTM f m = mapUDFM f m filterTM f m = filterUDFM f m {- @@ -235,22 +250,22 @@ data MaybeMap m a = MM { mm_nothing :: Maybe a, mm_just :: m a } +-- TODO(22292): derive +instance Functor m => Functor (MaybeMap m) where + fmap f MM { mm_nothing = mn, mm_just = mj } = MM + { mm_nothing = fmap f mn, mm_just = fmap f mj } + instance TrieMap m => TrieMap (MaybeMap m) where type Key (MaybeMap m) = Maybe (Key m) emptyTM = MM { mm_nothing = Nothing, mm_just = emptyTM } lookupTM = lkMaybe lookupTM alterTM = xtMaybe alterTM foldTM = fdMaybe - mapTM = mapMb filterTM = ftMaybe instance TrieMap m => Foldable (MaybeMap m) where foldMap = foldMapTM -mapMb :: TrieMap m => (a->b) -> MaybeMap m a -> MaybeMap m b -mapMb f (MM { mm_nothing = mn, mm_just = mj }) - = MM { mm_nothing = fmap f mn, mm_just = mapTM f mj } - lkMaybe :: (forall b. k -> m b -> Maybe b) -> Maybe k -> MaybeMap m a -> Maybe a lkMaybe _ Nothing = mm_nothing @@ -290,13 +305,17 @@ = LM { lm_nil :: Maybe a , lm_cons :: m (ListMap m a) } +-- TODO(22292): derive +instance Functor m => Functor (ListMap m) where + fmap f LM { lm_nil = mnil, lm_cons = mcons } = LM + { lm_nil = fmap f mnil, lm_cons = fmap (fmap f) mcons } + instance TrieMap m => TrieMap (ListMap m) where type Key (ListMap m) = [Key m] emptyTM = LM { lm_nil = Nothing, lm_cons = emptyTM } lookupTM = lkList lookupTM alterTM = xtList alterTM foldTM = fdList - mapTM = mapList filterTM = ftList instance TrieMap m => Foldable (ListMap m) where @@ -305,10 +324,6 @@ instance (TrieMap m, Outputable a) => Outputable (ListMap m a) where ppr m = text "List elts" <+> ppr (foldTM (:) m []) -mapList :: TrieMap m => (a->b) -> ListMap m a -> ListMap m b -mapList f (LM { lm_nil = mnil, lm_cons = mcons }) - = LM { lm_nil = fmap f mnil, lm_cons = mapTM (mapTM f) mcons } - lkList :: TrieMap m => (forall b. k -> m b -> Maybe b) -> [k] -> ListMap m a -> Maybe a lkList _ [] = lm_nil @@ -326,7 +341,7 @@ ftList :: TrieMap m => (a -> Bool) -> ListMap m a -> ListMap m a ftList f (LM { lm_nil = mnil, lm_cons = mcons }) - = LM { lm_nil = filterMaybe f mnil, lm_cons = mapTM (filterTM f) mcons } + = LM { lm_nil = filterMaybe f mnil, lm_cons = fmap (filterTM f) mcons } {- ************************************************************************ @@ -380,6 +395,11 @@ ppr (SingletonMap _ v) = text "Singleton map" <+> ppr v ppr (MultiMap m) = ppr m +-- TODO(22292): derive +instance Functor m => Functor (GenMap m) where + fmap = mapG + {-# INLINE fmap #-} + -- TODO undecidable instance instance (Eq (Key m), TrieMap m) => TrieMap (GenMap m) where type Key (GenMap m) = Key m @@ -387,7 +407,6 @@ lookupTM = lkG alterTM = xtG foldTM = fdG - mapTM = mapG filterTM = ftG instance (Eq (Key m), TrieMap m) => Foldable (GenMap m) where @@ -431,10 +450,10 @@ xtG k f (MultiMap m) = MultiMap (alterTM k f m) {-# INLINEABLE mapG #-} -mapG :: TrieMap m => (a -> b) -> GenMap m a -> GenMap m b +mapG :: Functor m => (a -> b) -> GenMap m a -> GenMap m b mapG _ EmptyMap = EmptyMap mapG f (SingletonMap k v) = SingletonMap k (f v) -mapG f (MultiMap m) = MultiMap (mapTM f m) +mapG f (MultiMap m) = MultiMap (fmap f m) {-# INLINEABLE fdG #-} fdG :: TrieMap m => (a -> b -> b) -> GenMap m a -> b -> b diff --git a/compiler/GHC/Driver/Config/Diagnostic.hs b/compiler/GHC/Driver/Config/Diagnostic.hs --- a/compiler/GHC/Driver/Config/Diagnostic.hs +++ b/compiler/GHC/Driver/Config/Diagnostic.hs @@ -1,5 +1,13 @@ + +-- | Functions for initialising error message printing configuration from the +-- GHC session flags. module GHC.Driver.Config.Diagnostic ( initDiagOpts + , initPrintConfig + , initPsMessageOpts + , initDsMessageOpts + , initTcMessageOpts + , initDriverMessageOpts ) where @@ -8,7 +16,16 @@ import GHC.Utils.Outputable import GHC.Utils.Error (DiagOpts (..)) +import GHC.Driver.Errors.Types (GhcMessage, GhcMessageOpts (..), PsMessage, DriverMessage, DriverMessageOpts (..)) +import GHC.Driver.Errors.Ppr () +import GHC.Tc.Errors.Types +import GHC.HsToCore.Errors.Types +import GHC.Types.Error +import GHC.Tc.Errors.Ppr +-- | Initialise the general configuration for printing diagnostic messages +-- For example, this configuration controls things like whether warnings are +-- treated like errors. initDiagOpts :: DynFlags -> DiagOpts initDiagOpts dflags = DiagOpts { diag_warning_flags = warningFlags dflags @@ -18,4 +35,24 @@ , diag_max_errors = maxErrors dflags , diag_ppr_ctx = initSDocContext dflags defaultErrStyle } + +-- | Initialise the configuration for printing specific diagnostic messages +initPrintConfig :: DynFlags -> DiagnosticOpts GhcMessage +initPrintConfig dflags = + GhcMessageOpts { psMessageOpts = initPsMessageOpts dflags + , tcMessageOpts = initTcMessageOpts dflags + , dsMessageOpts = initDsMessageOpts dflags + , driverMessageOpts= initDriverMessageOpts dflags } + +initPsMessageOpts :: DynFlags -> DiagnosticOpts PsMessage +initPsMessageOpts _ = NoDiagnosticOpts + +initTcMessageOpts :: DynFlags -> DiagnosticOpts TcRnMessage +initTcMessageOpts dflags = TcRnMessageOpts { tcOptsShowContext = gopt Opt_ShowErrorContext dflags } + +initDsMessageOpts :: DynFlags -> DiagnosticOpts DsMessage +initDsMessageOpts _ = NoDiagnosticOpts + +initDriverMessageOpts :: DynFlags -> DiagnosticOpts DriverMessage +initDriverMessageOpts dflags = DriverMessageOpts (initPsMessageOpts dflags) diff --git a/compiler/GHC/Driver/Env.hs b/compiler/GHC/Driver/Env.hs --- a/compiler/GHC/Driver/Env.hs +++ b/compiler/GHC/Driver/Env.hs @@ -46,7 +46,7 @@ import GHC.Driver.Errors ( printOrThrowDiagnostics ) import GHC.Driver.Errors.Types ( GhcMessage ) import GHC.Driver.Config.Logger (initLogFlags) -import GHC.Driver.Config.Diagnostic (initDiagOpts) +import GHC.Driver.Config.Diagnostic (initDiagOpts, initPrintConfig) import GHC.Driver.Env.Types ( Hsc(..), HscEnv(..) ) import GHC.Runtime.Context @@ -95,7 +95,8 @@ (a, w) <- hsc hsc_env emptyMessages let dflags = hsc_dflags hsc_env let !diag_opts = initDiagOpts dflags - printOrThrowDiagnostics (hsc_logger hsc_env) diag_opts w + !print_config = initPrintConfig dflags + printOrThrowDiagnostics (hsc_logger hsc_env) print_config diag_opts w return a runHsc' :: HscEnv -> Hsc a -> IO (a, Messages GhcMessage) diff --git a/compiler/GHC/Driver/Errors.hs b/compiler/GHC/Driver/Errors.hs --- a/compiler/GHC/Driver/Errors.hs +++ b/compiler/GHC/Driver/Errors.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE ScopedTypeVariables #-} module GHC.Driver.Errors ( printOrThrowDiagnostics , printMessages @@ -16,8 +17,8 @@ import GHC.Utils.Logger import qualified GHC.Driver.CmdLine as CmdLine -printMessages :: Diagnostic a => Logger -> DiagOpts -> Messages a -> IO () -printMessages logger opts msgs +printMessages :: forall a . Diagnostic a => Logger -> DiagnosticOpts a -> DiagOpts -> Messages a -> IO () +printMessages logger msg_opts opts msgs = sequence_ [ let style = mkErrStyle unqual ctx = (diag_ppr_ctx opts) { sdocStyle = style } in logMsg logger (MCDiagnostic sev (diagnosticReason dia) (diagnosticCode dia)) s $ @@ -30,15 +31,15 @@ where messageWithHints :: Diagnostic a => SDocContext -> a -> SDoc messageWithHints ctx e = - let main_msg = formatBulleted ctx $ diagnosticMessage e + let main_msg = formatBulleted ctx $ diagnosticMessage msg_opts e in case diagnosticHints e of [] -> main_msg [h] -> main_msg $$ hang (text "Suggested fix:") 2 (ppr h) hs -> main_msg $$ hang (text "Suggested fixes:") 2 (formatBulleted ctx . mkDecorated . map ppr $ hs) -handleFlagWarnings :: Logger -> DiagOpts -> [CmdLine.Warn] -> IO () -handleFlagWarnings logger opts warns = do +handleFlagWarnings :: Logger -> GhcMessageOpts -> DiagOpts -> [CmdLine.Warn] -> IO () +handleFlagWarnings logger print_config opts warns = do let -- It would be nicer if warns :: [Located SDoc], but that -- has circular import problems. bag = listToBag [ mkPlainMsgEnvelope opts loc $ @@ -48,16 +49,16 @@ mkPlainDiagnostic reason noHints $ text warn | CmdLine.Warn reason (L loc warn) <- warns ] - printOrThrowDiagnostics logger opts (mkMessages bag) + printOrThrowDiagnostics logger print_config opts (mkMessages bag) -- | Given a bag of diagnostics, turn them into an exception if -- any has 'SevError', or print them out otherwise. -printOrThrowDiagnostics :: Logger -> DiagOpts -> Messages GhcMessage -> IO () -printOrThrowDiagnostics logger opts msgs +printOrThrowDiagnostics :: Logger -> GhcMessageOpts -> DiagOpts -> Messages GhcMessage -> IO () +printOrThrowDiagnostics logger print_config opts msgs | errorsOrFatalWarningsFound msgs = throwErrors msgs | otherwise - = printMessages logger opts msgs + = printMessages logger print_config opts msgs -- | Convert a 'PsError' into a wrapped 'DriverMessage'; use it -- for dealing with parse errors when the driver is doing dependency analysis. 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 @@ -1,6 +1,8 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeApplications #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -- instance Diagnostic {DriverMessage, GhcMessage} module GHC.Driver.Errors.Ppr ( @@ -26,6 +28,8 @@ import Data.Version import Language.Haskell.Syntax.Decls (RuleDecl(..)) +import GHC.Tc.Errors.Types (TcRnMessage) +import GHC.HsToCore.Errors.Types (DsMessage) -- -- Suggestions @@ -36,19 +40,23 @@ suggestInstantiatedWith pi_mod_name insts = [ InstantiationSuggestion k v | (k,v) <- ((pi_mod_name, mkHoleModule pi_mod_name) : insts) ] - instance Diagnostic GhcMessage where - diagnosticMessage = \case + type DiagnosticOpts GhcMessage = GhcMessageOpts + defaultDiagnosticOpts = GhcMessageOpts (defaultDiagnosticOpts @PsMessage) + (defaultDiagnosticOpts @TcRnMessage) + (defaultDiagnosticOpts @DsMessage) + (defaultDiagnosticOpts @DriverMessage) + diagnosticMessage opts = \case GhcPsMessage m - -> diagnosticMessage m + -> diagnosticMessage (psMessageOpts opts) m GhcTcRnMessage m - -> diagnosticMessage m + -> diagnosticMessage (tcMessageOpts opts) m GhcDsMessage m - -> diagnosticMessage m + -> diagnosticMessage (dsMessageOpts opts) m GhcDriverMessage m - -> diagnosticMessage m - GhcUnknownMessage m - -> diagnosticMessage m + -> diagnosticMessage (driverMessageOpts opts) m + GhcUnknownMessage (UnknownDiagnostic @e m) + -> diagnosticMessage (defaultDiagnosticOpts @e) m diagnosticReason = \case GhcPsMessage m @@ -77,11 +85,13 @@ diagnosticCode = constructorCode instance Diagnostic DriverMessage where - diagnosticMessage = \case - DriverUnknownMessage m - -> diagnosticMessage m + type DiagnosticOpts DriverMessage = DriverMessageOpts + defaultDiagnosticOpts = DriverMessageOpts (defaultDiagnosticOpts @PsMessage) + diagnosticMessage opts = \case + DriverUnknownMessage (UnknownDiagnostic @e m) + -> diagnosticMessage (defaultDiagnosticOpts @e) m DriverPsHeaderMessage m - -> diagnosticMessage m + -> diagnosticMessage (psDiagnosticOpts opts) m DriverMissingHomeModules missing buildingCabalPackage -> let msg | buildingCabalPackage == YesBuildingCabalPackage = hang 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 @@ -4,7 +4,10 @@ module GHC.Driver.Errors.Types ( GhcMessage(..) - , DriverMessage(..), DriverMessages, PsMessage(PsHeaderMessage) + , GhcMessageOpts(..) + , DriverMessage(..) + , DriverMessageOpts(..) + , DriverMessages, PsMessage(PsHeaderMessage) , BuildingCabalPackage(..) , WarningMessages , ErrorMessages @@ -91,13 +94,20 @@ deriving Generic + +data GhcMessageOpts = GhcMessageOpts { psMessageOpts :: DiagnosticOpts PsMessage + , tcMessageOpts :: DiagnosticOpts TcRnMessage + , dsMessageOpts :: DiagnosticOpts DsMessage + , driverMessageOpts :: DiagnosticOpts DriverMessage + } + -- | Creates a new 'GhcMessage' out of any diagnostic. This function is also -- provided to ease the integration of #18516 by allowing diagnostics to be -- wrapped into the general (but structured) 'GhcMessage' type, so that the -- conversion can happen gradually. This function should not be needed within -- GHC, as it would typically be used by plugin or library authors (see -- comment for the 'GhcUnknownMessage' type constructor) -ghcUnknownMessage :: (Diagnostic a, Typeable a) => a -> GhcMessage +ghcUnknownMessage :: (DiagnosticOpts a ~ NoDiagnosticOpts, Diagnostic a, Typeable a) => a -> GhcMessage ghcUnknownMessage = GhcUnknownMessage . UnknownDiagnostic -- | Abstracts away the frequent pattern where we are calling 'ioMsgMaybe' on @@ -117,6 +127,7 @@ data DriverMessage where -- | Simply wraps a generic 'Diagnostic' message @a@. DriverUnknownMessage :: UnknownDiagnostic -> DriverMessage + -- | A parse error in parsing a Haskell file header during dependency -- analysis DriverPsHeaderMessage :: !PsMessage -> DriverMessage @@ -358,6 +369,9 @@ DriverHomePackagesNotClosed :: ![UnitId] -> DriverMessage deriving instance Generic DriverMessage + +data DriverMessageOpts = + DriverMessageOpts { psDiagnosticOpts :: DiagnosticOpts PsMessage } -- | Pass to a 'DriverMessage' the information whether or not the -- '-fbuilding-cabal-package' flag is set. diff --git a/compiler/GHC/Driver/Flags.hs b/compiler/GHC/Driver/Flags.hs --- a/compiler/GHC/Driver/Flags.hs +++ b/compiler/GHC/Driver/Flags.hs @@ -372,6 +372,7 @@ | Opt_KeepCAFs | Opt_KeepGoing | Opt_ByteCode + | Opt_ByteCodeAndObjectCode | Opt_LinkRts -- output style opts @@ -426,6 +427,9 @@ | Opt_SuppressTimestamps -- ^ Suppress timestamps in dumps | Opt_SuppressCoreSizes -- ^ Suppress per binding Core size stats in dumps + -- Error message suppression + | Opt_ShowErrorContext + -- temporary flags | Opt_AutoLinkPackages | Opt_ImplicitImportQualified @@ -442,6 +446,8 @@ | Opt_KeepOFiles | Opt_BuildDynamicToo + | Opt_WriteIfSimplifiedCore + | Opt_UseBytecodeRatherThanObjects -- safe haskell flags | Opt_DistrustAllPackages diff --git a/compiler/GHC/Driver/Monad.hs b/compiler/GHC/Driver/Monad.hs --- a/compiler/GHC/Driver/Monad.hs +++ b/compiler/GHC/Driver/Monad.hs @@ -147,7 +147,8 @@ dflags <- getSessionDynFlags logger <- getLogger let !diag_opts = initDiagOpts dflags - liftIO $ printOrThrowDiagnostics logger diag_opts warns + !print_config = initPrintConfig dflags + liftIO $ printOrThrowDiagnostics logger print_config diag_opts warns -- ----------------------------------------------------------------------------- -- | A minimal implementation of a 'GhcMonad'. If you need a custom monad, @@ -224,7 +225,8 @@ dflags <- getDynFlags logger <- getLogger let !diag_opts = initDiagOpts dflags - liftIO $ printMessages logger diag_opts (srcErrorMessages err) + !print_config = initPrintConfig dflags + liftIO $ printMessages logger print_config diag_opts (srcErrorMessages err) -- | A function called to log warnings and errors. type WarnErrLogger = forall m. (HasDynFlags m , MonadIO m, HasLogger m) => Maybe SourceError -> m () diff --git a/compiler/GHC/Driver/Pipeline/Phases.hs b/compiler/GHC/Driver/Pipeline/Phases.hs --- a/compiler/GHC/Driver/Pipeline/Phases.hs +++ b/compiler/GHC/Driver/Pipeline/Phases.hs @@ -17,10 +17,10 @@ import GHC.Fingerprint.Type import GHC.Unit.Module.Location ( ModLocation ) import GHC.Unit.Module.ModIface -import GHC.Linker.Types import GHC.Driver.Phases import Language.Haskell.Syntax.Module.Name ( ModuleName ) +import GHC.Unit.Home.ModInfo -- Typed Pipeline Phases -- MP: TODO: We need to refine the arguments to each of these phases so recompilation @@ -39,7 +39,7 @@ -> Messages GhcMessage -> Maybe Fingerprint -> TPhase HscBackendAction - T_HscBackend :: PipeEnv -> HscEnv -> ModuleName -> HscSource -> ModLocation -> HscBackendAction -> TPhase ([FilePath], ModIface, Maybe Linkable, FilePath) + T_HscBackend :: PipeEnv -> HscEnv -> ModuleName -> HscSource -> ModLocation -> HscBackendAction -> TPhase ([FilePath], ModIface, HomeModLinkable, FilePath) T_CmmCpp :: PipeEnv -> HscEnv -> FilePath -> TPhase FilePath T_Cmm :: PipeEnv -> HscEnv -> FilePath -> TPhase ([FilePath], FilePath) T_Cc :: Phase -> PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> TPhase FilePath 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 @@ -2903,10 +2903,11 @@ , make_ord_flag defFlag "fbyte-code" (noArgM $ \dflags -> do setBackend interpreterBackend - pure $ gopt_set dflags Opt_ByteCode) - , make_ord_flag defFlag "fobject-code" $ NoArg $ do - dflags <- liftEwM getCmdLineState + pure $ flip gopt_unset Opt_ByteCodeAndObjectCode (gopt_set dflags Opt_ByteCode)) + , make_ord_flag defFlag "fobject-code" $ noArgM $ \dflags -> do setBackend $ platformDefaultBackend (targetPlatform dflags) + dflags' <- liftEwM getCmdLineState + pure $ gopt_unset dflags' Opt_ByteCodeAndObjectCode , make_dep_flag defFlag "fglasgow-exts" (NoArg enableGlasgowExts) "Use individual extensions instead" @@ -3481,6 +3482,7 @@ flagSpec "strictness" Opt_Strictness, flagSpec "use-rpaths" Opt_RPath, flagSpec "write-interface" Opt_WriteInterface, + flagSpec "write-if-simplified-core" Opt_WriteIfSimplifiedCore, flagSpec "write-ide-info" Opt_WriteHie, flagSpec "unbox-small-strict-fields" Opt_UnboxSmallStrictFields, flagSpec "unbox-strict-fields" Opt_UnboxStrictFields, @@ -3501,11 +3503,14 @@ flagSpec "whole-archive-hs-libs" Opt_WholeArchiveHsLibs, flagSpec "keep-cafs" Opt_KeepCAFs, flagSpec "link-rts" Opt_LinkRts, - flagSpec' "compact-unwind" Opt_CompactUnwind + flagSpec "byte-code-and-object-code" Opt_ByteCodeAndObjectCode, + flagSpec "prefer-byte-code" Opt_UseBytecodeRatherThanObjects, + flagSpec' "compact-unwind" Opt_CompactUnwind (\turn_on -> updM (\dflags -> do unless (platformOS (targetPlatform dflags) == OSDarwin && turn_on) (addWarn "-compact-unwind is only implemented by the darwin platform. Ignoring.") - return dflags)) + return dflags)), + flagSpec "show-error-context" Opt_ShowErrorContext ] ++ fHoleFlags @@ -3799,7 +3804,9 @@ Opt_VersionMacros, Opt_RPath, Opt_DumpWithWays, - Opt_CompactUnwind + Opt_CompactUnwind, + Opt_ShowErrorContext + ] ++ [f | (ns,f) <- optLevelFlags, 0 `elem` ns] @@ -3872,6 +3879,8 @@ ,(Opt_DeferTypeErrors, turnOn, Opt_DeferOutOfScopeVariables) ,(Opt_DoLinearCoreLinting, turnOn, Opt_DoCoreLinting) ,(Opt_Strictness, turnOn, Opt_WorkerWrapper) + ,(Opt_WriteIfSimplifiedCore, turnOn, Opt_WriteInterface) + ,(Opt_ByteCodeAndObjectCode, turnOn, Opt_WriteIfSimplifiedCore) ] ++ validHoleFitsImpliedGFlags -- General flags that are switched on/off when other general flags are switched @@ -4459,12 +4468,11 @@ setMainIs :: String -> DynP () setMainIs arg - | not (null main_fn) && isLower (head main_fn) - -- The arg looked like "Foo.Bar.baz" + | x:_ <- main_fn, isLower x -- The arg looked like "Foo.Bar.baz" = upd $ \d -> d { mainFunIs = Just main_fn, mainModuleNameIs = mkModuleName main_mod } - | isUpper (head arg) -- The arg looked like "Foo" or "Foo.Bar" + | x:_ <- arg, isUpper x -- The arg looked like "Foo" or "Foo.Bar" = upd $ \d -> d { mainModuleNameIs = mkModuleName arg } | otherwise -- The arg looked like "baz" diff --git a/compiler/GHC/Hs.hs b/compiler/GHC/Hs.hs --- a/compiler/GHC/Hs.hs +++ b/compiler/GHC/Hs.hs @@ -69,7 +69,7 @@ data XModulePs = XModulePs { hsmodAnn :: EpAnn AnnsModule, - hsmodLayout :: LayoutInfo, + hsmodLayout :: LayoutInfo GhcPs, -- ^ Layout info for the module. -- For incomplete modules (e.g. the output of parseHeader), it is NoLayoutInfo. hsmodDeprecMessage :: Maybe (LocatedP (WarningTxt GhcPs)), diff --git a/compiler/GHC/Hs/Decls.hs b/compiler/GHC/Hs/Decls.hs --- a/compiler/GHC/Hs/Decls.hs +++ b/compiler/GHC/Hs/Decls.hs @@ -353,7 +353,8 @@ , tcdFVs :: NameSet } deriving Data -type instance XClassDecl GhcPs = (EpAnn [AddEpAnn], AnnSortKey, LayoutInfo) -- See Note [Class LayoutInfo] +type instance XClassDecl GhcPs = (EpAnn [AddEpAnn], AnnSortKey) + -- TODO:AZ:tidy up AnnSortKey above type instance XClassDecl GhcRn = NameSet -- FVs type instance XClassDecl GhcTc = NameSet -- FVs @@ -487,10 +488,11 @@ = hsep [pprLHsContext context, pp_tyvars tyvars] where pp_tyvars (varl:varsr) - | fixity == Infix && length varsr > 1 + | fixity == Infix, varr:varsr'@(_:_) <- varsr + -- If varsr has at least 2 elements, parenthesize. = hsep [char '(',ppr (unLoc varl), pprInfixOcc (unLoc thing) - , (ppr.unLoc) (head varsr), char ')' - , hsep (map (ppr.unLoc) (tail varsr))] + , (ppr.unLoc) varr, char ')' + , hsep (map (ppr.unLoc) varsr')] | fixity == Infix = hsep [ppr (unLoc varl), pprInfixOcc (unLoc thing) , hsep (map (ppr.unLoc) varsr)] diff --git a/compiler/GHC/Hs/Doc.hs b/compiler/GHC/Hs/Doc.hs --- a/compiler/GHC/Hs/Doc.hs +++ b/compiler/GHC/Hs/Doc.hs @@ -85,9 +85,9 @@ instance Binary a => Binary (WithHsDocIdentifiers a GhcRn) where put_ bh (WithHsDocIdentifiers s ids) = do put_ bh s - put_ bh ids + put_ bh $ BinLocated <$> ids get bh = - liftA2 WithHsDocIdentifiers (get bh) (get bh) + liftA2 WithHsDocIdentifiers (get bh) (fmap unBinLocated <$> get bh) -- | Extract a mapping from the lexed identifiers to the names they may -- correspond to. diff --git a/compiler/GHC/Hs/DocString.hs b/compiler/GHC/Hs/DocString.hs --- a/compiler/GHC/Hs/DocString.hs +++ b/compiler/GHC/Hs/DocString.hs @@ -75,19 +75,19 @@ MultiLineDocString dec xs -> do putByte bh 0 put_ bh dec - put_ bh xs + put_ bh $ BinLocated <$> xs NestedDocString dec x -> do putByte bh 1 put_ bh dec - put_ bh x + put_ bh $ BinLocated x GeneratedDocString x -> do putByte bh 2 put_ bh x get bh = do tag <- getByte bh case tag of - 0 -> MultiLineDocString <$> get bh <*> get bh - 1 -> NestedDocString <$> get bh <*> get bh + 0 -> MultiLineDocString <$> get bh <*> (fmap unBinLocated <$> get bh) + 1 -> NestedDocString <$> get bh <*> (unBinLocated <$> get bh) 2 -> GeneratedDocString <$> get bh t -> fail $ "HsDocString: invalid tag " ++ show t diff --git a/compiler/GHC/Hs/Dump.hs b/compiler/GHC/Hs/Dump.hs --- a/compiler/GHC/Hs/Dump.hs +++ b/compiler/GHC/Hs/Dump.hs @@ -158,7 +158,7 @@ occName n = braces $ text "OccName:" - <+> text (occNameString n) + <+> ftext (occNameFS n) moduleName :: ModuleName -> SDoc moduleName m = braces $ text "ModuleName:" <+> ppr m diff --git a/compiler/GHC/Hs/Extension.hs b/compiler/GHC/Hs/Extension.hs --- a/compiler/GHC/Hs/Extension.hs +++ b/compiler/GHC/Hs/Extension.hs @@ -11,6 +11,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilyDependencies #-} +{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE UndecidableSuperClasses #-} -- for IsPass; see Note [NoGhcTc] {-# LANGUAGE UndecidableInstances #-} -- Wrinkle in Note [Trees That Grow] -- in module Language.Haskell.Syntax.Extension @@ -27,6 +28,7 @@ import GHC.TypeLits (KnownSymbol, symbolVal) import Data.Data hiding ( Fixity ) +import Language.Haskell.Syntax.Concrete import Language.Haskell.Syntax.Extension import GHC.Types.Name import GHC.Types.Name.Reader @@ -258,3 +260,5 @@ instance (KnownSymbol tok, KnownSymbol utok) => Outputable (HsUniToken tok utok) where ppr HsNormalTok = text (symbolVal (Proxy :: Proxy tok)) ppr HsUnicodeTok = text (symbolVal (Proxy :: Proxy utok)) + +deriving instance Typeable p => Data (LayoutInfo (GhcPass p)) diff --git a/compiler/GHC/Hs/Utils.hs b/compiler/GHC/Hs/Utils.hs --- a/compiler/GHC/Hs/Utils.hs +++ b/compiler/GHC/Hs/Utils.hs @@ -66,7 +66,7 @@ spanHsLocaLBinds, -- * Literals - mkHsIntegral, mkHsFractional, mkHsIsString, mkHsString, mkHsStringPrimLit, + mkHsIntegral, mkHsFractional, mkHsIsString, mkHsString, mkHsStringFS, mkHsStringPrimLit, mkHsCharPrimLit, -- * Patterns @@ -109,7 +109,7 @@ lStmtsImplicits, hsValBindsImplicits, lPatImplicits ) where -import GHC.Prelude +import GHC.Prelude hiding (head, init, last, tail) import GHC.Hs.Decls import GHC.Hs.Binds @@ -150,6 +150,8 @@ import Data.Foldable ( toList ) import Data.Function import Data.List ( partition, deleteBy ) +import Data.List.NonEmpty ( nonEmpty ) +import qualified Data.List.NonEmpty as NE {- ************************************************************************ @@ -220,8 +222,9 @@ mkLocatedList :: Semigroup a => [GenLocated (SrcAnn a) e2] -> LocatedAn an [GenLocated (SrcAnn a) e2] -mkLocatedList [] = noLocA [] -mkLocatedList ms = L (noAnnSrcSpan $ locA $ combineLocsA (head ms) (last ms)) ms +mkLocatedList ms = case nonEmpty ms of + Nothing -> noLocA [] + Just ms1 -> L (noAnnSrcSpan $ locA $ combineLocsA (NE.head ms1) (NE.last ms1)) ms mkHsApp :: LHsExpr (GhcPass id) -> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id) mkHsApp e1 e2 = addCLocAA e1 e2 (HsApp noComments e1 e2) @@ -451,6 +454,9 @@ mkHsString :: String -> HsLit (GhcPass p) mkHsString s = HsString NoSourceText (mkFastString s) +mkHsStringFS :: FastString -> HsLit (GhcPass p) +mkHsStringFS s = HsString NoSourceText s + mkHsStringPrimLit :: FastString -> HsLit (GhcPass p) mkHsStringPrimLit fs = HsStringPrim NoSourceText (bytesFS fs) @@ -656,7 +662,7 @@ mkLHsPatTup :: [LPat GhcRn] -> LPat GhcRn mkLHsPatTup [] = noLocA $ TuplePat noExtField [] Boxed mkLHsPatTup [lpat] = lpat -mkLHsPatTup lpats = L (getLoc (head lpats)) $ TuplePat noExtField lpats Boxed +mkLHsPatTup lpats@(lpat:_) = L (getLoc lpat) $ TuplePat noExtField lpats Boxed -- | The Big equivalents for the source tuple expressions mkBigLHsVarTup :: IsSrcSpanAnn p a 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 @@ -1,6 +1,8 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE LambdaCase #-} - +{-# LANGUAGE GADTs #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -- instance Diagnostic DsMessage module GHC.HsToCore.Errors.Ppr where @@ -23,9 +25,11 @@ instance Diagnostic DsMessage where - diagnosticMessage = \case - DsUnknownMessage m - -> diagnosticMessage m + type DiagnosticOpts DsMessage = NoDiagnosticOpts + defaultDiagnosticOpts = NoDiagnosticOpts + diagnosticMessage _ = \case + DsUnknownMessage (UnknownDiagnostic @e m) + -> diagnosticMessage (defaultDiagnosticOpts @e) m DsEmptyEnumeration -> mkSimpleDecorated $ text "Enumeration is empty" DsIdentitiesFound conv_fn type_of_conv @@ -235,7 +239,7 @@ DsRuleMightInlineFirst{} -> WarningWithFlag Opt_WarnInlineRuleShadowing DsAnotherRuleMightFireFirst{} -> WarningWithFlag Opt_WarnInlineRuleShadowing - diagnosticHints = \case + diagnosticHints = \case DsUnknownMessage m -> diagnosticHints m DsEmptyEnumeration -> noHints DsIdentitiesFound{} -> 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 @@ -1,4 +1,6 @@ {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE TypeFamilies #-} module GHC.HsToCore.Errors.Types where diff --git a/compiler/GHC/HsToCore/Pmc/Solver/Types.hs b/compiler/GHC/HsToCore/Pmc/Solver/Types.hs --- a/compiler/GHC/HsToCore/Pmc/Solver/Types.hs +++ b/compiler/GHC/HsToCore/Pmc/Solver/Types.hs @@ -348,9 +348,9 @@ lookupSolution :: Nabla -> Id -> Maybe PmAltConApp lookupSolution nabla x = case vi_pos (lookupVarInfo (nabla_tm_st nabla) x) of [] -> Nothing - pos + pos@(x:_) | Just sol <- find isDataConSolution pos -> Just sol - | otherwise -> Just (head pos) + | otherwise -> Just x -------------------------------------------------------------------------------- -- The rest is just providing an IR for (overloaded!) literals and AltCons that @@ -766,7 +766,7 @@ instance Outputable PmLitValue where ppr (PmLitInt i) = ppr i - ppr (PmLitRat r) = ppr (double (fromRat r)) -- good enough + ppr (PmLitRat r) = double (fromRat r) -- good enough ppr (PmLitChar c) = pprHsChar c ppr (PmLitString s) = pprHsString s ppr (PmLitOverInt n i) = minuses n (ppr i) diff --git a/compiler/GHC/Iface/Syntax.hs b/compiler/GHC/Iface/Syntax.hs --- a/compiler/GHC/Iface/Syntax.hs +++ b/compiler/GHC/Iface/Syntax.hs @@ -5,14 +5,15 @@ {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE DeriveTraversable #-} module GHC.Iface.Syntax ( module GHC.Iface.Type, IfaceDecl(..), IfaceFamTyConFlav(..), IfaceClassOp(..), IfaceAT(..), IfaceConDecl(..), IfaceConDecls(..), IfaceEqSpec, - IfaceExpr(..), IfaceAlt(..), IfaceLetBndr(..), IfaceJoinInfo(..), - IfaceBinding(..), IfaceConAlt(..), + IfaceExpr(..), IfaceAlt(..), IfaceLetBndr(..), IfaceJoinInfo(..), IfaceBinding, + IfaceBindingX(..), IfaceMaybeRhs(..), IfaceConAlt(..), IfaceIdInfo, IfaceIdDetails(..), IfaceUnfolding(..), IfGuidance(..), IfaceInfoItem(..), IfaceRule(..), IfaceAnnotation(..), IfaceAnnTarget, IfaceClsInst(..), IfaceFamInst(..), IfaceTickish(..), @@ -22,7 +23,7 @@ IfaceAxBranch(..), IfaceTyConParent(..), IfaceCompleteMatch(..), - IfaceLFInfo(..), + IfaceLFInfo(..), IfaceTopBndrInfo(..), -- * Binding names IfaceTopBndr, @@ -117,6 +118,7 @@ --pprTrace "putIfaceTopBndr" (ppr name) $ put_binding_name bh name + data IfaceDecl = IfaceId { ifName :: IfaceTopBndr, ifType :: IfaceType, @@ -548,7 +550,7 @@ | IfaceApp IfaceExpr IfaceExpr | IfaceCase IfaceExpr IfLclName [IfaceAlt] | IfaceECase IfaceExpr IfaceType -- See Note [Empty case alternatives] - | IfaceLet IfaceBinding IfaceExpr + | IfaceLet (IfaceBinding IfaceLetBndr) IfaceExpr | IfaceCast IfaceExpr IfaceCoercion | IfaceLit Literal | IfaceLitRubbish IfaceType -- See GHC.Types.Literal @@ -571,15 +573,24 @@ | IfaceDataAlt IfExtName | IfaceLitAlt Literal -data IfaceBinding - = IfaceNonRec IfaceLetBndr IfaceExpr - | IfaceRec [(IfaceLetBndr, IfaceExpr)] +type IfaceBinding b = IfaceBindingX IfaceExpr b +data IfaceBindingX r b + = IfaceNonRec b r + | IfaceRec [(b, r)] + deriving (Functor, Foldable, Traversable, Ord, Eq) + -- IfaceLetBndr is like IfaceIdBndr, but has IdInfo too -- It's used for *non-top-level* let/rec binders -- See Note [IdInfo on nested let-bindings] data IfaceLetBndr = IfLetBndr IfLclName IfaceType IfaceIdInfo IfaceJoinInfo +data IfaceTopBndrInfo = IfLclTopBndr IfLclName IfaceType IfaceIdInfo IfaceIdDetails + | IfGblTopBndr IfaceTopBndr + +-- See Note [Interface File with Core: Sharing RHSs] +data IfaceMaybeRhs = IfUseUnfoldingRhs | IfRhs IfaceExpr + data IfaceJoinInfo = IfaceNotJoinPoint | IfaceJoinPoint JoinArity @@ -696,6 +707,21 @@ instance Outputable IfaceDecl where ppr = pprIfaceDecl showToIface +instance (Outputable r, Outputable b) => Outputable (IfaceBindingX r b) where + ppr b = case b of + (IfaceNonRec b r) -> ppr_bind (b, r) + (IfaceRec pairs) -> sep [text "rec {", nest 2 (sep (map ppr_bind pairs)),text "}"] + where + ppr_bind (b, r) = ppr b <+> equals <+> ppr r + +instance Outputable IfaceTopBndrInfo where + ppr (IfLclTopBndr lcl_name _ _ _) = ppr lcl_name + ppr (IfGblTopBndr gbl) = ppr gbl + +instance Outputable IfaceMaybeRhs where + ppr IfUseUnfoldingRhs = text "" + ppr (IfRhs ie) = ppr ie + {- Note [Minimal complete definition] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -2452,7 +2478,7 @@ 1 -> liftM IfaceDataAlt $ get bh _ -> liftM IfaceLitAlt $ get bh -instance Binary IfaceBinding where +instance (Binary r, Binary b) => Binary (IfaceBindingX b r) where put_ bh (IfaceNonRec aa ab) = putByte bh 0 >> put_ bh aa >> put_ bh ab put_ bh (IfaceRec ac) = putByte bh 1 >> put_ bh ac get bh = do @@ -2473,6 +2499,38 @@ d <- get bh return (IfLetBndr a b c d) +instance Binary IfaceTopBndrInfo where + put_ bh (IfLclTopBndr lcl ty info dets) = do + putByte bh 0 + put_ bh lcl + put_ bh ty + put_ bh info + put_ bh dets + put_ bh (IfGblTopBndr gbl) = do + putByte bh 1 + put_ bh gbl + get bh = do + tag <- getByte bh + case tag of + 0 -> IfLclTopBndr <$> get bh <*> get bh <*> get bh <*> get bh + 1 -> IfGblTopBndr <$> get bh + _ -> pprPanic "IfaceTopBndrInfo" (intWithCommas tag) + +instance Binary IfaceMaybeRhs where + put_ bh IfUseUnfoldingRhs = putByte bh 0 + put_ bh (IfRhs e) = do + putByte bh 1 + put_ bh e + + get bh = do + b <- getByte bh + case b of + 0 -> return IfUseUnfoldingRhs + 1 -> IfRhs <$> get bh + _ -> pprPanic "IfaceMaybeRhs" (intWithCommas b) + + + instance Binary IfaceJoinInfo where put_ bh IfaceNotJoinPoint = putByte bh 0 put_ bh (IfaceJoinPoint ar) = do @@ -2630,10 +2688,18 @@ instance NFData IfaceAlt where rnf (IfaceAlt con bndrs rhs) = rnf con `seq` rnf bndrs `seq` rnf rhs -instance NFData IfaceBinding where +instance (NFData b, NFData a) => NFData (IfaceBindingX a b) where rnf = \case IfaceNonRec bndr e -> rnf bndr `seq` rnf e IfaceRec binds -> rnf binds + +instance NFData IfaceTopBndrInfo where + rnf (IfGblTopBndr n) = n `seq` () + rnf (IfLclTopBndr fs ty info dets) = rnf fs `seq` rnf ty `seq` rnf info `seq` rnf dets `seq` () + +instance NFData IfaceMaybeRhs where + rnf IfUseUnfoldingRhs = () + rnf (IfRhs ce) = rnf ce `seq` () instance NFData IfaceLetBndr where rnf (IfLetBndr nm ty id_info join_info) = diff --git a/compiler/GHC/Linker/Types.hs b/compiler/GHC/Linker/Types.hs --- a/compiler/GHC/Linker/Types.hs +++ b/compiler/GHC/Linker/Types.hs @@ -49,6 +49,7 @@ import GHC.Unit.Module.Env import GHC.Types.Unique.DSet import GHC.Types.Unique.DFM +import GHC.Unit.Module.WholeCoreBindings {- ********************************************************************** @@ -156,6 +157,10 @@ = DotO ObjFile -- ^ An object file (.o) | DotA FilePath -- ^ Static archive file (.a) | DotDLL FilePath -- ^ Dynamically linked library file (.so, .dll, .dylib) + | CoreBindings WholeCoreBindings -- ^ Serialised core which we can turn into BCOs (or object files), or used by some other backend + -- See Note [Interface Files with Core Definitions] + | LoadedBCOs [Unlinked] -- ^ A list of BCOs, but hidden behind extra indirection to avoid + -- being too strict. | BCOs CompiledByteCode [SptEntry] -- ^ A byte-code object, lives only in memory. Also -- carries some static pointer table entries which @@ -168,6 +173,8 @@ ppr (DotA path) = text "DotA" <+> text path ppr (DotDLL path) = text "DotDLL" <+> text path ppr (BCOs bcos spt) = text "BCOs" <+> ppr bcos <+> ppr spt + ppr (LoadedBCOs{}) = text "LoadedBCOs" + ppr (CoreBindings {}) = text "FI" -- | An entry to be inserted into a module's static pointer table. -- See Note [Grand plan for static forms] in "GHC.Iface.Tidy.StaticPtrTable". @@ -205,6 +212,8 @@ nameOfObject_maybe (DotO fn) = Just fn nameOfObject_maybe (DotA fn) = Just fn nameOfObject_maybe (DotDLL fn) = Just fn +nameOfObject_maybe (CoreBindings {}) = Nothing +nameOfObject_maybe (LoadedBCOs{}) = Nothing nameOfObject_maybe (BCOs {}) = Nothing -- | Retrieve the filename of the linkable if possible. Panic if it is a byte-code object @@ -212,8 +221,9 @@ nameOfObject o = fromMaybe (pprPanic "nameOfObject" (ppr o)) (nameOfObject_maybe o) -- | Retrieve the compiled byte-code if possible. Panic if it is a file-based linkable -byteCodeOfObject :: Unlinked -> CompiledByteCode -byteCodeOfObject (BCOs bc _) = bc +byteCodeOfObject :: Unlinked -> [CompiledByteCode] +byteCodeOfObject (BCOs bc _) = [bc] +byteCodeOfObject (LoadedBCOs ul) = concatMap byteCodeOfObject ul byteCodeOfObject other = pprPanic "byteCodeOfObject" (ppr other) {- ********************************************************************** diff --git a/compiler/GHC/Parser.y b/compiler/GHC/Parser.y --- a/compiler/GHC/Parser.y +++ b/compiler/GHC/Parser.y @@ -67,7 +67,7 @@ import qualified GHC.Data.Strict as Strict import GHC.Types.Name.Reader -import GHC.Types.Name.Occurrence ( varName, dataName, tcClsName, tvName, occNameFS, mkVarOcc, occNameString) +import GHC.Types.Name.Occurrence ( varName, dataName, tcClsName, tvName, occNameFS, mkVarOccFS, occNameString) import GHC.Types.SrcLoc import GHC.Types.Basic import GHC.Types.Error ( GhcHint(..) ) @@ -925,17 +925,17 @@ body :: { (AnnList ,([LImportDecl GhcPs], [LHsDecl GhcPs]) - ,LayoutInfo) } + ,LayoutInfo GhcPs) } : '{' top '}' { (AnnList Nothing (Just $ moc $1) (Just $ mcc $3) [] (fst $2) - , snd $2, ExplicitBraces) } + , snd $2, explicitBraces $1 $3) } | vocurly top close { (AnnList Nothing Nothing Nothing [] (fst $2) , snd $2, VirtualBraces (getVOCURLY $1)) } body2 :: { (AnnList ,([LImportDecl GhcPs], [LHsDecl GhcPs]) - ,LayoutInfo) } + ,LayoutInfo GhcPs) } : '{' top '}' { (AnnList Nothing (Just $ moc $1) (Just $ mcc $3) [] (fst $2) - , snd $2, ExplicitBraces) } + , snd $2, explicitBraces $1 $3) } | missing_module_keyword top close { (AnnList Nothing Nothing Nothing [] [], snd $2, VirtualBraces leftmostColumn) } @@ -1712,9 +1712,9 @@ decllist_cls :: { Located ([AddEpAnn] , OrdList (LHsDecl GhcPs) - , LayoutInfo) } -- Reversed + , LayoutInfo GhcPs) } -- Reversed : '{' decls_cls '}' { sLL $1 $> (moc $1:mcc $3:(fst $ unLoc $2) - ,snd $ unLoc $2, ExplicitBraces) } + ,snd $ unLoc $2, explicitBraces $1 $3) } | vocurly decls_cls close { let { L l (anns, decls) = $2 } in L l (anns, decls, VirtualBraces (getVOCURLY $1)) } @@ -1722,7 +1722,7 @@ -- where_cls :: { Located ([AddEpAnn] ,(OrdList (LHsDecl GhcPs)) -- Reversed - ,LayoutInfo) } + ,LayoutInfo GhcPs) } -- No implicit parameters -- May have type declarations : 'where' decllist_cls { sLL $1 $> (mj AnnWhere $1:(fstOf3 $ unLoc $2) @@ -3447,7 +3447,7 @@ final = last fields l = comb2 (reLoc $1) $3 isPun = True - var <- mkHsVarPV (L (noAnnSrcSpan $ getLocA final) (mkRdrUnqual . mkVarOcc . unpackFS . field_label . unLoc . dfoLabel . unLoc $ final)) + var <- mkHsVarPV (L (noAnnSrcSpan $ getLocA final) (mkRdrUnqual . mkVarOccFS . field_label . unLoc . dfoLabel . unLoc $ final)) fmap Right $ mkHsProjUpdatePV l (L l fields) var isPun [] } @@ -3830,7 +3830,7 @@ special_sym :: { Located FastString } special_sym : '.' { sL1 $1 (fsLit ".") } - | '*' { sL1 $1 (fsLit (starSym (isUnicode $1))) } + | '*' { sL1 $1 (starSym (isUnicode $1)) } ----------------------------------------------------------------------------- -- Data constructors @@ -4408,6 +4408,9 @@ hsUniTok t@(L l _) = L (mkTokenLocation l) (if isUnicode t then HsUnicodeTok else HsNormalTok) + +explicitBraces :: Located Token -> Located Token -> LayoutInfo GhcPs +explicitBraces t1 t2 = ExplicitBraces (hsTok t1) (hsTok t2) -- ------------------------------------- diff --git a/compiler/GHC/Parser/Annotation.hs b/compiler/GHC/Parser/Annotation.hs --- a/compiler/GHC/Parser/Annotation.hs +++ b/compiler/GHC/Parser/Annotation.hs @@ -95,7 +95,6 @@ import GHC.Types.Name import GHC.Types.SrcLoc import GHC.Hs.DocString -import GHC.Utils.Binary import GHC.Utils.Outputable hiding ( (<>) ) import GHC.Utils.Panic import qualified GHC.Data.Strict as Strict @@ -1248,17 +1247,6 @@ instance Outputable IsUnicodeSyntax where ppr = text . show - -instance Binary a => Binary (LocatedL a) where - -- We do not serialise the annotations - put_ bh (L l x) = do - put_ bh (locA l) - put_ bh x - - get bh = do - l <- get bh - x <- get bh - return (L (noAnnSrcSpan l) x) instance (Outputable a) => Outputable (SrcSpanAnn' a) where ppr (SrcSpanAnn a l) = text "SrcSpanAnn" <+> ppr a <+> ppr l 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 @@ -5,6 +5,8 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE PolyKinds #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -- instance Diagnostic PsMessage @@ -36,9 +38,11 @@ instance Diagnostic PsMessage where - diagnosticMessage = \case - PsUnknownMessage m - -> diagnosticMessage m + type DiagnosticOpts PsMessage = NoDiagnosticOpts + defaultDiagnosticOpts = NoDiagnosticOpts + diagnosticMessage _ = \case + PsUnknownMessage (UnknownDiagnostic @e m) + -> diagnosticMessage (defaultDiagnosticOpts @e) m PsHeaderMessage m -> psHeaderMessageDiagnostic m @@ -73,20 +77,20 @@ PsWarnTransitionalLayout reason -> mkSimpleDecorated $ text "transitional layout will not be accepted in the future:" - $$ text (case reason of - TransLayout_Where -> "`where' clause at the same depth as implicit layout block" - TransLayout_Pipe -> "`|' at the same depth as implicit layout block" + $$ (case reason of + TransLayout_Where -> text "`where' clause at the same depth as implicit layout block" + TransLayout_Pipe -> text "`|' at the same depth as implicit layout block" ) PsWarnOperatorWhitespaceExtConflict sym -> 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 "would denote" <+> syntax_meaning + $$ nest 2 (text "were the" <+> extension_name <+> text "extension enabled.") 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 (text "LinearTypes") (text "a multiplicity annotation") + OperatorWhitespaceSymbol_PrefixDollar -> mk_prefix_msg (text "TemplateHaskell") (text "an untyped splice") + OperatorWhitespaceSymbol_PrefixDollarDollar -> mk_prefix_msg (text "TemplateHaskell") (text "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) @@ -120,21 +124,21 @@ PsErrLexer err kind -> mkSimpleDecorated $ hcat - [ text $ case err of - LexError -> "lexical error" - LexUnknownPragma -> "unknown pragma" - LexErrorInPragma -> "lexical error in pragma" - LexNumEscapeRange -> "numeric escape sequence out of range" - LexStringCharLit -> "lexical error in string/character literal" - LexStringCharLitEOF -> "unexpected end-of-file in string/character literal" - LexUnterminatedComment -> "unterminated `{-'" - LexUnterminatedOptions -> "unterminated OPTIONS pragma" - LexUnterminatedQQ -> "unterminated quasiquotation" + [ case err of + LexError -> text "lexical error" + LexUnknownPragma -> text "unknown pragma" + LexErrorInPragma -> text "lexical error in pragma" + LexNumEscapeRange -> text "numeric escape sequence out of range" + LexStringCharLit -> text "lexical error in string/character literal" + LexStringCharLitEOF -> text "unexpected end-of-file in string/character literal" + LexUnterminatedComment -> text "unterminated `{-'" + LexUnterminatedOptions -> text "unterminated OPTIONS pragma" + LexUnterminatedQQ -> text "unterminated quasiquotation" - , text $ case kind of - LexErrKind_EOF -> " at end of input" - LexErrKind_UTF8 -> " (UTF-8 decoding error)" - LexErrKind_Char c -> " at character " ++ show c + , case kind of + LexErrKind_EOF -> text " at end of input" + LexErrKind_UTF8 -> text " (UTF-8 decoding error)" + LexErrKind_Char c -> text $ " at character " ++ show c ] PsErrParse token _details | null token @@ -509,7 +513,7 @@ , nest 2 $ text "but" <+> quotes (ppr tycon) <+> text "has" <+> speakN n ] , text "In the newtype declaration for" <+> quotes (ppr tycon) ] - diagnosticReason = \case + diagnosticReason = \case PsUnknownMessage m -> diagnosticReason m PsHeaderMessage m -> psHeaderMessageReason m PsWarnBidirectionalFormatChars{} -> WarningWithFlag Opt_WarnUnicodeBidirectionalFormatCharacters @@ -627,7 +631,7 @@ PsErrInvalidCApiImport {} -> ErrorWithoutFlag PsErrMultipleConForNewtype {} -> ErrorWithoutFlag - diagnosticHints = \case + diagnosticHints = \case PsUnknownMessage m -> diagnosticHints m PsHeaderMessage m -> psHeaderMessageHints m PsWarnBidirectionalFormatChars{} -> noHints 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 @@ -1,4 +1,5 @@ {-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE TypeFamilies #-} module GHC.Parser.Errors.Types where diff --git a/compiler/GHC/Parser/HaddockLex.x b/compiler/GHC/Parser/HaddockLex.x --- a/compiler/GHC/Parser/HaddockLex.x +++ b/compiler/GHC/Parser/HaddockLex.x @@ -148,7 +148,7 @@ RealSrcSpan span _ -> [(RealSrcSpan span' Strict.Nothing, tok) | (span', tok) <- alexScanTokens (realSrcSpanStart span) bs] UnhelpfulSpan reason -> [(UnhelpfulSpan reason, tok) | (_, tok) <- alexScanTokens fakeLoc bs] - fakeLoc = mkRealSrcLoc (mkFastString "") 0 0 + fakeLoc = mkRealSrcLoc nilFS 0 0 -- | Lex identifiers from a docstring. lexHsDoc :: P (LocatedN RdrName) -- ^ A precise identifier parser @@ -169,7 +169,7 @@ plausibleIdents (L (UnhelpfulSpan reason) (HsDocStringChunk s)) = [(UnhelpfulSpan reason, tok) | (_, tok) <- alexScanTokens fakeLoc s] -- preserve the original reason - fakeLoc = mkRealSrcLoc (mkFastString "") 0 0 + fakeLoc = mkRealSrcLoc nilFS 0 0 validateIdentWith :: P (LocatedN RdrName) -> SrcSpan -> ByteString -> Maybe (Located RdrName) validateIdentWith identParser mloc str0 = @@ -191,7 +191,7 @@ buffer = stringBufferFromByteString str0 realSrcLc = case mloc of RealSrcSpan loc _ -> realSrcSpanStart loc - UnhelpfulSpan _ -> mkRealSrcLoc (mkFastString "") 0 0 + UnhelpfulSpan _ -> mkRealSrcLoc nilFS 0 0 pstate = initParserState pflags buffer realSrcLc in case unP identParser pstate of POk _ name -> Just $ case mloc of diff --git a/compiler/GHC/Parser/Lexer.x b/compiler/GHC/Parser/Lexer.x --- a/compiler/GHC/Parser/Lexer.x +++ b/compiler/GHC/Parser/Lexer.x @@ -163,6 +163,7 @@ $uniidchar = \x07 -- Trick Alex into handling Unicode. See Note [Unicode in Alex]. $idchar = [$small $large $digit $uniidchar \'] +$labelchar = [$small $large $digit $uniidchar \' \.] $unigraphic = \x06 -- Trick Alex into handling Unicode. See Note [Unicode in Alex]. $graphic = [$small $large $symbol $digit $idchar $special $unigraphic \"\'] @@ -451,7 +452,8 @@ } <0> { - "#" @varid / { ifExtension OverloadedLabelsBit } { skip_one_varid ITlabelvarid } + "#" $labelchar+ / { ifExtension OverloadedLabelsBit } { skip_one_varid ITlabelvarid } + "#" \" / { ifExtension OverloadedLabelsBit } { lex_quoted_label } } <0> { @@ -2023,46 +2025,64 @@ lex_string_tok :: Action lex_string_tok span buf _len _buf2 = do - tok <- lex_string "" + lexed <- lex_string (AI end bufEnd) <- getInput let - tok' = case tok of - ITprimstring _ bs -> ITprimstring (SourceText src) bs - ITstring _ s -> ITstring (SourceText src) s - _ -> panic "lex_string_tok" + tok = case lexed of + LexedPrimString s -> ITprimstring (SourceText src) (unsafeMkByteString s) + LexedRegularString s -> ITstring (SourceText src) (mkFastString s) src = lexemeToString buf (cur bufEnd - cur buf) - return (L (mkPsSpan (psSpanStart span) end) tok') + return $ L (mkPsSpan (psSpanStart span) end) tok -lex_string :: String -> P Token -lex_string s = do + +lex_quoted_label :: Action +lex_quoted_label span _buf _len _buf2 = do + s <- lex_string_helper "" + (AI end _) <- getInput + let + token = ITlabelvarid (mkFastString s) + start = psSpanStart span + + return $ L (mkPsSpan start end) token + + +data LexedString = LexedRegularString String | LexedPrimString String + +lex_string :: P LexedString +lex_string = do + s <- lex_string_helper "" + magicHash <- getBit MagicHashBit + if magicHash + then do + i <- getInput + case alexGetChar' i of + Just ('#',i) -> do + setInput i + when (any (> '\xFF') s) $ do + pState <- getPState + let msg = PsErrPrimStringInvalidChar + let err = mkPlainErrorMsgEnvelope (mkSrcSpanPs (last_loc pState)) msg + addError err + return $ LexedPrimString s + _other -> + return $ LexedRegularString s + else + return $ LexedRegularString s + + +lex_string_helper :: String -> P String +lex_string_helper s = do i <- getInput case alexGetChar' i of Nothing -> lit_error i Just ('"',i) -> do - setInput i - let s' = reverse s - magicHash <- getBit MagicHashBit - if magicHash - then do - i <- getInput - case alexGetChar' i of - Just ('#',i) -> do - setInput i - when (any (> '\xFF') s') $ do - pState <- getPState - let msg = PsErrPrimStringInvalidChar - let err = mkPlainErrorMsgEnvelope (mkSrcSpanPs (last_loc pState)) msg - addError err - return (ITprimstring (SourceText s') (unsafeMkByteString s')) - _other -> - return (ITstring (SourceText s') (mkFastString s')) - else - return (ITstring (SourceText s') (mkFastString s')) + setInput i + return (reverse s) Just ('\\',i) | Just ('&',i) <- next -> do - setInput i; lex_string s + setInput i; lex_string_helper s | Just (c,i) <- next, c <= '\x7f' && is_space c -> do -- is_space only works for <= '\x7f' (#3751, #5425) setInput i; lex_stringgap s @@ -2070,16 +2090,17 @@ Just (c, i1) -> do case c of - '\\' -> do setInput i1; c' <- lex_escape; lex_string (c':s) - c | isAny c -> do setInput i1; lex_string (c:s) + '\\' -> do setInput i1; c' <- lex_escape; lex_string_helper (c':s) + c | isAny c -> do setInput i1; lex_string_helper (c:s) _other -> lit_error i -lex_stringgap :: String -> P Token + +lex_stringgap :: String -> P String lex_stringgap s = do i <- getInput c <- getCharOrFail i case c of - '\\' -> lex_string s + '\\' -> lex_string_helper s c | c <= '\x7f' && is_space c -> lex_stringgap s -- is_space only works for <= '\x7f' (#3751, #5425) _other -> lit_error i diff --git a/compiler/GHC/Parser/PostProcess.hs b/compiler/GHC/Parser/PostProcess.hs --- a/compiler/GHC/Parser/PostProcess.hs +++ b/compiler/GHC/Parser/PostProcess.hs @@ -96,8 +96,8 @@ warnStarIsType, warnPrepositiveQualifiedModule, failOpFewArgs, - failOpNotEnabledImportQualifiedPost, - failOpImportQualifiedTwice, + failNotEnabledImportQualifiedPost, + failImportQualifiedTwice, SumOrTuple (..), @@ -193,7 +193,7 @@ -> Located (Maybe (LHsContext GhcPs), LHsType GhcPs) -> Located (a,[LHsFunDep GhcPs]) -> OrdList (LHsDecl GhcPs) - -> LayoutInfo + -> LayoutInfo GhcPs -> [AddEpAnn] -> P (LTyClDecl GhcPs) @@ -204,7 +204,8 @@ ; tyvars <- checkTyVars (text "class") whereDots cls tparams ; cs <- getCommentsFor (locA loc) -- Get any remaining comments ; let anns' = addAnns (EpAnn (spanAsAnchor $ locA loc) annsIn emptyComments) ann cs - ; return (L loc (ClassDecl { tcdCExt = (anns', NoAnnSortKey, layoutInfo) + ; return (L loc (ClassDecl { tcdCExt = (anns', NoAnnSortKey) + , tcdLayout = layoutInfo , tcdCtxt = mcxt , tcdLName = cls, tcdTyVars = tyvars , tcdFixity = fixity @@ -964,8 +965,7 @@ checkRuleTyVarBndrNames :: [LHsTyVarBndr flag GhcPs] -> P () checkRuleTyVarBndrNames = mapM_ (check . fmap hsTyVarName) where check (L loc (Unqual occ)) = - -- TODO: don't use string here, OccName has a Unique/FastString - when ((occNameString occ ==) `any` ["forall","family","role"]) + when (occNameFS occ `elem` [fsLit "forall",fsLit "family",fsLit "role"]) (addFatalError $ mkPlainErrorMsgEnvelope (locA loc) $ (PsErrParseErrorOnInput occ)) check _ = panic "checkRuleTyVarBndrNames" @@ -1008,7 +1008,7 @@ -- workaround to define '*' despite StarIsType go _ (HsParTy an (L l (HsStarTy _ isUni))) acc ops' cps' fix = do { addPsMessage (locA l) PsWarnStarBinder - ; let name = mkOccName tcClsName (starSym isUni) + ; let name = mkOccNameFS tcClsName (starSym isUni) ; let a' = newAnns l an ; return (L a' (Unqual name), acc, fix , (reverse ops') ++ cps') } @@ -1133,13 +1133,13 @@ -- 'ImportQualifiedPost' is not in effect. whenJust mPost $ \post -> when (not importQualifiedPostEnabled) $ - failOpNotEnabledImportQualifiedPost (RealSrcSpan (epaLocationRealSrcSpan post) Strict.Nothing) + failNotEnabledImportQualifiedPost (RealSrcSpan (epaLocationRealSrcSpan post) Strict.Nothing) -- Error if 'qualified' occurs in both pre and postpositive -- positions. whenJust mPost $ \post -> when (isJust mPre) $ - failOpImportQualifiedTwice (RealSrcSpan (epaLocationRealSrcSpan post) Strict.Nothing) + failImportQualifiedTwice (RealSrcSpan (epaLocationRealSrcSpan post) Strict.Nothing) -- Warn if 'qualified' found in prepositive position and -- 'Opt_WarnPrepositiveQualifiedModule' is enabled. @@ -2775,7 +2775,7 @@ -- want z-encoding (e.g. names with z's in them shouldn't be doubled) -- mkExtName :: RdrName -> CLabelString -mkExtName rdrNm = mkFastString (occNameString (rdrNameOcc rdrNm)) +mkExtName rdrNm = occNameFS (rdrNameOcc rdrNm) -------------------------------------------------------------------------------- -- Help with module system imports/exports @@ -2873,12 +2873,12 @@ warnPrepositiveQualifiedModule span = addPsMessage span PsWarnImportPreQualified -failOpNotEnabledImportQualifiedPost :: SrcSpan -> P () -failOpNotEnabledImportQualifiedPost loc = +failNotEnabledImportQualifiedPost :: SrcSpan -> P () +failNotEnabledImportQualifiedPost loc = addError $ mkPlainErrorMsgEnvelope loc $ PsErrImportPostQualified -failOpImportQualifiedTwice :: SrcSpan -> P () -failOpImportQualifiedTwice loc = +failImportQualifiedTwice :: SrcSpan -> P () +failImportQualifiedTwice loc = addError $ mkPlainErrorMsgEnvelope loc $ PsErrImportQualifiedTwice warnStarIsType :: SrcSpan -> P () @@ -3141,9 +3141,9 @@ ----------------------------------------------------------------------------- -- Token symbols -starSym :: Bool -> String -starSym True = "★" -starSym False = "*" +starSym :: Bool -> FastString +starSym True = fsLit "★" +starSym False = fsLit "*" ----------------------------------------- -- Bits and pieces for RecordDotSyntax. diff --git a/compiler/GHC/Parser/PostProcess/Haddock.hs b/compiler/GHC/Parser/PostProcess/Haddock.hs --- a/compiler/GHC/Parser/PostProcess/Haddock.hs +++ b/compiler/GHC/Parser/PostProcess/Haddock.hs @@ -48,7 +48,7 @@ -} module GHC.Parser.PostProcess.Haddock (addHaddockToModule) where -import GHC.Prelude hiding (head, mod) +import GHC.Prelude hiding (head, init, last, mod, tail) import GHC.Hs @@ -60,7 +60,8 @@ import Data.Foldable import Data.Traversable import Data.Maybe -import Data.List.NonEmpty (head) +import Data.List.NonEmpty (nonEmpty) +import qualified Data.List.NonEmpty as NE import Control.Monad import Control.Monad.Trans.State.Strict import Control.Monad.Trans.Reader @@ -339,7 +340,7 @@ The inputs to addHaddockInterleaveItems are: - * layout_info :: LayoutInfo + * layout_info :: LayoutInfo GhcPs In the example above, note that the indentation level inside the module is 2 spaces. It would be represented as layout_info = VirtualBraces 2. @@ -371,7 +372,7 @@ addHaddockInterleaveItems :: forall a. HasHaddock a - => LayoutInfo + => LayoutInfo GhcPs -> (PsLocated HdkComment -> Maybe a) -- Get a documentation item -> [a] -- Unprocessed (non-documentation) items -> HdkA [a] -- Documentation items & processed non-documentation items @@ -388,7 +389,7 @@ with_layout_info :: HdkA a -> HdkA a with_layout_info = case layout_info of NoLayoutInfo -> id - ExplicitBraces -> id + ExplicitBraces{} -> id VirtualBraces n -> let loc_range = mempty { loc_range_col = ColumnFrom (n+1) } in hoistHdkA (inLocRange loc_range) @@ -497,7 +498,7 @@ -- -- ^ Comment on the second method -- addHaddock (TyClD _ decl) - | ClassDecl { tcdCExt = (x, NoAnnSortKey, tcdLayout), + | ClassDecl { tcdCExt = (x, NoAnnSortKey), tcdLayout, tcdCtxt, tcdLName, tcdTyVars, tcdFixity, tcdFDs, tcdSigs, tcdMeths, tcdATs, tcdATDefs } <- decl = do @@ -508,7 +509,7 @@ flattenBindsAndSigs (tcdMeths, tcdSigs, tcdATs, tcdATDefs, [], []) pure $ let (tcdMeths', tcdSigs', tcdATs', tcdATDefs', _, tcdDocs) = partitionBindsAndSigs where_cls' - decl' = ClassDecl { tcdCExt = (x, NoAnnSortKey, tcdLayout) + decl' = ClassDecl { tcdCExt = (x, NoAnnSortKey), tcdLayout , tcdCtxt, tcdLName, tcdTyVars, tcdFixity, tcdFDs , tcdSigs = tcdSigs' , tcdMeths = tcdMeths' @@ -699,7 +700,7 @@ case con_decl of ConDeclGADT { con_g_ext, con_names, con_dcolon, con_bndrs, con_mb_cxt, con_g_args, con_res_ty } -> do -- discardHasInnerDocs is ok because we don't need this info for GADTs. - con_doc' <- discardHasInnerDocs $ getConDoc (getLocA (head con_names)) + con_doc' <- discardHasInnerDocs $ getConDoc (getLocA (NE.head con_names)) con_g_args' <- case con_g_args of PrefixConGADT ts -> PrefixConGADT <$> addHaddock ts @@ -873,13 +874,13 @@ doc <- selectDocString trailingDocs return $ L l' (con_fld { cd_fld_doc = fmap lexLHsDocString doc }) con_args' <- case con_args con_decl of - x@(PrefixCon _ []) -> x <$ reportExtraDocs trailingDocs - x@(RecCon (L _ [])) -> x <$ reportExtraDocs trailingDocs - PrefixCon _ ts -> PrefixCon noTypeArgs <$> mapLastM mk_doc_ty ts + x@(PrefixCon _ ts) -> case nonEmpty ts of + Nothing -> x <$ reportExtraDocs trailingDocs + Just ts -> PrefixCon noTypeArgs . toList <$> mapLastM mk_doc_ty ts + x@(RecCon (L l_rec flds)) -> case nonEmpty flds of + Nothing -> x <$ reportExtraDocs trailingDocs + Just flds -> RecCon . L l_rec . toList <$> mapLastM mk_doc_fld flds InfixCon t1 t2 -> InfixCon t1 <$> mk_doc_ty t2 - RecCon (L l_rec flds) -> do - flds' <- mapLastM mk_doc_fld flds - return (RecCon (L l_rec flds')) return $ L l (con_decl{ con_args = con_args' }) else do con_doc' <- selectDoc (con_doc con_decl `mcons` (map lexLHsDocString trailingDocs)) @@ -1308,10 +1309,10 @@ * * ********************************************************************* -} -mkDocHsDecl :: LayoutInfo -> PsLocated HdkComment -> Maybe (LHsDecl GhcPs) +mkDocHsDecl :: LayoutInfo GhcPs -> PsLocated HdkComment -> Maybe (LHsDecl GhcPs) mkDocHsDecl layout_info a = fmap (DocD noExtField) <$> mkDocDecl layout_info a -mkDocDecl :: LayoutInfo -> PsLocated HdkComment -> Maybe (LDocDecl GhcPs) +mkDocDecl :: LayoutInfo GhcPs -> PsLocated HdkComment -> Maybe (LDocDecl GhcPs) mkDocDecl layout_info (L l_comment hdk_comment) | indent_mismatch = Nothing | otherwise = @@ -1345,7 +1346,7 @@ -- -- ^ indent mismatch indent_mismatch = case layout_info of NoLayoutInfo -> False - ExplicitBraces -> False + ExplicitBraces{} -> False VirtualBraces n -> n /= srcSpanStartCol (psRealSpan l_comment) mkDocIE :: PsLocated HdkComment -> Maybe (LIE GhcPs) diff --git a/compiler/GHC/Runtime/Interpreter.hs b/compiler/GHC/Runtime/Interpreter.hs --- a/compiler/GHC/Runtime/Interpreter.hs +++ b/compiler/GHC/Runtime/Interpreter.hs @@ -752,7 +752,7 @@ getModBreaks :: HomeModInfo -> ModBreaks getModBreaks hmi - | Just linkable <- hm_linkable hmi, + | Just linkable <- homeModInfoByteCode hmi, [cbc] <- mapMaybe onlyBCOs $ linkableUnlinked linkable = fromMaybe emptyModBreaks (bc_breaks cbc) | otherwise diff --git a/compiler/GHC/Stg/InferTags/TagSig.hs b/compiler/GHC/Stg/InferTags/TagSig.hs --- a/compiler/GHC/Stg/InferTags/TagSig.hs +++ b/compiler/GHC/Stg/InferTags/TagSig.hs @@ -16,6 +16,7 @@ import GHC.Utils.Outputable import GHC.Utils.Binary import GHC.Utils.Panic.Plain +import Data.Coerce data TagInfo = TagDunno -- We don't know anything about the tag. @@ -64,3 +65,12 @@ isTaggedSig (TagSig TagProper) = True isTaggedSig (TagSig TagTagged) = True isTaggedSig _ = False + +seqTagSig :: TagSig -> () +seqTagSig = coerce seqTagInfo + +seqTagInfo :: TagInfo -> () +seqTagInfo TagTagged = () +seqTagInfo TagDunno = () +seqTagInfo TagProper = () +seqTagInfo (TagTuple tis) = foldl' (\_unit sig -> seqTagSig (coerce sig)) () tis diff --git a/compiler/GHC/StgToCmm/Types.hs b/compiler/GHC/StgToCmm/Types.hs --- a/compiler/GHC/StgToCmm/Types.hs +++ b/compiler/GHC/StgToCmm/Types.hs @@ -1,7 +1,7 @@ module GHC.StgToCmm.Types - ( CgInfos (..) + ( CmmCgInfos (..) , LambdaFormInfo (..) , ModuleLFInfos , StandardFormInfo (..) @@ -13,8 +13,6 @@ import GHC.Core.DataCon -import GHC.Stg.InferTags.TagSig - import GHC.Runtime.Heap.Layout import GHC.Types.Basic @@ -85,7 +83,7 @@ -- -- See also Note [Conveying CAF-info and LFInfo between modules] above. -- -data CgInfos = CgInfos +data CmmCgInfos = CmmCgInfos { cgNonCafs :: !NonCaffySet -- ^ Exported Non-CAFFY closures in the current module. Everything else is -- either not exported of CAFFY. @@ -93,7 +91,6 @@ -- ^ LambdaFormInfos of exported closures in the current module. , cgIPEStub :: !CStub -- ^ The C stub which is used for IPE information - , cgTagSigs :: !(NameEnv TagSig) } -------------------------------------------------------------------------------- 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 @@ -1,9 +1,11 @@ -{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE DataKinds #-} +{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -- instance Diagnostic TcRnMessage @@ -14,9 +16,9 @@ , tidySkolemInfo , tidySkolemInfoAnon -- - , withHsDocContext , pprHsDocContext , inHsDocContext + , TcRnMessageOpts(..) ) where @@ -94,16 +96,34 @@ import Data.Ord ( comparing ) import Data.Bifunctor import GHC.Types.Name.Env +import qualified Language.Haskell.TH as TH +data TcRnMessageOpts = TcRnMessageOpts { tcOptsShowContext :: !Bool -- ^ Whether we show the error context or not + } +defaultTcRnMessageOpts :: TcRnMessageOpts +defaultTcRnMessageOpts = TcRnMessageOpts { tcOptsShowContext = True } + + instance Diagnostic TcRnMessage where - diagnosticMessage = \case - TcRnUnknownMessage m - -> diagnosticMessage m + type DiagnosticOpts TcRnMessage = TcRnMessageOpts + defaultDiagnosticOpts = defaultTcRnMessageOpts + diagnosticMessage opts = \case + TcRnUnknownMessage (UnknownDiagnostic @e m) + -> diagnosticMessage (defaultDiagnosticOpts @e) m TcRnMessageWithInfo unit_state msg_with_info -> case msg_with_info of TcRnMessageDetailed err_info msg - -> messageWithInfoDiagnosticMessage unit_state err_info (diagnosticMessage msg) + -> messageWithInfoDiagnosticMessage unit_state err_info + (tcOptsShowContext opts) + (diagnosticMessage opts msg) + TcRnWithHsDocContext ctxt msg + -> if tcOptsShowContext opts + then main_msg `unionDecoratedSDoc` ctxt_msg + else main_msg + where + main_msg = diagnosticMessage opts msg + ctxt_msg = mkSimpleDecorated (inHsDocContext ctxt) TcRnSolverReport msg _ _ -> mkSimpleDecorated $ pprSolverReportWithCtxt msg TcRnRedundantConstraints redundants (info, show_info) @@ -177,11 +197,8 @@ -> mkSimpleDecorated $ text "Illegal use of punning for field" <+> quotes (ppr fld) TcRnIllegalWildcardsInRecord fld_part -> mkSimpleDecorated $ text "Illegal `..' in record" <+> pprRecordFieldPart fld_part - TcRnIllegalWildcardInType mb_name bad mb_ctxt - -> mkSimpleDecorated $ vcat [ main_msg, context_msg ] - where - main_msg :: SDoc - main_msg = case bad of + TcRnIllegalWildcardInType mb_name bad + -> mkSimpleDecorated $ case bad of WildcardNotLastInConstraint -> hang notAllowed 2 constraint_hint_msg ExtraConstraintWildcardNotAllowed allow_sole -> @@ -192,10 +209,7 @@ hang notAllowed 2 sole_msg WildcardsNotAllowedAtAll -> notAllowed - context_msg :: SDoc - context_msg = case mb_ctxt of - Just ctxt -> nest 2 (text "in" <+> pprHsDocContext ctxt) - _ -> empty + where notAllowed, what, wildcard, how :: SDoc notAllowed = what <+> quotes wildcard <+> how wildcard = case mb_name of @@ -350,12 +364,16 @@ 2 (text "type:" <+> quotes (ppr ty)) , hang (text "where the body of the forall has this kind:") 2 (quotes (pprKind kind)) ] - TcRnVDQInTermType ty + TcRnVDQInTermType mb_ty -> mkSimpleDecorated $ vcat - [ hang (text "Illegal visible, dependent quantification" <+> - text "in the type of a term:") - 2 (pprType ty) + [ case mb_ty of + Nothing -> main_msg + Just ty -> hang (main_msg <> char ':') 2 (pprType ty) , text "(GHC does not yet support this)" ] + where + main_msg = + text "Illegal visible, dependent quantification" <+> + text "in the type of a term" TcRnBadQuantPredHead ty -> mkSimpleDecorated $ hang (text "Quantified predicate must have a class or type variable head:") @@ -1000,13 +1018,151 @@ TcRnTypeDataForbids feature -> mkSimpleDecorated $ ppr feature <+> text "are not allowed in type data declarations." + TcRnIllegalNewtype con show_linear_types reason + -> mkSimpleDecorated $ + vcat [msg, additional] + where + (msg,additional) = + case reason of + DoesNotHaveSingleField n_flds -> + (sep [ + text "A newtype constructor must have exactly one field", + nest 2 $ + text "but" <+> quotes (ppr con) <+> text "has" <+> speakN n_flds + ], + ppr con <+> dcolon <+> ppr (dataConDisplayType show_linear_types con)) + IsNonLinear -> + (text "A newtype constructor must be linear", + ppr con <+> dcolon <+> ppr (dataConDisplayType True con)) + IsGADT -> + (text "A newtype must not be a GADT", + ppr con <+> dcolon <+> pprWithExplicitKindsWhen sneaky_eq_spec (ppr $ dataConDisplayType show_linear_types con)) + HasConstructorContext -> + (text "A newtype constructor must not have a context in its type", + ppr con <+> dcolon <+> ppr (dataConDisplayType show_linear_types con)) + HasExistentialTyVar -> + (text "A newtype constructor must not have existential type variables", + ppr con <+> dcolon <+> ppr (dataConDisplayType show_linear_types con)) + HasStrictnessAnnotation -> + (text "A newtype constructor must not have a strictness annotation", empty) + -- Is there an EqSpec involving an invisible binder? If so, print the + -- error message with explicit kinds. + invisible_binders = filter isInvisibleTyConBinder (tyConBinders $ dataConTyCon con) + sneaky_eq_spec + = any (\eq -> any (( == eqSpecTyVar eq) . binderVar) invisible_binders) + $ dataConEqSpec con + TcRnTypedTHWithPolyType ty + -> mkSimpleDecorated $ + vcat [ text "Illegal polytype:" <+> ppr ty + , text "The type of a Typed Template Haskell expression must" <+> + text "not have any quantification." ] + TcRnSpliceThrewException phase _exn exn_msg expr show_code + -> mkSimpleDecorated $ + vcat [ text "Exception when trying to" <+> text phaseStr <+> text "compile-time code:" + , nest 2 (text exn_msg) + , if show_code then text "Code:" <+> ppr expr else empty] + where phaseStr = + case phase of + SplicePhase_Run -> "run" + SplicePhase_CompileAndLink -> "compile and link" + TcRnInvalidTopDecl _decl + -> mkSimpleDecorated $ + text "Only function, value, annotation, and foreign import declarations may be added with addTopDecls" + TcRnNonExactName name + -> mkSimpleDecorated $ + hang (text "The binder" <+> quotes (ppr name) <+> text "is not a NameU.") + 2 (text "Probable cause: you used mkName instead of newName to generate a binding.") + TcRnAddInvalidCorePlugin plugin + -> mkSimpleDecorated $ + hang + (text "addCorePlugin: invalid plugin module " + <+> text (show plugin) + ) + 2 + (text "Plugins in the current package can't be specified.") + TcRnAddDocToNonLocalDefn doc_loc + -> mkSimpleDecorated $ + text "Can't add documentation to" <+> ppr_loc doc_loc <+> + text "as it isn't inside the current module" + where + ppr_loc (TH.DeclDoc n) = text $ TH.pprint n + ppr_loc (TH.ArgDoc n _) = text $ TH.pprint n + ppr_loc (TH.InstDoc t) = text $ TH.pprint t + ppr_loc TH.ModuleDoc = text "the module header" + + TcRnFailedToLookupThInstName th_type reason + -> mkSimpleDecorated $ + case reason of + NoMatchesFound -> + text "Couldn't find any instances of" + <+> text (TH.pprint th_type) + <+> text "to add documentation to" + CouldNotDetermineInstance -> + text "Couldn't work out what instance" + <+> text (TH.pprint th_type) + <+> text "is supposed to be" + TcRnCannotReifyInstance ty + -> mkSimpleDecorated $ + hang (text "reifyInstances:" <+> quotes (ppr ty)) + 2 (text "is not a class constraint or type family application") + TcRnCannotReifyOutOfScopeThing th_name + -> mkSimpleDecorated $ + quotes (text (TH.pprint th_name)) <+> + text "is not in scope at a reify" + -- Ugh! Rather an indirect way to display the name + TcRnCannotReifyThingNotInTypeEnv name + -> mkSimpleDecorated $ + quotes (ppr name) <+> text "is not in the type environment at a reify" + TcRnNoRolesAssociatedWithThing thing + -> mkSimpleDecorated $ + text "No roles associated with" <+> (ppr thing) + TcRnCannotRepresentType sort ty + -> mkSimpleDecorated $ + hsep [text "Can't represent" <+> sort_doc <+> + text "in Template Haskell:", + nest 2 (ppr ty)] + where + sort_doc = text $ + case sort of + LinearInvisibleArgument -> "linear invisible argument" + CoercionsInTypes -> "coercions in types" + TcRnRunSpliceFailure mCallingFnName (ConversionFail what reason) + -> mkSimpleDecorated + . addCallingFn + . addSpliceInfo + $ pprConversionFailReason reason + where + addCallingFn rest = + case mCallingFnName of + Nothing -> rest + Just callingFn -> + hang (text ("Error in a declaration passed to " ++ callingFn ++ ":")) + 2 rest + addSpliceInfo = case what of + ConvDec d -> addSliceInfo' "declaration" d + ConvExp e -> addSliceInfo' "expression" e + ConvPat p -> addSliceInfo' "pattern" p + ConvType t -> addSliceInfo' "type" t + addSliceInfo' what item reasonErr = reasonErr $$ descr + where + -- Show the item in pretty syntax normally, + -- but with all its constructors if you say -dppr-debug + descr = hang (text "When splicing a TH" <+> text what <> colon) + 2 (getPprDebug $ \case + True -> text (show item) + False -> text (TH.pprint item)) + TcRnReportCustomQuasiError _ msg -> mkSimpleDecorated $ text msg + TcRnInterfaceLookupError _ sdoc -> mkSimpleDecorated sdoc + diagnosticReason = \case TcRnUnknownMessage m -> diagnosticReason m TcRnMessageWithInfo _ msg_with_info -> case msg_with_info of TcRnMessageDetailed _ m -> diagnosticReason m + TcRnWithHsDocContext _ msg + -> diagnosticReason msg TcRnSolverReport _ reason _ -> reason -- Error, or a Warning if we are deferring type errors TcRnRedundantConstraints {} @@ -1334,6 +1490,38 @@ -> ErrorWithoutFlag TcRnTypeDataForbids{} -> ErrorWithoutFlag + TcRnIllegalNewtype{} + -> ErrorWithoutFlag + TcRnTypedTHWithPolyType{} + -> ErrorWithoutFlag + TcRnSpliceThrewException{} + -> ErrorWithoutFlag + TcRnInvalidTopDecl{} + -> ErrorWithoutFlag + TcRnNonExactName{} + -> ErrorWithoutFlag + TcRnAddInvalidCorePlugin{} + -> ErrorWithoutFlag + TcRnAddDocToNonLocalDefn{} + -> ErrorWithoutFlag + TcRnFailedToLookupThInstName{} + -> ErrorWithoutFlag + TcRnCannotReifyInstance{} + -> ErrorWithoutFlag + TcRnCannotReifyOutOfScopeThing{} + -> ErrorWithoutFlag + TcRnCannotReifyThingNotInTypeEnv{} + -> ErrorWithoutFlag + TcRnNoRolesAssociatedWithThing{} + -> ErrorWithoutFlag + TcRnCannotRepresentType{} + -> ErrorWithoutFlag + TcRnRunSpliceFailure{} + -> ErrorWithoutFlag + TcRnReportCustomQuasiError isError _ + -> if isError then ErrorWithoutFlag else WarningWithoutFlag + TcRnInterfaceLookupError{} + -> ErrorWithoutFlag diagnosticHints = \case TcRnUnknownMessage m @@ -1341,6 +1529,8 @@ TcRnMessageWithInfo _ msg_with_info -> case msg_with_info of TcRnMessageDetailed _ m -> diagnosticHints m + TcRnWithHsDocContext _ msg + -> diagnosticHints msg TcRnSolverReport _ _ hints -> hints TcRnRedundantConstraints{} @@ -1670,10 +1860,41 @@ -> [suggestExtension LangExt.TypeData] TcRnTypeDataForbids{} -> noHints + TcRnIllegalNewtype{} + -> noHints + TcRnTypedTHWithPolyType{} + -> noHints + TcRnSpliceThrewException{} + -> noHints + TcRnInvalidTopDecl{} + -> noHints + TcRnNonExactName{} + -> noHints + TcRnAddInvalidCorePlugin{} + -> noHints + TcRnAddDocToNonLocalDefn{} + -> noHints + TcRnFailedToLookupThInstName{} + -> noHints + TcRnCannotReifyInstance{} + -> noHints + TcRnCannotReifyOutOfScopeThing{} + -> noHints + TcRnCannotReifyThingNotInTypeEnv{} + -> noHints + TcRnNoRolesAssociatedWithThing{} + -> noHints + TcRnCannotRepresentType{} + -> noHints + TcRnRunSpliceFailure{} + -> noHints + TcRnReportCustomQuasiError{} + -> noHints + TcRnInterfaceLookupError{} + -> noHints diagnosticCode = constructorCode - -- | Change [x] to "x", [x, y] to "x and y", [x, y, z] to "x, y, and z", -- and so on. The `and` stands for any `conjunction`, which is passed in. commafyWith :: SDoc -> [SDoc] -> [SDoc] @@ -1768,10 +1989,11 @@ messageWithInfoDiagnosticMessage :: UnitState -> ErrInfo + -> Bool -> DecoratedSDoc -> DecoratedSDoc -messageWithInfoDiagnosticMessage unit_state ErrInfo{..} important = - let err_info' = map (pprWithUnitState unit_state) [errInfoContext, errInfoSupplementary] +messageWithInfoDiagnosticMessage unit_state ErrInfo{..} show_ctxt important = + let err_info' = map (pprWithUnitState unit_state) ([errInfoContext | show_ctxt] ++ [errInfoSupplementary]) in (mapDecoratedSDoc (pprWithUnitState unit_state) important) `unionDecoratedSDoc` mkDecorated err_info' @@ -2327,8 +2549,8 @@ sep [text "Matching givens (or their superclasses):" , nest 2 (vcat matching_givens)] , potentialInstancesErrMsg - (PotentialInstances { matches, unifiers }) - , ppWhen (null matching_givens && isSingleton matches && null unifiers) $ + (PotentialInstances { matches = NE.toList matches, unifiers }) + , ppWhen (null matching_givens && null (NE.tail matches) && null unifiers) $ -- Intuitively, some given matched the wanted in their -- flattened or rewritten (from given equalities) form -- but the matcher can't figure that out because the @@ -2338,7 +2560,7 @@ sep [ text "There exists a (perhaps superclass) match:" , nest 2 (vcat (pp_givens useful_givens))] - , ppWhen (isSingleton matches) $ + , ppWhen (null $ NE.tail matches) $ parens (vcat [ ppUnless (null tyCoVars) $ text "The choice depends on the instantiation of" <+> quotes (pprWithCommas ppr tyCoVars) @@ -2379,16 +2601,16 @@ Just (clas', tys') -> clas' == clas && isJust (tcMatchTys tys tys') Nothing -> False -pprTcSolverReportMsg _ (UnsafeOverlap item matches unsafe_overlapped) = +pprTcSolverReportMsg _ (UnsafeOverlap item match unsafe_overlapped) = vcat [ addArising ct_loc (text "Unsafe overlapping instances for" <+> pprType (mkClassPred clas tys)) , sep [text "The matching instance is:", - nest 2 (pprInstance $ head matches)] + nest 2 (pprInstance match)] , vcat [ text "It is compiled in a Safe module and as such can only" , text "overlap instances from the same module, however it" , text "overlaps the following instances from different" <+> text "modules:" - , nest 2 (vcat [pprInstances $ unsafe_overlapped]) + , nest 2 (vcat [pprInstances $ NE.toList unsafe_overlapped]) ] ] where @@ -3526,9 +3748,6 @@ ************************************************************************ -} -withHsDocContext :: HsDocContext -> SDoc -> SDoc -withHsDocContext ctxt doc = doc $$ inHsDocContext ctxt - inHsDocContext :: HsDocContext -> SDoc inHsDocContext ctxt = text "In" <+> pprHsDocContext ctxt @@ -3560,3 +3779,79 @@ = text "the definition of data constructor" <+> quotes (ppr name) pprHsDocContext (ConDeclCtx names) = text "the definition of data constructors" <+> interpp'SP names + +pprConversionFailReason :: ConversionFailReason -> SDoc +pprConversionFailReason = \case + IllegalOccName ctxt_ns occ -> + text "Illegal" <+> pprNameSpace ctxt_ns + <+> text "name:" <+> quotes (text occ) + SumAltArityExceeded alt arity -> + text "Sum alternative" <+> int alt + <+> text "exceeds its arity," <+> int arity + IllegalSumAlt alt -> + vcat [ text "Illegal sum alternative:" <+> int alt + , nest 2 $ text "Sum alternatives must start from 1" ] + IllegalSumArity arity -> + vcat [ text "Illegal sum arity:" <+> int arity + , nest 2 $ text "Sums must have an arity of at least 2" ] + MalformedType typeOrKind ty -> + text "Malformed " <> text ty_str <+> text (show ty) + where ty_str = case typeOrKind of + TypeLevel -> "type" + KindLevel -> "kind" + IllegalLastStatement do_or_lc stmt -> + vcat [ text "Illegal last statement of" <+> pprAHsDoFlavour do_or_lc <> colon + , nest 2 $ ppr stmt + , text "(It should be an expression.)" ] + KindSigsOnlyAllowedOnGADTs -> + text "Kind signatures are only allowed on GADTs" + IllegalDeclaration declDescr bad_decls -> + sep [ text "Illegal" <+> what <+> text "in" <+> descrDoc <> colon + , nest 2 bads ] + where + (what, bads) = case bad_decls of + IllegalDecls (NE.toList -> decls) -> + (text "declaration" <> plural decls, vcat $ map ppr decls) + IllegalFamDecls (NE.toList -> decls) -> + ( text "family declaration" <> plural decls, vcat $ map ppr decls) + descrDoc = text $ case declDescr of + InstanceDecl -> "an instance declaration" + WhereClause -> "a where clause" + LetBinding -> "a let expression" + LetExpression -> "a let expression" + ClssDecl -> "a class declaration" + CannotMixGADTConsWith98Cons -> + text "Cannot mix GADT constructors with Haskell 98" + <+> text "constructors" + EmptyStmtListInDoBlock -> + text "Empty stmt list in do-block" + NonVarInInfixExpr -> + text "Non-variable expression is not allowed in an infix expression" + MultiWayIfWithoutAlts -> + text "Multi-way if-expression with no alternatives" + CasesExprWithoutAlts -> + text "\\cases expression with no alternatives" + ImplicitParamsWithOtherBinds -> + text "Implicit parameters mixed with other bindings" + InvalidCCallImpent from -> + text (show from) <+> text "is not a valid ccall impent" + RecGadtNoCons -> + text "RecGadtC must have at least one constructor name" + GadtNoCons -> + text "GadtC must have at least one constructor name" + InvalidTypeInstanceHeader tys -> + text "Invalid type instance header:" + <+> text (show tys) + InvalidTyFamInstLHS lhs -> + text "Invalid type family instance LHS:" + <+> text (show lhs) + InvalidImplicitParamBinding -> + text "Implicit parameter binding only allowed in let or where" + DefaultDataInstDecl adts -> + (text "Default data instance declarations" + <+> text "are not allowed:") + $$ ppr adts + FunBindLacksEquations nm -> + text "Function binding for" + <+> quotes (text (TH.pprint nm)) + <+> text "has no equations" 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 @@ -13,6 +13,7 @@ , pprFixedRuntimeRepProvenance , ShadowedNameProvenance(..) , RecordFieldPart(..) + , IllegalNewtypeReason(..) , InjectivityErrReason(..) , HasKinds(..) , hasKinds @@ -76,6 +77,14 @@ , ExpectedBackends , ArgOrResult(..) , MatchArgsContext(..), MatchArgBadMatches(..) + , ConversionFailReason(..) + , UnrepresentableTypeDescr(..) + , LookupTHInstNameErrReason(..) + , SplicePhase(..) + , THDeclDescriptor(..) + , RunSpliceFailReason(..) + , ThingBeingConverted(..) + , IllegalDecls(..) ) where import GHC.Prelude @@ -94,6 +103,7 @@ import GHC.Types.Hint (UntickedPromotedThing(..)) import GHC.Types.ForeignCall (CLabelString) import GHC.Types.Name (Name, OccName, getSrcLoc, getSrcSpan) +import qualified GHC.Types.Name.Occurrence as OccName import GHC.Types.Name.Reader import GHC.Types.SrcLoc import GHC.Types.TyThing (TyThing) @@ -118,12 +128,14 @@ import GHC.Utils.Misc (capitalise, filterOut) import qualified GHC.LanguageExtensions as LangExt import GHC.Data.FastString (FastString) +import GHC.Exception.Type (SomeException) import Language.Haskell.Syntax.Basic (FieldLabelString(..)) import qualified Data.List.NonEmpty as NE import Data.Typeable (Typeable) import GHC.Unit.Module.Warnings (WarningTxt) +import qualified Language.Haskell.TH.Syntax as TH import GHC.Generics ( Generic ) @@ -181,12 +193,13 @@ !TcRnMessage deriving Generic -mkTcRnUnknownMessage :: (Diagnostic a, Typeable a) => a -> TcRnMessage +mkTcRnUnknownMessage :: (Diagnostic a, Typeable a, DiagnosticOpts a ~ NoDiagnosticOpts) + => a -> TcRnMessage mkTcRnUnknownMessage diag = TcRnUnknownMessage (UnknownDiagnostic diag) -- | An error which might arise during typechecking/renaming. data TcRnMessage where - {-| Simply wraps a generic 'Diagnostic' message @a@. It can be used by plugins + {-| Simply wraps an unknown 'Diagnostic' message @a@. It can be used by plugins to provide custom diagnostic messages originated during typechecking/renaming. -} TcRnUnknownMessage :: UnknownDiagnostic -> TcRnMessage @@ -203,6 +216,13 @@ -> !TcRnMessageDetailed -> TcRnMessage + {-| TcRnWithHsDocContext annotates an error message with the context in which + it originated. + -} + TcRnWithHsDocContext :: !HsDocContext + -> !TcRnMessage + -> TcRnMessage + {-| TcRnSolverReport is the constructor used to report unsolved constraints after constraint solving, as well as other errors such as hole fit errors. @@ -526,7 +546,6 @@ :: Maybe Name -- ^ the wildcard name, or 'Nothing' for an anonymous wildcard -> !BadAnonWildcardContext - -> !(Maybe HsDocContext) -> TcRnMessage @@ -896,7 +915,7 @@ dependent/should_fail/T17687 dependent/should_fail/T18271 -} - TcRnVDQInTermType :: !Type -> TcRnMessage + TcRnVDQInTermType :: !(Maybe Type) -> TcRnMessage {-| TcRnBadQuantPredHead is an error that occurs whenever a quantified predicate lacks a class or type variable head. @@ -2288,7 +2307,35 @@ TcRnNoExplicitAssocTypeOrDefaultDeclaration :: Name -> TcRnMessage + {-| TcRnIllegalNewtype is an error that occurs when a newtype: + * Does not have exactly one field, or + * is non-linear, or + * is a GADT, or + * has a context in its constructor's type, or + * has existential type variables in its constructor's type, or + * has strictness annotations. + + Test cases: + testsuite/tests/gadt/T14719 + testsuite/tests/indexed-types/should_fail/T14033 + testsuite/tests/indexed-types/should_fail/T2334A + testsuite/tests/linear/should_fail/LinearGADTNewtype + testsuite/tests/parser/should_fail/readFail008 + testsuite/tests/polykinds/T11459 + testsuite/tests/typecheck/should_fail/T15523 + testsuite/tests/typecheck/should_fail/T15796 + testsuite/tests/typecheck/should_fail/T17955 + testsuite/tests/typecheck/should_fail/T18891a + testsuite/tests/typecheck/should_fail/T21447 + testsuite/tests/typecheck/should_fail/tcfail156 + -} + TcRnIllegalNewtype + :: DataCon + -> Bool -- ^ True if linear types enabled + -> IllegalNewtypeReason + -> TcRnMessage + {-| TcRnIllegalTypeData is an error that occurs when a @type data@ declaration occurs without the TypeOperators extension. @@ -2314,6 +2361,190 @@ -} TcRnTypeDataForbids :: !TypeDataForbids -> TcRnMessage + {-| TcRnTypedTHWithPolyType is an error that signifies the illegal use + of a polytype in a typed template haskell expression. + + Example(s): + bad :: (forall a. a -> a) -> () + bad = $$( [|| \_ -> () ||] ) + + Test cases: th/T11452 + -} + TcRnTypedTHWithPolyType :: !TcType -> TcRnMessage + + {-| TcRnSpliceThrewException is an error that occurrs when running a template + haskell splice throws an exception. + + Example(s): + + Test cases: annotations/should_fail/annfail12 + perf/compiler/MultiLayerModulesTH_Make + perf/compiler/MultiLayerModulesTH_OneShot + th/T10796b + th/T19470 + th/T19709d + th/T5358 + th/T5976 + th/T7276a + th/T8987 + th/TH_exn1 + th/TH_exn2 + th/TH_runIO + -} + TcRnSpliceThrewException + :: !SplicePhase + -> !SomeException + -> !String -- ^ Result of showing the exception (cannot be done safely outside IO) + -> !(LHsExpr GhcTc) + -> !Bool -- True <=> Print the expression + -> TcRnMessage + + {-| TcRnInvalidTopDecl is a template haskell error occurring when one of the 'Dec's passed to + 'addTopDecls' is not a function, value, annotation, or foreign import declaration. + + Example(s): + + Test cases: + -} + TcRnInvalidTopDecl :: !(HsDecl GhcPs) -> TcRnMessage + + {-| TcRnNonExactName is a template haskell error for when a declaration being + added is bound to a name that is not fully known. + + Example(s): + + Test cases: + -} + TcRnNonExactName :: !RdrName -> TcRnMessage + + {-| TcRnAddInvalidCorePlugin is a template haskell error indicating that a + core plugin being added has an invalid module due to being in the current package. + + Example(s): + + Test cases: + -} + TcRnAddInvalidCorePlugin + :: !String -- ^ Module name + -> TcRnMessage + + {-| TcRnAddDocToNonLocalDefn is a template haskell error for documentation being added to a + definition which is not in the current module. + + Example(s): + + Test cases: showIface/should_fail/THPutDocExternal + -} + TcRnAddDocToNonLocalDefn :: !TH.DocLoc -> TcRnMessage + + {-| TcRnFailedToLookupThInstName is a template haskell error that occurrs when looking up an + instance fails. + + Example(s): + + Test cases: showIface/should_fail/THPutDocNonExistent + -} + TcRnFailedToLookupThInstName :: !TH.Type -> !LookupTHInstNameErrReason -> TcRnMessage + + {-| TcRnCannotReifyInstance is a template haskell error for when an instance being reified + via `reifyInstances` is not a class constraint or type family application. + + Example(s): + + Test cases: + -} + TcRnCannotReifyInstance :: !Type -> TcRnMessage + + {-| TcRnCannotReifyOutOfScopeThing is a template haskell error indicating + that the given name is not in scope and therefore cannot be reified. + + Example(s): + + Test cases: th/T16976f + -} + TcRnCannotReifyOutOfScopeThing :: !TH.Name -> TcRnMessage + + {-| TcRnCannotReifyThingNotInTypeEnv is a template haskell error occurring + when the given name is not in the type environment and therefore cannot be reified. + + Example(s): + + Test cases: + -} + TcRnCannotReifyThingNotInTypeEnv :: !Name -> TcRnMessage + + {-| TcRnNoRolesAssociatedWithName is a template haskell error for when the user + tries to reify the roles of a given name but it is not something that has + roles associated with it. + + Example(s): + + Test cases: + -} + TcRnNoRolesAssociatedWithThing :: !TcTyThing -> TcRnMessage + + {-| TcRnCannotRepresentThing is a template haskell error indicating that a + type cannot be reified because it does not have a representation in template haskell. + + Example(s): + + Test cases: + -} + TcRnCannotRepresentType :: !UnrepresentableTypeDescr -> !Type -> TcRnMessage + + {-| TcRnRunSpliceFailure is an error indicating that a template haskell splice + failed to be converted into a valid expression. + + Example(s): + + Test cases: th/T10828a + th/T10828b + th/T12478_4 + th/T15270A + th/T15270B + th/T16895a + th/T16895b + th/T16895c + th/T16895d + th/T16895e + th/T17379a + th/T17379b + th/T18740d + th/T2597b + th/T2674 + th/T3395 + th/T7484 + th/T7667a + th/TH_implicitParamsErr1 + th/TH_implicitParamsErr2 + th/TH_implicitParamsErr3 + th/TH_invalid_add_top_decl + -} + TcRnRunSpliceFailure + :: !(Maybe String) -- ^ Name of the function used to run the splice + -> !RunSpliceFailReason + -> TcRnMessage + + {-| TcRnUserErrReported is an error or warning thrown using 'qReport' from + the 'Quasi' instance of 'TcM'. + + Example(s): + + Test cases: + -} + TcRnReportCustomQuasiError + :: !Bool -- True => Error, False => Warning + -> !String -- Error body + -> TcRnMessage + + {-| TcRnInterfaceLookupError is an error resulting from looking up a name in an interface file. + + Example(s): + + Test cases: + -} + TcRnInterfaceLookupError :: !Name -> !SDoc -> TcRnMessage + deriving Generic -- | Things forbidden in @type data@ declarations. @@ -2331,8 +2562,58 @@ ppr TypeDataForbidsStrictnessAnnotations = text "Strictness flags" ppr TypeDataForbidsDerivingClauses = text "Deriving clauses" +data RunSpliceFailReason + = ConversionFail !ThingBeingConverted !ConversionFailReason + deriving Generic + +-- | Identifies the TH splice attempting to be converted +data ThingBeingConverted + = ConvDec !TH.Dec + | ConvExp !TH.Exp + | ConvPat !TH.Pat + | ConvType !TH.Type + +-- | The reason a TH splice could not be converted to a Haskell expression +data ConversionFailReason + = IllegalOccName !OccName.NameSpace !String + | SumAltArityExceeded !TH.SumAlt !TH.SumArity + | IllegalSumAlt !TH.SumAlt + | IllegalSumArity !TH.SumArity + | MalformedType !TypeOrKind !TH.Type + | IllegalLastStatement !HsDoFlavour !(LStmt GhcPs (LHsExpr GhcPs)) + | KindSigsOnlyAllowedOnGADTs + | IllegalDeclaration !THDeclDescriptor !IllegalDecls + | CannotMixGADTConsWith98Cons + | EmptyStmtListInDoBlock + | NonVarInInfixExpr + | MultiWayIfWithoutAlts + | CasesExprWithoutAlts + | ImplicitParamsWithOtherBinds + | InvalidCCallImpent !String -- ^ Source + | RecGadtNoCons + | GadtNoCons + | InvalidTypeInstanceHeader !TH.Type + | InvalidTyFamInstLHS !TH.Type + | InvalidImplicitParamBinding + | DefaultDataInstDecl ![LDataFamInstDecl GhcPs] + | FunBindLacksEquations !TH.Name + deriving Generic + +data IllegalDecls + = IllegalDecls !(NE.NonEmpty (LHsDecl GhcPs)) + | IllegalFamDecls !(NE.NonEmpty (LFamilyDecl GhcPs)) + +-- | Label for a TH declaration +data THDeclDescriptor + = InstanceDecl + | WhereClause + | LetBinding + | LetExpression + | ClssDecl + -- | Specifies which back ends can handle a requested foreign import or export type ExpectedBackends = [Backend] + -- | Specifies which calling convention is unsupported on the current platform data UnsupportedCallConvention = StdCallConvUnsupported @@ -2384,6 +2665,17 @@ pprFixedRuntimeRepProvenance FixedRuntimeRepPatSynSigArg = text "pattern synonym argument" pprFixedRuntimeRepProvenance FixedRuntimeRepPatSynSigRes = text "pattern synonym scrutinee" +-- | Why the particular illegal newtype error arose together with more +-- information, if any. +data IllegalNewtypeReason + = DoesNotHaveSingleField !Int + | IsNonLinear + | IsGADT + | HasConstructorContext + | HasExistentialTyVar + | HasStrictnessAnnotation + deriving Generic + -- | Why the particular injectivity error arose together with more information, -- if any. data InjectivityErrReason @@ -2986,7 +3278,7 @@ -- Test cases: tcfail118, tcfail121, tcfail218. | OverlappingInstances { overlappingInstances_item :: ErrorItem - , overlappingInstances_matches :: [ClsInst] + , overlappingInstances_matches :: NE.NonEmpty ClsInst , overlappingInstances_unifiers :: [ClsInst] } -- | Could not solve a constraint from instances because @@ -2996,8 +3288,8 @@ -- Test cases: SH_Overlap{1,2,5,6,7,11}. | UnsafeOverlap { unsafeOverlap_item :: ErrorItem - , unsafeOverlap_matches :: [ClsInst] - , unsafeOverlapped :: [ClsInst] } + , unsafeOverlap_match :: ClsInst + , unsafeOverlapped :: NE.NonEmpty ClsInst } deriving Generic @@ -3431,3 +3723,16 @@ :: { matchArgFirstMatch :: LocatedA (Match GhcRn body) , matchArgBadMatches :: NE.NonEmpty (LocatedA (Match GhcRn body)) } -> MatchArgBadMatches + +-- | The phase in which an exception was encountered when dealing with a TH splice +data SplicePhase + = SplicePhase_Run + | SplicePhase_CompileAndLink + +data LookupTHInstNameErrReason + = NoMatchesFound + | CouldNotDetermineInstance + +data UnrepresentableTypeDescr + = LinearInvisibleArgument + | CoercionsInTypes diff --git a/compiler/GHC/Tc/Types/Constraint.hs b/compiler/GHC/Tc/Types/Constraint.hs --- a/compiler/GHC/Tc/Types/Constraint.hs +++ b/compiler/GHC/Tc/Types/Constraint.hs @@ -235,7 +235,8 @@ -- * (TyEq:F) rhs has no foralls -- (this avoids substituting a forall for the tyvar in other types) -- * (TyEq:K) tcTypeKind lhs `tcEqKind` tcTypeKind rhs; Note [Ct kind invariant] - -- * (TyEq:N) If the equality is representational, rhs has no top-level newtype + -- * (TyEq:N) If the equality is representational, rhs is not headed by a saturated + -- application of a newtype TyCon. -- See Note [No top-level newtypes on RHS of representational equalities] -- in GHC.Tc.Solver.Canonical. (Applies only when constructor of newtype is -- in scope.) 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 @@ -428,7 +428,7 @@ - Flag tcTyConIsPoly = True; this is used only to short-cut zonking - tyConBinders are still TcTyConBinders, but they are /skolem/ TcTyVars, - with fixed kinds: no unification variables here + with fixed kinds, and accurate skolem info: no unification variables here tyConBinders includes the Inferred binders if any diff --git a/compiler/GHC/Types/CostCentre.hs b/compiler/GHC/Types/CostCentre.hs --- a/compiler/GHC/Types/CostCentre.hs +++ b/compiler/GHC/Types/CostCentre.hs @@ -259,7 +259,7 @@ ppr cc = getPprStyle $ \ sty -> if codeStyle sty then ppCostCentreLbl cc - else text (costCentreUserName cc) + else ftext (costCentreUserNameFS cc) -- Printing in Core pprCostCentreCore :: CostCentre -> SDoc 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 @@ -4,6 +4,9 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE TypeApplications #-} module GHC.Types.Error ( -- * Messages @@ -32,6 +35,8 @@ , mkDecoratedDiagnostic , mkDecoratedError + , NoDiagnosticOpts(..) + -- * Hints and refactoring actions , GhcHint (..) , AvailableBindings(..) @@ -211,11 +216,16 @@ -- GHC's case, it can be an error or a warning) and the /reason/ why such -- message was generated in the first place. class Diagnostic a where + + -- | Type of configuration options for the diagnostic. + type DiagnosticOpts a + defaultDiagnosticOpts :: DiagnosticOpts a + -- | Extract the error message text from a 'Diagnostic'. - diagnosticMessage :: a -> DecoratedSDoc + diagnosticMessage :: DiagnosticOpts a -> a -> DecoratedSDoc -- | Extract the reason for this diagnostic. For warnings, - -- a 'DiagnosticReason' includes the warning flag + -- a 'DiagnosticReason' includes the warning flag. diagnosticReason :: a -> DiagnosticReason -- | Extract any hints a user might use to repair their @@ -238,17 +248,25 @@ -- | An existential wrapper around an unknown diagnostic. data UnknownDiagnostic where - UnknownDiagnostic :: (Typeable diag, Diagnostic diag) => diag -> UnknownDiagnostic + UnknownDiagnostic :: (DiagnosticOpts a ~ NoDiagnosticOpts, Diagnostic a, Typeable a) + => a -> UnknownDiagnostic instance Diagnostic UnknownDiagnostic where - diagnosticMessage (UnknownDiagnostic diag) = diagnosticMessage diag - diagnosticReason (UnknownDiagnostic diag) = diagnosticReason diag - diagnosticHints (UnknownDiagnostic diag) = diagnosticHints diag - diagnosticCode (UnknownDiagnostic diag) = diagnosticCode diag + type DiagnosticOpts UnknownDiagnostic = NoDiagnosticOpts + defaultDiagnosticOpts = NoDiagnosticOpts + diagnosticMessage _ (UnknownDiagnostic diag) = diagnosticMessage NoDiagnosticOpts diag + diagnosticReason (UnknownDiagnostic diag) = diagnosticReason diag + diagnosticHints (UnknownDiagnostic diag) = diagnosticHints diag + diagnosticCode (UnknownDiagnostic diag) = diagnosticCode diag -pprDiagnostic :: Diagnostic e => e -> SDoc +-- A fallback 'DiagnosticOpts' which can be used when there are no options +-- for a particular diagnostic. +data NoDiagnosticOpts = NoDiagnosticOpts + +pprDiagnostic :: forall e . Diagnostic e => e -> SDoc pprDiagnostic e = vcat [ ppr (diagnosticReason e) - , nest 2 (vcat (unDecorated (diagnosticMessage e))) ] + , nest 2 (vcat (unDecorated (diagnosticMessage opts e))) ] + where opts = defaultDiagnosticOpts @e -- | A generic 'Hint' message, to be used with 'DiagnosticMessage'. data DiagnosticHint = DiagnosticHint !SDoc @@ -268,7 +286,9 @@ } instance Diagnostic DiagnosticMessage where - diagnosticMessage = diagMessage + type DiagnosticOpts DiagnosticMessage = NoDiagnosticOpts + defaultDiagnosticOpts = NoDiagnosticOpts + diagnosticMessage _ = diagMessage diagnosticReason = diagReason diagnosticHints = diagHints diagnosticCode _ = Nothing @@ -429,10 +449,10 @@ instance Show (MsgEnvelope DiagnosticMessage) where show = showMsgEnvelope --- | Shows an 'MsgEnvelope'. -showMsgEnvelope :: Diagnostic a => MsgEnvelope a -> String +-- | Shows an 'MsgEnvelope'. Only use this for debugging. +showMsgEnvelope :: forall a . Diagnostic a => MsgEnvelope a -> String showMsgEnvelope err = - renderWithContext defaultSDocContext (vcat (unDecorated . diagnosticMessage $ errMsgDiagnostic err)) + renderWithContext defaultSDocContext (vcat (unDecorated . (diagnosticMessage (defaultDiagnosticOpts @a)) $ errMsgDiagnostic err)) pprMessageBag :: Bag SDoc -> SDoc pprMessageBag msgs = vcat (punctuate blankLine (bagToList msgs)) diff --git a/compiler/GHC/Types/Error/Codes.hs b/compiler/GHC/Types/Error/Codes.hs --- a/compiler/GHC/Types/Error/Codes.hs +++ b/compiler/GHC/Types/Error/Codes.hs @@ -468,11 +468,57 @@ GhcDiagnosticCode "TcRnNoExplicitAssocTypeOrDefaultDeclaration" = 08585 GhcDiagnosticCode "TcRnIllegalTypeData" = 15013 GhcDiagnosticCode "TcRnTypeDataForbids" = 67297 + GhcDiagnosticCode "TcRnTypedTHWithPolyType" = 94642 + GhcDiagnosticCode "TcRnSpliceThrewException" = 87897 + GhcDiagnosticCode "TcRnInvalidTopDecl" = 52886 + GhcDiagnosticCode "TcRnNonExactName" = 77923 + GhcDiagnosticCode "TcRnAddInvalidCorePlugin" = 86463 + GhcDiagnosticCode "TcRnAddDocToNonLocalDefn" = 67760 + GhcDiagnosticCode "TcRnFailedToLookupThInstName" = 49530 + GhcDiagnosticCode "TcRnCannotReifyInstance" = 30384 + GhcDiagnosticCode "TcRnCannotReifyOutOfScopeThing" = 24922 + GhcDiagnosticCode "TcRnCannotReifyThingNotInTypeEnv" = 79890 + GhcDiagnosticCode "TcRnNoRolesAssociatedWithThing" = 65923 + GhcDiagnosticCode "TcRnCannotRepresentType" = 75721 + GhcDiagnosticCode "TcRnReportCustomQuasiError" = 39584 + GhcDiagnosticCode "TcRnInterfaceLookupError" = 52243 + -- IllegalNewtypeReason + GhcDiagnosticCode "DoesNotHaveSingleField" = 23517 + GhcDiagnosticCode "IsNonLinear" = 38291 + GhcDiagnosticCode "IsGADT" = 89498 + GhcDiagnosticCode "HasConstructorContext" = 17440 + GhcDiagnosticCode "HasExistentialTyVar" = 07525 + GhcDiagnosticCode "HasStrictnessAnnotation" = 04049 + -- TcRnPragmaWarning GhcDiagnosticCode "WarningTxt" = 63394 GhcDiagnosticCode "DeprecatedTxt" = 68441 + -- TcRnRunSliceFailure/ConversionFail + GhcDiagnosticCode "IllegalOccName" = 55017 + GhcDiagnosticCode "SumAltArityExceeded" = 68444 + GhcDiagnosticCode "IllegalSumAlt" = 63966 + GhcDiagnosticCode "IllegalSumArity" = 97721 + GhcDiagnosticCode "MalformedType" = 28709 + GhcDiagnosticCode "IllegalLastStatement" = 47373 + GhcDiagnosticCode "KindSigsOnlyAllowedOnGADTs" = 40746 + GhcDiagnosticCode "IllegalDeclaration" = 23882 + GhcDiagnosticCode "CannotMixGADTConsWith98Cons" = 24104 + GhcDiagnosticCode "EmptyStmtListInDoBlock" = 34949 + GhcDiagnosticCode "NonVarInInfixExpr" = 99831 + GhcDiagnosticCode "MultiWayIfWithoutAlts" = 63930 + GhcDiagnosticCode "CasesExprWithoutAlts" = 91745 + GhcDiagnosticCode "ImplicitParamsWithOtherBinds" = 42974 + GhcDiagnosticCode "InvalidCCallImpent" = 60220 + GhcDiagnosticCode "RecGadtNoCons" = 18816 + GhcDiagnosticCode "GadtNoCons" = 38140 + GhcDiagnosticCode "InvalidTypeInstanceHeader" = 37056 + GhcDiagnosticCode "InvalidTyFamInstLHS" = 78486 + GhcDiagnosticCode "InvalidImplicitParamBinding" = 51603 + GhcDiagnosticCode "DefaultDataInstDecl" = 39639 + GhcDiagnosticCode "FunBindLacksEquations" = 52078 + -- Diagnostic codes for the foreign function interface GhcDiagnosticCode "NotADataType" = 31136 GhcDiagnosticCode "NewtypeDataConNotInScope" = 72317 @@ -583,10 +629,18 @@ -- Recur into TcRnMessageWithInfo to get the underlying TcRnMessage ConRecursInto "TcRnMessageWithInfo" = 'Just TcRnMessageDetailed ConRecursInto "TcRnMessageDetailed" = 'Just TcRnMessage + ConRecursInto "TcRnWithHsDocContext" = 'Just TcRnMessage ConRecursInto "TcRnCannotDeriveInstance" = 'Just DeriveInstanceErrReason ConRecursInto "TcRnPragmaWarning" = 'Just (WarningTxt GhcRn) ConRecursInto "TcRnNotInScope" = 'Just NotInScopeError + ConRecursInto "TcRnIllegalNewtype" = 'Just IllegalNewtypeReason + + -- + -- TH errors + + ConRecursInto "TcRnRunSpliceFailure" = 'Just RunSpliceFailReason + ConRecursInto "ConversionFail" = 'Just ConversionFailReason ------------------ -- FFI errors diff --git a/compiler/GHC/Types/FieldLabel.hs b/compiler/GHC/Types/FieldLabel.hs --- a/compiler/GHC/Types/FieldLabel.hs +++ b/compiler/GHC/Types/FieldLabel.hs @@ -188,7 +188,7 @@ | otherwise = mkVarOccFS fl where fl = field_label lbl - str = ":" ++ unpackFS fl ++ ":" ++ occNameString dc + str = concatFS [fsLit ":", fl, fsLit ":", occNameFS dc] -- | Undo the name mangling described in Note [FieldLabel] to produce a Name -- that has the user-visible OccName (but the selector's unique). This should diff --git a/compiler/GHC/Types/ForeignCall.hs b/compiler/GHC/Types/ForeignCall.hs --- a/compiler/GHC/Types/ForeignCall.hs +++ b/compiler/GHC/Types/ForeignCall.hs @@ -219,8 +219,8 @@ | otherwise = text "_unsafe" ppr_fun (StaticTarget st lbl mPkgId isFun) - = text (if isFun then "__ffi_static_ccall" - else "__ffi_static_ccall_value") + = (if isFun then text "__ffi_static_ccall" + else text "__ffi_static_ccall_value") <> gc_suf <+> (case mPkgId of Nothing -> empty diff --git a/compiler/GHC/Types/ForeignStubs.hs b/compiler/GHC/Types/ForeignStubs.hs --- a/compiler/GHC/Types/ForeignStubs.hs +++ b/compiler/GHC/Types/ForeignStubs.hs @@ -44,7 +44,7 @@ where body' = vcat [ declarations - , hsep [text "void", pprCLabel platform CStyle clbl, text "(void)"] + , hsep [text "void", pprCLabel platform clbl, text "(void)"] , braces body ] 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 @@ -477,9 +477,9 @@ -- See Note [Type classes and linear types] base_info = noCafIdInfo - `setArityInfo` 1 - `setDmdSigInfo` strict_sig - `setCprSigInfo` topCprSig + `setArityInfo` 1 + `setDmdSigInfo` strict_sig + `setCprSigInfo` topCprSig info | new_tycon = base_info `setInlinePragInfo` alwaysInlinePragma @@ -697,6 +697,8 @@ -- does not tidy the IdInfo of implicit bindings (like the wrapper) -- so it not make sure that the CAF info is sane + -- The signature is purely for passes like the Simplifier, not for + -- DmdAnal itself; see Note [DmdAnal for DataCon wrappers]. wrap_sig = mkClosedDmdSig wrap_arg_dmds topDiv wrap_arg_dmds = @@ -1321,9 +1323,9 @@ name = mkFCallName uniq occ_str info = noCafIdInfo - `setArityInfo` arity - `setDmdSigInfo` strict_sig - `setCprSigInfo` topCprSig + `setArityInfo` arity + `setDmdSigInfo` strict_sig + `setCprSigInfo` topCprSig (bndrs, _) = tcSplitPiTys ty arity = count isAnonTyCoBinder bndrs 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 @@ -67,6 +67,7 @@ import GHC.Prelude import GHC.Builtin.Types.Prim +import GHC.Core.TyCo.Rep ( RuntimeRepType ) import GHC.Core.Type import GHC.Utils.Outputable import GHC.Data.FastString @@ -131,7 +132,7 @@ -- that can be represented as a Literal. Create -- with 'nullAddrLit' - | LitRubbish Type -- ^ A nonsense value of the given + | LitRubbish RuntimeRepType -- ^ A nonsense value of the given -- representation. See Note [Rubbish literals]. -- -- The Type argument, rr, is of kind RuntimeRep. @@ -903,7 +904,7 @@ add_par (text "__label" <+> b <+> ppr fod) where b = case mb of Nothing -> pprHsString l - Just x -> doubleQuotes (text (unpackFS l ++ '@':show x)) + Just x -> doubleQuotes (ftext l <> text ('@':show x)) pprLiteral _ (LitRubbish rep) = text "RUBBISH" <> parens (ppr rep) diff --git a/compiler/GHC/Types/Name/Env.hs b/compiler/GHC/Types/Name/Env.hs --- a/compiler/GHC/Types/Name/Env.hs +++ b/compiler/GHC/Types/Name/Env.hs @@ -19,7 +19,7 @@ unitNameEnv, nonDetNameEnvElts, extendNameEnv_C, extendNameEnv_Acc, extendNameEnv, extendNameEnvList, extendNameEnvList_C, - filterNameEnv, anyNameEnv, + filterNameEnv, mapMaybeNameEnv, anyNameEnv, plusNameEnv, plusNameEnv_C, plusNameEnv_CD, plusNameEnv_CD2, alterNameEnv, lookupNameEnv, lookupNameEnv_NF, delFromNameEnv, delListFromNameEnv, elemNameEnv, mapNameEnv, disjointNameEnv, @@ -121,6 +121,7 @@ lookupNameEnv :: NameEnv a -> Name -> Maybe a lookupNameEnv_NF :: NameEnv a -> Name -> a filterNameEnv :: (elt -> Bool) -> NameEnv elt -> NameEnv elt +mapMaybeNameEnv :: (a -> Maybe b) -> NameEnv a -> NameEnv b anyNameEnv :: (elt -> Bool) -> NameEnv elt -> Bool mapNameEnv :: (elt1 -> elt2) -> NameEnv elt1 -> NameEnv elt2 disjointNameEnv :: NameEnv a -> NameEnv a -> Bool @@ -149,6 +150,7 @@ delFromNameEnv x y = delFromUFM x y delListFromNameEnv x y = delListFromUFM x y filterNameEnv x y = filterUFM x y +mapMaybeNameEnv x y = mapMaybeUFM x y anyNameEnv f x = foldUFM ((||) . f) False x disjointNameEnv x y = disjointUFM x y seqEltsNameEnv seqElt x = seqEltsUFM seqElt x diff --git a/compiler/GHC/Types/Name/Occurrence.hs b/compiler/GHC/Types/Name/Occurrence.hs --- a/compiler/GHC/Types/Name/Occurrence.hs +++ b/compiler/GHC/Types/Name/Occurrence.hs @@ -646,8 +646,8 @@ mkGen1R = mk_simple_deriv tcName "Rep1_" -- Overloaded record field selectors -mkRecFldSelOcc :: String -> OccName -mkRecFldSelOcc s = mk_deriv varName "$sel" [fsLit s] +mkRecFldSelOcc :: FastString -> OccName +mkRecFldSelOcc s = mk_deriv varName "$sel" [s] mk_simple_deriv :: NameSpace -> FastString -> OccName -> OccName mk_simple_deriv sp px occ = mk_deriv sp px [occNameFS occ] diff --git a/compiler/GHC/Types/Name/Occurrence.hs-boot b/compiler/GHC/Types/Name/Occurrence.hs-boot --- a/compiler/GHC/Types/Name/Occurrence.hs-boot +++ b/compiler/GHC/Types/Name/Occurrence.hs-boot @@ -1,6 +1,5 @@ module GHC.Types.Name.Occurrence where -import GHC.Prelude (String) import GHC.Data.FastString data OccName @@ -8,6 +7,6 @@ class HasOccName name where occName :: name -> OccName -occNameString :: OccName -> String -mkRecFldSelOcc :: String -> OccName +occNameFS :: OccName -> FastString +mkRecFldSelOcc :: FastString -> OccName mkVarOccFS :: FastString -> OccName diff --git a/compiler/GHC/Types/Name/Set.hs b/compiler/GHC/Types/Name/Set.hs --- a/compiler/GHC/Types/Name/Set.hs +++ b/compiler/GHC/Types/Name/Set.hs @@ -220,5 +220,5 @@ -- | 'Id's which have no CAF references. This is a result of analysis of C--. -- It is always safe to use an empty 'NonCaffySet'. TODO Refer to Note. -newtype NonCaffySet = NonCaffySet NameSet +newtype NonCaffySet = NonCaffySet { ncs_nameSet :: NameSet } deriving (Semigroup, Monoid) diff --git a/compiler/GHC/Types/RepType.hs b/compiler/GHC/Types/RepType.hs --- a/compiler/GHC/Types/RepType.hs +++ b/compiler/GHC/Types/RepType.hs @@ -286,7 +286,7 @@ -- -- TODO(michalt): We should probably introduce `SlotTy`s for 8-/16-/32-bit -- values, so that we can pack things more tightly. -data SlotTy = PtrLiftedSlot | PtrUnliftedSlot | WordSlot | Word64Slot | FloatSlot | DoubleSlot +data SlotTy = PtrLiftedSlot | PtrUnliftedSlot | WordSlot | Word64Slot | FloatSlot | DoubleSlot | VecSlot Int PrimElemRep deriving (Eq, Ord) -- Constructor order is important! If slot A could fit into slot B -- then slot A must occur first. E.g. FloatSlot before DoubleSlot @@ -301,6 +301,7 @@ ppr WordSlot = text "WordSlot" ppr DoubleSlot = text "DoubleSlot" ppr FloatSlot = text "FloatSlot" + ppr (VecSlot n e) = text "VecSlot" <+> ppr n <+> ppr e typeSlotTy :: UnaryType -> Maybe SlotTy typeSlotTy ty @@ -326,7 +327,7 @@ primRepSlot AddrRep = WordSlot primRepSlot FloatRep = FloatSlot primRepSlot DoubleRep = DoubleSlot -primRepSlot VecRep{} = pprPanic "primRepSlot" (text "No slot for VecRep") +primRepSlot (VecRep n e) = VecSlot n e slotPrimRep :: SlotTy -> PrimRep slotPrimRep PtrLiftedSlot = LiftedRep @@ -335,6 +336,7 @@ slotPrimRep WordSlot = WordRep slotPrimRep DoubleSlot = DoubleRep slotPrimRep FloatSlot = FloatRep +slotPrimRep (VecSlot n e) = VecRep n e -- | Returns the bigger type if one fits into the other. (commutative) -- diff --git a/compiler/GHC/Types/SourceError.hs b/compiler/GHC/Types/SourceError.hs --- a/compiler/GHC/Types/SourceError.hs +++ b/compiler/GHC/Types/SourceError.hs @@ -14,7 +14,7 @@ import GHC.Utils.Monad import GHC.Utils.Panic import GHC.Utils.Exception -import GHC.Utils.Error (pprMsgEnvelopeBagWithLoc) +import GHC.Utils.Error (pprMsgEnvelopeBagWithLocDefault) import GHC.Utils.Outputable import GHC.Driver.Errors.Ppr () -- instance Diagnostic GhcMessage @@ -59,7 +59,7 @@ show (SourceError msgs) = renderWithContext defaultSDocContext . vcat - . pprMsgEnvelopeBagWithLoc + . pprMsgEnvelopeBagWithLocDefault . getMessages $ msgs diff --git a/compiler/GHC/Types/SrcLoc.hs b/compiler/GHC/Types/SrcLoc.hs --- a/compiler/GHC/Types/SrcLoc.hs +++ b/compiler/GHC/Types/SrcLoc.hs @@ -16,6 +16,7 @@ -- ** Constructing SrcLoc mkSrcLoc, mkRealSrcLoc, mkGeneralSrcLoc, + leftmostColumn, noSrcLoc, -- "I'm sorry, I haven't a clue" generatedSrcLoc, -- Code generated within the compiler @@ -68,6 +69,7 @@ getBufPos, BufSpan(..), getBufSpan, + removeBufSpan, -- * Located Located, @@ -103,11 +105,6 @@ mkSrcSpanPs, combineRealSrcSpans, psLocatedToLocated, - - -- * Layout information - LayoutInfo(..), - leftmostColumn - ) where import GHC.Prelude @@ -240,6 +237,10 @@ mkRealSrcLoc :: FastString -> Int -> Int -> RealSrcLoc mkRealSrcLoc x line col = SrcLoc (LexicalFastString x) line col +-- | Indentation level is 1-indexed, so the leftmost column is 1. +leftmostColumn :: Int +leftmostColumn = 1 + getBufPos :: SrcLoc -> Strict.Maybe BufPos getBufPos (RealSrcLoc _ mbpos) = mbpos getBufPos (UnhelpfulLoc _) = Strict.Nothing @@ -392,6 +393,10 @@ | UnhelpfulOther !FastString deriving (Eq, Show) +removeBufSpan :: SrcSpan -> SrcSpan +removeBufSpan (RealSrcSpan s _) = RealSrcSpan s Strict.Nothing +removeBufSpan s = s + {- Note [Why Maybe BufPos] ~~~~~~~~~~~~~~~~~~~~~~~~~~ In SrcLoc we store (Maybe BufPos); in SrcSpan we store (Maybe BufSpan). @@ -881,33 +886,3 @@ mkSrcSpanPs :: PsSpan -> SrcSpan mkSrcSpanPs (PsSpan r b) = RealSrcSpan r (Strict.Just b) - --- | Layout information for declarations. -data LayoutInfo = - - -- | Explicit braces written by the user. - -- - -- @ - -- class C a where { foo :: a; bar :: a } - -- @ - ExplicitBraces - | - -- | Virtual braces inserted by the layout algorithm. - -- - -- @ - -- class C a where - -- foo :: a - -- bar :: a - -- @ - VirtualBraces - !Int -- ^ Layout column (indentation level, begins at 1) - | - -- | Empty or compiler-generated blocks do not have layout information - -- associated with them. - NoLayoutInfo - - deriving (Eq, Ord, Show, Data) - --- | Indentation level is 1-indexed, so the leftmost column is 1. -leftmostColumn :: Int -leftmostColumn = 1 diff --git a/compiler/GHC/Types/Var/Env.hs b/compiler/GHC/Types/Var/Env.hs --- a/compiler/GHC/Types/Var/Env.hs +++ b/compiler/GHC/Types/Var/Env.hs @@ -47,7 +47,7 @@ anyDVarEnv, -- * The InScopeSet type - InScopeSet, + InScopeSet(..), -- ** Operations on InScopeSets emptyInScopeSet, mkInScopeSet, mkInScopeSetList, delInScopeSet, diff --git a/compiler/GHC/Unit/Env.hs b/compiler/GHC/Unit/Env.hs --- a/compiler/GHC/Unit/Env.hs +++ b/compiler/GHC/Unit/Env.hs @@ -37,6 +37,7 @@ , addHomeModInfoToHug -- * UnitEnvGraph , UnitEnvGraph (..) + , UnitEnvGraphKey , unitEnv_insert , unitEnv_delete , unitEnv_adjust diff --git a/compiler/GHC/Unit/Home/ModInfo.hs b/compiler/GHC/Unit/Home/ModInfo.hs --- a/compiler/GHC/Unit/Home/ModInfo.hs +++ b/compiler/GHC/Unit/Home/ModInfo.hs @@ -1,6 +1,13 @@ -- | Info about modules in the "home" unit module GHC.Unit.Home.ModInfo ( HomeModInfo (..) + , HomeModLinkable(..) + , homeModInfoObject + , homeModInfoByteCode + , emptyHomeModInfoLinkable + , justBytecode + , justObjects + , bytecodeAndObjects , HomePackageTable , emptyHomePackageTable , lookupHpt @@ -27,7 +34,7 @@ import GHC.Unit.Module.ModDetails import GHC.Unit.Module -import GHC.Linker.Types ( Linkable(..) ) +import GHC.Linker.Types ( Linkable(..), isObjectLinkable ) import GHC.Types.Unique import GHC.Types.Unique.DFM @@ -35,6 +42,7 @@ import GHC.Utils.Outputable import Data.List (sortOn) import Data.Ord +import GHC.Utils.Panic -- | Information about modules in the package being compiled data HomeModInfo = HomeModInfo @@ -48,24 +56,77 @@ -- This field is LAZY because a ModDetails is constructed by knot tying. - , hm_linkable :: !(Maybe Linkable) + , hm_linkable :: !HomeModLinkable -- ^ The actual artifact we would like to link to access things in - -- this module. + -- this module. See Note [Home module build products] -- - -- 'hm_linkable' might be Nothing: + -- 'hm_linkable' might be empty: -- -- 1. If this is an .hs-boot module -- -- 2. Temporarily during compilation if we pruned away -- the old linkable because it was out of date. -- - -- After a complete compilation ('GHC.load'), all 'hm_linkable' fields - -- in the 'HomePackageTable' will be @Just@. - -- -- When re-linking a module ('GHC.Driver.Main.HscNoRecomp'), we construct the -- 'HomeModInfo' by building a new 'ModDetails' from the old -- 'ModIface' (only). } + +homeModInfoByteCode :: HomeModInfo -> Maybe Linkable +homeModInfoByteCode = homeMod_bytecode . hm_linkable + +homeModInfoObject :: HomeModInfo -> Maybe Linkable +homeModInfoObject = homeMod_object . hm_linkable + +emptyHomeModInfoLinkable :: HomeModLinkable +emptyHomeModInfoLinkable = HomeModLinkable Nothing Nothing + +-- See Note [Home module build products] +data HomeModLinkable = HomeModLinkable { homeMod_bytecode :: !(Maybe Linkable) + , homeMod_object :: !(Maybe Linkable) } + +instance Outputable HomeModLinkable where + ppr (HomeModLinkable l1 l2) = ppr l1 $$ ppr l2 + +justBytecode :: Linkable -> HomeModLinkable +justBytecode lm = + assertPpr (not (isObjectLinkable lm)) (ppr lm) + $ emptyHomeModInfoLinkable { homeMod_bytecode = Just lm } + +justObjects :: Linkable -> HomeModLinkable +justObjects lm = + assertPpr (isObjectLinkable lm) (ppr lm) + $ emptyHomeModInfoLinkable { homeMod_object = Just lm } + +bytecodeAndObjects :: Linkable -> Linkable -> HomeModLinkable +bytecodeAndObjects bc o = + assertPpr (not (isObjectLinkable bc) && isObjectLinkable o) (ppr bc $$ ppr o) + (HomeModLinkable (Just bc) (Just o)) + + +{- +Note [Home module build products] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +When compiling a home module we can produce some combination of the following +build products. + +1. A byte code linkable, for use with the byte code interpreter. +2. An object file linkable, for linking a final executable or the byte code interpreter + +What we have produced is recorded in the `HomeModLinkable` type. In the case +that these linkables are produced they are stored in the relevant field so that +subsequent modules can retrieve and use them as necessary. + +* `-fbyte-code` will *only* produce a byte code linkable. This is the default in GHCi. +* `-fobject-code` will *only* produce an object file linkable. This is the default in -c and --make mode. +* `-fbyte-code-and-object-code` produces both a byte-code and object file linkable. So both fields are populated. + +Why would you want to produce both an object file and byte code linkable? If you +also want to use `-fprefer-byte-code` then you should probably also use this +flag to make sure that byte code is generated for your modules. + +-} -- | Helps us find information about modules in the home package type HomePackageTable = DModuleNameEnv HomeModInfo diff --git a/compiler/GHC/Unit/Module/Env.hs b/compiler/GHC/Unit/Module/Env.hs --- a/compiler/GHC/Unit/Module/Env.hs +++ b/compiler/GHC/Unit/Module/Env.hs @@ -9,7 +9,7 @@ , partitionModuleEnv , moduleEnvKeys, moduleEnvElts, moduleEnvToList , unitModuleEnv, isEmptyModuleEnv - , extendModuleEnvWith, filterModuleEnv + , extendModuleEnvWith, filterModuleEnv, mapMaybeModuleEnv -- * ModuleName mappings , ModuleNameEnv, DModuleNameEnv @@ -93,6 +93,10 @@ filterModuleEnv :: (Module -> a -> Bool) -> ModuleEnv a -> ModuleEnv a filterModuleEnv f (ModuleEnv e) = ModuleEnv (Map.filterWithKey (f . unNDModule) e) + +mapMaybeModuleEnv :: (Module -> a -> Maybe b) -> ModuleEnv a -> ModuleEnv b +mapMaybeModuleEnv f (ModuleEnv e) = + ModuleEnv (Map.mapMaybeWithKey (f . unNDModule) e) elemModuleEnv :: Module -> ModuleEnv a -> Bool elemModuleEnv m (ModuleEnv e) = Map.member (NDModule m) e diff --git a/compiler/GHC/Unit/Module/Graph.hs b/compiler/GHC/Unit/Module/Graph.hs --- a/compiler/GHC/Unit/Module/Graph.hs +++ b/compiler/GHC/Unit/Module/Graph.hs @@ -282,12 +282,12 @@ mod_str = showPpr dflags mod ++ hscSourceString (ms_hsc_src mod_summary) dyn_file = op $ msDynObjFilePath mod_summary obj_file = op $ msObjFilePath mod_summary + files = [ obj_file ] + ++ [ dyn_file | gopt Opt_BuildDynamicToo dflags ] + ++ [ "interpreted" | gopt Opt_ByteCodeAndObjectCode dflags ] message = case backendSpecialModuleSource (backend dflags) recomp of Just special -> text special - Nothing -> - if gopt Opt_BuildDynamicToo dflags - then text obj_file <> comma <+> text dyn_file - else text obj_file + Nothing -> foldr1 (\ofile rest -> ofile <> comma <+> rest) (map text files) diff --git a/compiler/GHC/Unit/Module/ModIface.hs b/compiler/GHC/Unit/Module/ModIface.hs --- a/compiler/GHC/Unit/Module/ModIface.hs +++ b/compiler/GHC/Unit/Module/ModIface.hs @@ -200,6 +200,11 @@ -- Ditto data constructors, class operations, except that -- the hash of the parent class/tycon changes + mi_extra_decls :: Maybe [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo], + -- ^ Extra variable definitions which are **NOT** exposed but when + -- combined with mi_decls allows us to restart code generation. + -- See Note [Interface Files with Core Definitions] and Note [Interface File with Core: Sharing RHSs] + mi_globals :: !(Maybe GlobalRdrEnv), -- ^ Binds all the things defined at the top level in -- the /original source/ code for this module. which @@ -349,6 +354,7 @@ mi_warns = warns, mi_anns = anns, mi_decls = decls, + mi_extra_decls = extra_decls, mi_insts = insts, mi_fam_insts = fam_insts, mi_rules = rules, @@ -392,6 +398,7 @@ lazyPut bh warns lazyPut bh anns put_ bh decls + put_ bh extra_decls put_ bh insts put_ bh fam_insts lazyPut bh rules @@ -423,6 +430,7 @@ warns <- {-# SCC "bin_warns" #-} lazyGet bh anns <- {-# SCC "bin_anns" #-} lazyGet bh decls <- {-# SCC "bin_tycldecls" #-} get bh + extra_decls <- get bh insts <- {-# SCC "bin_insts" #-} get bh fam_insts <- {-# SCC "bin_fam_insts" #-} get bh rules <- {-# SCC "bin_rules" #-} lazyGet bh @@ -446,6 +454,7 @@ mi_fixities = fixities, mi_warns = warns, mi_decls = decls, + mi_extra_decls = extra_decls, mi_globals = Nothing, mi_insts = insts, mi_fam_insts = fam_insts, @@ -494,6 +503,7 @@ mi_fam_insts = [], mi_rules = [], mi_decls = [], + mi_extra_decls = Nothing, mi_globals = Nothing, mi_hpc = False, mi_trust = noIfaceTrustInfo, @@ -541,11 +551,12 @@ -- avoid major space leaks. instance (NFData (IfaceBackendExts (phase :: ModIfacePhase)), NFData (IfaceDeclExts (phase :: ModIfacePhase))) => NFData (ModIface_ phase) where rnf (ModIface f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 - f13 f14 f15 f16 f17 f18 f19 f20 f21 f22 f23) = + f13 f14 f15 f16 f17 f18 f19 f20 f21 f22 f23 f24) = rnf f1 `seq` rnf f2 `seq` f3 `seq` f4 `seq` f5 `seq` f6 `seq` rnf f7 `seq` f8 `seq` - f9 `seq` rnf f10 `seq` rnf f11 `seq` f12 `seq` rnf f13 `seq` rnf f14 `seq` rnf f15 `seq` - rnf f16 `seq` f17 `seq` rnf f18 `seq` rnf f19 `seq` f20 `seq` f21 `seq` f22 `seq` rnf f23 + f9 `seq` rnf f10 `seq` rnf f11 `seq` rnf f12 `seq` f13 `seq` rnf f14 `seq` rnf f15 `seq` rnf f16 `seq` + rnf f17 `seq` f18 `seq` rnf f19 `seq` rnf f20 `seq` f21 `seq` f22 `seq` f23 `seq` rnf f24 `seq` () + instance NFData (ModIfaceBackend) where rnf (ModIfaceBackend f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13) diff --git a/compiler/GHC/Unit/Module/Status.hs b/compiler/GHC/Unit/Module/Status.hs --- a/compiler/GHC/Unit/Module/Status.hs +++ b/compiler/GHC/Unit/Module/Status.hs @@ -10,13 +10,13 @@ import GHC.Unit.Module.ModIface import GHC.Utils.Fingerprint -import GHC.Linker.Types import GHC.Utils.Outputable +import GHC.Unit.Home.ModInfo -- | Status of a module in incremental compilation data HscRecompStatus -- | Nothing to do because code already exists. - = HscUpToDate ModIface (Maybe Linkable) + = HscUpToDate ModIface HomeModLinkable -- | Recompilation of module, or update of interface is required. Optionally -- pass the old interface hash to avoid updating the existing interface when -- it has not changed. diff --git a/compiler/GHC/Unit/Module/Warnings.hs b/compiler/GHC/Unit/Module/Warnings.hs --- a/compiler/GHC/Unit/Module/Warnings.hs +++ b/compiler/GHC/Unit/Module/Warnings.hs @@ -61,21 +61,21 @@ instance Binary (WarningTxt GhcRn) where put_ bh (WarningTxt s w) = do putByte bh 0 - put_ bh s - put_ bh w + put_ bh $ unLoc s + put_ bh $ unLoc <$> w put_ bh (DeprecatedTxt s d) = do putByte bh 1 - put_ bh s - put_ bh d + put_ bh $ unLoc s + put_ bh $ unLoc <$> d get bh = do h <- getByte bh case h of - 0 -> do s <- get bh - w <- get bh + 0 -> do s <- noLoc <$> get bh + w <- fmap noLoc <$> get bh return (WarningTxt s w) - _ -> do s <- get bh - d <- get bh + _ -> do s <- noLoc <$> get bh + d <- fmap noLoc <$> get bh return (DeprecatedTxt s d) diff --git a/compiler/GHC/Unit/Module/WholeCoreBindings.hs b/compiler/GHC/Unit/Module/WholeCoreBindings.hs new file mode 100644 --- /dev/null +++ b/compiler/GHC/Unit/Module/WholeCoreBindings.hs @@ -0,0 +1,63 @@ +module GHC.Unit.Module.WholeCoreBindings where + +import GHC.Unit.Types (Module) +import GHC.Unit.Module.Location +import GHC.Iface.Syntax + +{- +Note [Interface Files with Core Definitions] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +A interface file can optionally contain the definitions of all core bindings, this +is enabled by the flag `-fwrite-if-simplified-core`. +This provides everything needed in addition to the normal ModIface and ModDetails +to restart compilation after typechecking to generate bytecode. The `fi_bindings` field +is stored in the normal interface file and the other fields populated whilst loading +the interface file. + +The lifecycle of a WholeCoreBindings typically proceeds as follows: + +1. The ModIface which contains mi_extra_decls is loaded from disk. A linkable is + created (which is headed by the `CoreBindings` constructor). This is an unhydrated set of bindings which + is currently unsuitable for linking, but at the point it is loaded, the ModIface + hasn't been hydrated yet (See Note [Hydrating Modules]) either so the CoreBindings constructor allows the delaying of converting + the WholeCoreBindings into a proper Linkable (if we ever do that). The CoreBindings constructor also + allows us to convert the WholeCoreBindings into multiple different linkables if we so desired. + +2. `initWholeCoreBindings` turns a WholeCoreBindings into a proper BCO linkable. This step combines together + all the necessary information from a ModIface, ModDetails and WholeCoreBindings in order to + create the linkable. The linkable created is a "LoadedBCOs" linkable, which + was introduced just for initWholeCoreBindings, so that the bytecode can be generated lazilly. + Using the `BCOs` constructor directly here leads to the bytecode being forced + too eagerly. + +3. Then when bytecode is needed, the LoadedBCOs value is inspected and unpacked and + the linkable is used as before. + +The flag `-fwrite-if-simplified-core` determines whether the extra information is written +to an interface file. The program which is written is the core bindings of the module +after whatever simplification the user requested has been performed. So the simplified core bindings +of the interface file agree with the optimisation level as reported by the interface +file. + +Note [Size of Interface Files with Core Definitions] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +How much overhead does `-fwrite-if-simplified-core` add to a typical interface file? +As an experiment I compiled the `Cabal` library and `ghc` library (Aug 22) with + +| Project | .hi | .hi (fat) | .o | +| --------| ---- | --------- | -- | +| ghc | 32M | 68M | 127M | +| Cabal | 3.2M | 9.8M | 14M | + +So the interface files gained in size but the end result was still smaller than +the object files. + +-} + +data WholeCoreBindings = WholeCoreBindings + { wcb_bindings :: [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo] + , wcb_module :: Module + , wcb_mod_location :: ModLocation + } 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 @@ -2036,7 +2036,7 @@ instance Outputable UnitErr where ppr = \case CloseUnitErr p mb_parent - -> (ftext (fsLit "unknown unit:") <+> ppr p) + -> (text "unknown unit:" <+> ppr p) <> case mb_parent of Nothing -> Outputable.empty Just parent -> space <> parens (text "dependency of" diff --git a/compiler/GHC/Utils/Binary.hs b/compiler/GHC/Utils/Binary.hs --- a/compiler/GHC/Utils/Binary.hs +++ b/compiler/GHC/Utils/Binary.hs @@ -73,6 +73,9 @@ UserData(..), getUserData, setUserData, newReadState, newWriteState, putDictionary, getDictionary, putFS, + + -- * Newtype wrappers + BinSpan(..), BinSrcSpan(..), BinLocated(..) ) where import GHC.Prelude @@ -1285,18 +1288,23 @@ -- fs <- get bh -- return (StringLiteral st fs Nothing) -instance Binary a => Binary (Located a) where - put_ bh (L l x) = do - put_ bh l +newtype BinLocated a = BinLocated { unBinLocated :: Located a } + +instance Binary a => Binary (BinLocated a) where + put_ bh (BinLocated (L l x)) = do + put_ bh $ BinSrcSpan l put_ bh x get bh = do - l <- get bh + l <- unBinSrcSpan <$> get bh x <- get bh - return (L l x) + return $ BinLocated (L l x) -instance Binary RealSrcSpan where - put_ bh ss = do +newtype BinSpan = BinSpan { unBinSpan :: RealSrcSpan } + +-- See Note [Source Location Wrappers] +instance Binary BinSpan where + put_ bh (BinSpan ss) = do put_ bh (srcSpanFile ss) put_ bh (srcSpanStartLine ss) put_ bh (srcSpanStartCol ss) @@ -1309,21 +1317,8 @@ sc <- get bh el <- get bh ec <- get bh - return (mkRealSrcSpan (mkRealSrcLoc f sl sc) - (mkRealSrcLoc f el ec)) - -instance Binary BufPos where - put_ bh (BufPos i) = put_ bh i - get bh = BufPos <$> get bh - -instance Binary BufSpan where - put_ bh (BufSpan start end) = do - put_ bh start - put_ bh end - get bh = do - start <- get bh - end <- get bh - return (BufSpan start end) + return $ BinSpan (mkRealSrcSpan (mkRealSrcLoc f sl sc) + (mkRealSrcLoc f el ec)) instance Binary UnhelpfulSpanReason where put_ bh r = case r of @@ -1342,24 +1337,44 @@ 3 -> return UnhelpfulGenerated _ -> UnhelpfulOther <$> get bh -instance Binary SrcSpan where - put_ bh (RealSrcSpan ss sb) = do +newtype BinSrcSpan = BinSrcSpan { unBinSrcSpan :: SrcSpan } + +-- See Note [Source Location Wrappers] +instance Binary BinSrcSpan where + put_ bh (BinSrcSpan (RealSrcSpan ss _sb)) = do putByte bh 0 - put_ bh ss - put_ bh sb + -- BufSpan doesn't ever get serialised because the positions depend + -- on build location. + put_ bh $ BinSpan ss - put_ bh (UnhelpfulSpan s) = do + put_ bh (BinSrcSpan (UnhelpfulSpan s)) = do putByte bh 1 put_ bh s get bh = do h <- getByte bh case h of - 0 -> do ss <- get bh - sb <- get bh - return (RealSrcSpan ss sb) + 0 -> do BinSpan ss <- get bh + return $ BinSrcSpan (RealSrcSpan ss Strict.Nothing) _ -> do s <- get bh - return (UnhelpfulSpan s) + return $ BinSrcSpan (UnhelpfulSpan s) + + +{- +Note [Source Location Wrappers] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +Source locations are banned from interface files, to +prevent filepaths affecting interface hashes. + +Unfortunately, we can't remove all binary instances, +as they're used to serialise .hie files, and we don't +want to break binary compatibility. + +To this end, the Bin[Src]Span newtypes wrappers were +introduced to prevent accidentally serialising a +source location as part of a larger structure. +-} -------------------------------------------------------------------------------- -- Instances for the containers package diff --git a/compiler/GHC/Utils/Error.hs b/compiler/GHC/Utils/Error.hs --- a/compiler/GHC/Utils/Error.hs +++ b/compiler/GHC/Utils/Error.hs @@ -2,6 +2,7 @@ {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE TypeApplications #-} {- (c) The AQUA Project, Glasgow University, 1994-1998 @@ -25,9 +26,9 @@ errorsFound, isEmptyMessages, -- ** Formatting - pprMessageBag, pprMsgEnvelopeBagWithLoc, + pprMessageBag, pprMsgEnvelopeBagWithLoc, pprMsgEnvelopeBagWithLocDefault, pprMessages, - pprLocMsgEnvelope, + pprLocMsgEnvelope, pprLocMsgEnvelopeDefault, formatBulleted, -- ** Construction @@ -228,14 +229,22 @@ msgs = filter (not . Outputable.isEmpty ctx) docs starred = (bullet<+>) -pprMessages :: Diagnostic e => Messages e -> SDoc -pprMessages = vcat . pprMsgEnvelopeBagWithLoc . getMessages +pprMessages :: Diagnostic e => DiagnosticOpts e -> Messages e -> SDoc +pprMessages e = vcat . pprMsgEnvelopeBagWithLoc e . getMessages -pprMsgEnvelopeBagWithLoc :: Diagnostic e => Bag (MsgEnvelope e) -> [SDoc] -pprMsgEnvelopeBagWithLoc bag = [ pprLocMsgEnvelope item | item <- sortMsgBag Nothing bag ] +pprMsgEnvelopeBagWithLoc :: Diagnostic e => DiagnosticOpts e -> Bag (MsgEnvelope e) -> [SDoc] +pprMsgEnvelopeBagWithLoc e bag = [ pprLocMsgEnvelope e item | item <- sortMsgBag Nothing bag ] -pprLocMsgEnvelope :: Diagnostic e => MsgEnvelope e -> SDoc -pprLocMsgEnvelope (MsgEnvelope { errMsgSpan = s +-- | Print the messages with the suitable default configuration, usually not what you want but sometimes you don't really +-- care about what the configuration is (for example, if the message is in a panic). +pprMsgEnvelopeBagWithLocDefault :: forall e . Diagnostic e => Bag (MsgEnvelope e) -> [SDoc] +pprMsgEnvelopeBagWithLocDefault bag = [ pprLocMsgEnvelopeDefault item | item <- sortMsgBag Nothing bag ] + +pprLocMsgEnvelopeDefault :: forall e . Diagnostic e => MsgEnvelope e -> SDoc +pprLocMsgEnvelopeDefault = pprLocMsgEnvelope (defaultDiagnosticOpts @e) + +pprLocMsgEnvelope :: Diagnostic e => DiagnosticOpts e -> MsgEnvelope e -> SDoc +pprLocMsgEnvelope opts (MsgEnvelope { errMsgSpan = s , errMsgDiagnostic = e , errMsgSeverity = sev , errMsgContext = unqual }) @@ -244,7 +253,7 @@ mkLocMessage (MCDiagnostic sev (diagnosticReason e) (diagnosticCode e)) s - (formatBulleted ctx $ diagnosticMessage e) + (formatBulleted ctx $ diagnosticMessage opts e) sortMsgBag :: Maybe DiagOpts -> Bag (MsgEnvelope e) -> [MsgEnvelope e] sortMsgBag mopts = maybeLimit . sortBy (cmp `on` errMsgSpan) . bagToList diff --git a/compiler/GHC/Utils/Json.hs b/compiler/GHC/Utils/Json.hs --- a/compiler/GHC/Utils/Json.hs +++ b/compiler/GHC/Utils/Json.hs @@ -14,6 +14,7 @@ JSBool :: Bool -> JsonDoc JSInt :: Int -> JsonDoc JSString :: String -> JsonDoc + -- ^ The 'String' is unescaped JSArray :: [JsonDoc] -> JsonDoc JSObject :: [(String, JsonDoc)] -> JsonDoc @@ -57,7 +58,7 @@ json :: a -> JsonDoc instance ToJson String where - json = JSString . escapeJsonString + json = JSString instance ToJson Int where json = JSInt diff --git a/compiler/GHC/Utils/Misc.hs b/compiler/GHC/Utils/Misc.hs --- a/compiler/GHC/Utils/Misc.hs +++ b/compiler/GHC/Utils/Misc.hs @@ -124,7 +124,7 @@ HasDebugCallStack, ) where -import GHC.Prelude hiding ( last ) +import GHC.Prelude hiding ( head, init, last, tail ) import GHC.Utils.Exception import GHC.Utils.Panic.Plain @@ -133,7 +133,9 @@ import Data.Data import qualified Data.List as List -import Data.List.NonEmpty ( NonEmpty(..), last ) +import qualified Data.List as Partial ( head ) +import Data.List.NonEmpty ( NonEmpty(..), last, nonEmpty ) +import qualified Data.List.NonEmpty as NE import GHC.Exts import GHC.Stack (HasCallStack) @@ -522,11 +524,9 @@ changeLast (x:xs) x' = x : changeLast xs x' -- | Apply an effectful function to the last list element. --- Assumes a non-empty list (panics otherwise). -mapLastM :: Functor f => (a -> f a) -> [a] -> f [a] -mapLastM _ [] = panic "mapLastM: empty list" -mapLastM f [x] = (\x' -> [x']) <$> f x -mapLastM f (x:xs) = (x:) <$> mapLastM f xs +mapLastM :: Functor f => (a -> f a) -> NonEmpty a -> f (NonEmpty a) +mapLastM f (x:|[]) = NE.singleton <$> f x +mapLastM f (x0:|x1:xs) = (x0 NE.<|) <$> mapLastM f (x1:|xs) whenNonEmpty :: Applicative m => [a] -> (NonEmpty a -> m ()) -> m () whenNonEmpty [] _ = pure () @@ -590,7 +590,7 @@ minWith :: Ord b => (a -> b) -> [a] -> a minWith get_key xs = assert (not (null xs) ) - head (sortWith get_key xs) + Partial.head (sortWith get_key xs) nubSort :: Ord a => [a] -> [a] nubSort = Set.toAscList . Set.fromList @@ -741,12 +741,10 @@ | p x = go yes (x : rev_yes) rev_no xs | otherwise = go xs [] (x : rev_yes ++ rev_no) xs --- | Get the last two elements in a list. Partial! +-- | Get the last two elements in a list. {-# INLINE last2 #-} -last2 :: [a] -> (a,a) -last2 = List.foldl' (\(_,x2) x -> (x2,x)) (partialError,partialError) - where - partialError = panic "last2 - list length less than two" +last2 :: [a] -> Maybe (a,a) +last2 = uncurry (liftA2 (,)) . List.foldl' (\(_,x2) x -> (x2, Just x)) (Nothing, Nothing) lastMaybe :: [a] -> Maybe a lastMaybe [] = Nothing @@ -764,17 +762,12 @@ -- If you are guaranteed to use both, this will -- be more efficient. snocView :: [a] -> Maybe ([a],a) -snocView [] = Nothing -snocView xs - | (xs,x) <- go xs - = Just (xs,x) +snocView = fmap go . nonEmpty where - go :: [a] -> ([a],a) - go [x] = ([],x) - go (x:xs) - | !(xs',x') <- go xs - = (x:xs', x') - go [] = error "impossible" + go :: NonEmpty a -> ([a],a) + go (x:|xs) = case nonEmpty xs of + Nothing -> ([],x) + Just xs -> case go xs of !(xs', x') -> (x:xs', x') split :: Char -> String -> [String] split c s = case rest of 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 @@ -1,3 +1,5 @@ +{-# LANGUAGE MonadComprehensions #-} + -- | Utilities related to Monad and Applicative classes -- Mostly for backwards compatibility. @@ -28,8 +30,11 @@ import Control.Monad import Control.Monad.Fix import Control.Monad.IO.Class +import Control.Monad.Trans.State.Strict (StateT (..)) import Data.Foldable (sequenceA_, foldlM, foldrM) import Data.List (unzip4, unzip5, zipWith4) +import Data.List.NonEmpty (NonEmpty (..)) +import Data.Tuple (swap) ------------------------------------------------------------------------------- -- Common functions @@ -137,25 +142,43 @@ -- variant and use it where appropriate. -- | Monadic version of mapAccumL -mapAccumLM :: Monad m +mapAccumLM :: (Monad m, Traversable t) => (acc -> x -> m (acc, y)) -- ^ combining function -> acc -- ^ initial state - -> [x] -- ^ inputs - -> m (acc, [y]) -- ^ final state, outputs -{-# INLINE mapAccumLM #-} + -> t x -- ^ inputs + -> m (acc, t y) -- ^ final state, outputs +{-# INLINE [1] mapAccumLM #-} -- INLINE pragma. mapAccumLM is called in inner loops. Like 'map', -- we inline it so that we can take advantage of knowing 'f'. -- This makes a few percent difference (in compiler allocations) -- when compiling perf/compiler/T9675 -mapAccumLM f s xs = - go s xs +mapAccumLM f s = fmap swap . flip runStateT s . traverse f' where + f' = StateT . (fmap . fmap) swap . flip f +{-# RULES "mapAccumLM/List" mapAccumLM = mapAccumLM_List #-} +{-# RULES "mapAccumLM/NonEmpty" mapAccumLM = mapAccumLM_NonEmpty #-} + +mapAccumLM_List + :: Monad m + => (acc -> x -> m (acc, y)) + -> acc -> [x] -> m (acc, [y]) +{-# INLINE mapAccumLM_List #-} +mapAccumLM_List f s = go s + where go s (x:xs) = do (s1, x') <- f s x (s2, xs') <- go s1 xs return (s2, x' : xs') go s [] = return (s, []) +mapAccumLM_NonEmpty + :: Monad m + => (acc -> x -> m (acc, y)) + -> acc -> NonEmpty x -> m (acc, NonEmpty y) +{-# INLINE mapAccumLM_NonEmpty #-} +mapAccumLM_NonEmpty f s (x:|xs) = + [(s2, x':|xs') | (s1, x') <- f s x, (s2, xs') <- mapAccumLM_List f s1 xs] + -- | Monadic version of mapSnd mapSndM :: (Applicative m, Traversable f) => (b -> m c) -> f (a,b) -> m (f (a,c)) mapSndM = traverse . traverse @@ -163,7 +186,10 @@ -- | Monadic version of concatMap concatMapM :: (Monad m, Traversable f) => (a -> m [b]) -> f a -> m [b] concatMapM f xs = liftM concat (mapM f xs) -{-# SPECIALIZE concatMapM :: (Monad m) => (a -> m [b]) -> [a] -> m [b] #-} +{-# INLINE concatMapM #-} +-- It's better to inline to inline this than to specialise +-- concatMapM :: (Monad m) => (a -> m [b]) -> [a] -> m [b] +-- Inlining cuts compiler allocation by around 1% -- | Applicative version of mapMaybe mapMaybeM :: Applicative m => (a -> m (Maybe b)) -> [a] -> m [b] @@ -171,24 +197,20 @@ where g a = liftA2 (maybe id (:)) (f a) -- | Monadic version of 'any', aborts the computation at the first @True@ value -anyM :: Monad m => (a -> m Bool) -> [a] -> m Bool -anyM f xs = go xs - where - go [] = return False - go (x:xs) = do b <- f x - if b then return True - else go xs +anyM :: (Monad m, Foldable f) => (a -> m Bool) -> f a -> m Bool +anyM f = foldr (orM . f) (pure False) -- | Monad version of 'all', aborts the computation at the first @False@ value -allM :: Monad m => (a -> m Bool) -> [a] -> m Bool -allM f bs = go bs - where - go [] = return True - go (b:bs) = (f b) >>= (\bv -> if bv then go bs else return False) +allM :: (Monad m, Foldable f) => (a -> m Bool) -> f a -> m Bool +allM f = foldr (andM . f) (pure True) -- | Monadic version of or orM :: Monad m => m Bool -> m Bool -> m Bool orM m1 m2 = m1 >>= \x -> if x then return True else m2 + +-- | Monadic version of and +andM :: Monad m => m Bool -> m Bool -> m Bool +andM m1 m2 = m1 >>= \x -> if x then m2 else return False -- | Monadic version of foldl that discards its result foldlM_ :: (Monad m, Foldable t) => (a -> b -> m a) -> a -> t b -> m () 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 @@ -83,7 +83,7 @@ -- * Controlling the style in which output is printed BindingSite(..), - PprStyle(..), LabelStyle(..), PrintUnqualified(..), + PprStyle(..), PrintUnqualified(..), QueryQualifyName, QueryQualifyModule, QueryQualifyPackage, reallyAlwaysQualify, reallyAlwaysQualifyNames, alwaysQualify, alwaysQualifyNames, alwaysQualifyModules, @@ -121,6 +121,7 @@ import GHC.Serialized import GHC.LanguageExtensions (Extension) import GHC.Utils.GlobalVars( unsafeHasPprDebug ) +import GHC.Utils.Misc (lastMaybe) import Data.ByteString (ByteString) import qualified Data.ByteString as BS @@ -172,19 +173,6 @@ | PprCode -- ^ Print code; either C or assembler --- | Style of label pretty-printing. --- --- When we produce C sources or headers, we have to take into account that C --- compilers transform C labels when they convert them into symbols. For --- example, they can add prefixes (e.g., "_" on Darwin) or suffixes (size for --- stdcalls on Windows). So we provide two ways to pretty-print CLabels: C style --- or Asm style. --- -data LabelStyle - = CStyle -- ^ C label style (used by C and LLVM backends) - | AsmStyle -- ^ Asm label style (used by NCG backend) - deriving (Eq,Ord,Show) - data Depth = AllTheWay | PartWay Int -- ^ 0 => stop @@ -716,7 +704,7 @@ in case str of [] -> Pretty.quotes pp_d '\'' : _ -> pp_d - _ | '\'' <- last str -> pp_d + _ | Just '\'' <- lastMaybe str -> pp_d | otherwise -> Pretty.quotes pp_d semi, comma, colon, equals, space, dcolon, underscore, dot, vbar :: SDoc diff --git a/compiler/Language/Haskell/Syntax.hs b/compiler/Language/Haskell/Syntax.hs --- a/compiler/Language/Haskell/Syntax.hs +++ b/compiler/Language/Haskell/Syntax.hs @@ -25,6 +25,7 @@ module Language.Haskell.Syntax.Module.Name, module Language.Haskell.Syntax.Pat, module Language.Haskell.Syntax.Type, + module Language.Haskell.Syntax.Concrete, module Language.Haskell.Syntax.Extension, ModuleName(..), HsModule(..) ) where @@ -35,6 +36,7 @@ import Language.Haskell.Syntax.ImpExp import Language.Haskell.Syntax.Module.Name import Language.Haskell.Syntax.Lit +import Language.Haskell.Syntax.Concrete import Language.Haskell.Syntax.Extension import Language.Haskell.Syntax.Pat import Language.Haskell.Syntax.Type diff --git a/compiler/Language/Haskell/Syntax/Concrete.hs b/compiler/Language/Haskell/Syntax/Concrete.hs new file mode 100644 --- /dev/null +++ b/compiler/Language/Haskell/Syntax/Concrete.hs @@ -0,0 +1,63 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE DeriveDataTypeable #-} + +-- | Bits of concrete syntax (tokens, layout). + +module Language.Haskell.Syntax.Concrete + ( LHsToken, LHsUniToken, + HsToken(HsTok), + HsUniToken(HsNormalTok, HsUnicodeTok), + LayoutInfo(ExplicitBraces, VirtualBraces, NoLayoutInfo) + ) where + +import GHC.Prelude +import GHC.TypeLits (Symbol, KnownSymbol) +import Data.Data +import Language.Haskell.Syntax.Extension + +type LHsToken tok p = XRec p (HsToken tok) +type LHsUniToken tok utok p = XRec p (HsUniToken tok utok) + +-- | A token stored in the syntax tree. For example, when parsing a +-- let-expression, we store @HsToken "let"@ and @HsToken "in"@. +-- The locations of those tokens can be used to faithfully reproduce +-- (exactprint) the original program text. +data HsToken (tok :: Symbol) = HsTok + +-- | With @UnicodeSyntax@, there might be multiple ways to write the same +-- token. For example an arrow could be either @->@ or @→@. This choice must be +-- recorded in order to exactprint such tokens, so instead of @HsToken "->"@ we +-- introduce @HsUniToken "->" "→"@. +-- +-- See also @IsUnicodeSyntax@ in @GHC.Parser.Annotation@; we do not use here to +-- avoid a dependency. +data HsUniToken (tok :: Symbol) (utok :: Symbol) = HsNormalTok | HsUnicodeTok + +deriving instance KnownSymbol tok => Data (HsToken tok) +deriving instance (KnownSymbol tok, KnownSymbol utok) => Data (HsUniToken tok utok) + +-- | Layout information for declarations. +data LayoutInfo pass = + + -- | Explicit braces written by the user. + -- + -- @ + -- class C a where { foo :: a; bar :: a } + -- @ + ExplicitBraces !(LHsToken "{" pass) !(LHsToken "}" pass) + | + -- | Virtual braces inserted by the layout algorithm. + -- + -- @ + -- class C a where + -- foo :: a + -- bar :: a + -- @ + VirtualBraces + !Int -- ^ Layout column (indentation level, begins at 1) + | + -- | Empty or compiler-generated blocks do not have layout information + -- associated with them. + NoLayoutInfo diff --git a/compiler/Language/Haskell/Syntax/Decls.hs b/compiler/Language/Haskell/Syntax/Decls.hs --- a/compiler/Language/Haskell/Syntax/Decls.hs +++ b/compiler/Language/Haskell/Syntax/Decls.hs @@ -97,8 +97,9 @@ -- Because Expr imports Decls via HsBracket import Language.Haskell.Syntax.Binds -import Language.Haskell.Syntax.Type +import Language.Haskell.Syntax.Concrete import Language.Haskell.Syntax.Extension +import Language.Haskell.Syntax.Type import Language.Haskell.Syntax.Basic (Role) import GHC.Types.Basic (TopLevelFlag, OverlapMode, RuleName, Activation) @@ -457,6 +458,8 @@ -- 'GHC.Parser.Annotation.AnnRarrow' -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation | ClassDecl { tcdCExt :: XClassDecl pass, -- ^ Post renamer, FVs + tcdLayout :: !(LayoutInfo pass), -- ^ Explicit or virtual braces + -- See Note [Class LayoutInfo] tcdCtxt :: Maybe (LHsContext pass), -- ^ Context... tcdLName :: LIdP pass, -- ^ Name of the class tcdTyVars :: LHsQTyVars pass, -- ^ Class type variables diff --git a/compiler/Language/Haskell/Syntax/Expr.hs b/compiler/Language/Haskell/Syntax/Expr.hs --- a/compiler/Language/Haskell/Syntax/Expr.hs +++ b/compiler/Language/Haskell/Syntax/Expr.hs @@ -26,6 +26,7 @@ import Language.Haskell.Syntax.Decls import Language.Haskell.Syntax.Pat import Language.Haskell.Syntax.Lit +import Language.Haskell.Syntax.Concrete import Language.Haskell.Syntax.Extension import Language.Haskell.Syntax.Type import Language.Haskell.Syntax.Binds diff --git a/compiler/Language/Haskell/Syntax/Extension.hs b/compiler/Language/Haskell/Syntax/Extension.hs --- a/compiler/Language/Haskell/Syntax/Extension.hs +++ b/compiler/Language/Haskell/Syntax/Extension.hs @@ -5,7 +5,6 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE EmptyCase #-} {-# LANGUAGE EmptyDataDeriving #-} -{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} @@ -22,8 +21,6 @@ -- This module captures the type families to precisely identify the extension -- points for GHC.Hs syntax -import GHC.TypeLits (Symbol, KnownSymbol) - #if MIN_VERSION_GLASGOW_HASKELL(9,3,0,0) import Data.Type.Equality (type (~)) #endif @@ -731,27 +728,3 @@ -- ===================================================================== -- End of Type family definitions -- ===================================================================== - - - --- ===================================================================== --- Token information - -type LHsToken tok p = XRec p (HsToken tok) - -data HsToken (tok :: Symbol) = HsTok - -deriving instance KnownSymbol tok => Data (HsToken tok) - -type LHsUniToken tok utok p = XRec p (HsUniToken tok utok) - --- With UnicodeSyntax, there might be multiple ways to write the same token. --- For example an arrow could be either "->" or "→". This choice must be --- recorded in order to exactprint such tokens, --- so instead of HsToken "->" we introduce HsUniToken "->" "→". --- --- See also IsUnicodeSyntax in GHC.Parser.Annotation; we do not use here to --- avoid a dependency. -data HsUniToken (tok :: Symbol) (utok :: Symbol) = HsNormalTok | HsUnicodeTok - -deriving instance (KnownSymbol tok, KnownSymbol utok) => Data (HsUniToken tok utok) diff --git a/compiler/Language/Haskell/Syntax/Pat.hs b/compiler/Language/Haskell/Syntax/Pat.hs --- a/compiler/Language/Haskell/Syntax/Pat.hs +++ b/compiler/Language/Haskell/Syntax/Pat.hs @@ -36,6 +36,7 @@ -- friends: import Language.Haskell.Syntax.Basic import Language.Haskell.Syntax.Lit +import Language.Haskell.Syntax.Concrete import Language.Haskell.Syntax.Extension import Language.Haskell.Syntax.Type diff --git a/compiler/Language/Haskell/Syntax/Type.hs b/compiler/Language/Haskell/Syntax/Type.hs --- a/compiler/Language/Haskell/Syntax/Type.hs +++ b/compiler/Language/Haskell/Syntax/Type.hs @@ -57,6 +57,7 @@ import {-# SOURCE #-} Language.Haskell.Syntax.Expr ( HsUntypedSplice ) +import Language.Haskell.Syntax.Concrete import Language.Haskell.Syntax.Extension import GHC.Types.Name.Reader ( RdrName ) 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: 2.0 build-type: Simple name: ghc-lib-parser -version: 0.20221001 +version: 0.20221101 license: BSD3 license-file: LICENSE category: Development @@ -449,6 +449,7 @@ GHC.Unit.Module.ModSummary GHC.Unit.Module.Status GHC.Unit.Module.Warnings + GHC.Unit.Module.WholeCoreBindings GHC.Unit.Parser GHC.Unit.Ppr GHC.Unit.State @@ -490,6 +491,7 @@ Language.Haskell.Syntax Language.Haskell.Syntax.Basic Language.Haskell.Syntax.Binds + Language.Haskell.Syntax.Concrete Language.Haskell.Syntax.Decls Language.Haskell.Syntax.Expr Language.Haskell.Syntax.Extension diff --git a/ghc-lib/stage0/compiler/build/primop-can-fail.hs-incl b/ghc-lib/stage0/compiler/build/primop-can-fail.hs-incl --- a/ghc-lib/stage0/compiler/build/primop-can-fail.hs-incl +++ b/ghc-lib/stage0/compiler/build/primop-can-fail.hs-incl @@ -234,6 +234,9 @@ primOpCanFail AtomicModifyMutVar2Op = True primOpCanFail AtomicModifyMutVar_Op = True primOpCanFail RaiseOp = True +primOpCanFail RaiseUnderflowOp = True +primOpCanFail RaiseOverflowOp = True +primOpCanFail RaiseDivZeroOp = True primOpCanFail ReallyUnsafePtrEqualityOp = True primOpCanFail (VecInsertOp _ _ _) = True primOpCanFail (VecDivOp _ _ _) = True diff --git a/ghc-lib/stage0/compiler/build/primop-code-size.hs-incl b/ghc-lib/stage0/compiler/build/primop-code-size.hs-incl --- a/ghc-lib/stage0/compiler/build/primop-code-size.hs-incl +++ b/ghc-lib/stage0/compiler/build/primop-code-size.hs-incl @@ -61,6 +61,9 @@ primOpCodeSize AddrToIntOp = 0 primOpCodeSize IntToAddrOp = 0 primOpCodeSize WriteMutVarOp = primOpCodeSizeForeignCall +primOpCodeSize RaiseUnderflowOp = primOpCodeSizeForeignCall +primOpCodeSize RaiseOverflowOp = primOpCodeSizeForeignCall +primOpCodeSize RaiseDivZeroOp = primOpCodeSizeForeignCall primOpCodeSize TouchOp = 0 primOpCodeSize ParOp = primOpCodeSizeForeignCall primOpCodeSize SparkOp = primOpCodeSizeForeignCall 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 @@ -563,6 +563,9 @@ | CasMutVarOp | CatchOp | RaiseOp + | RaiseUnderflowOp + | RaiseOverflowOp + | RaiseDivZeroOp | RaiseIOOp | MaskAsyncExceptionsOp | MaskUninterruptibleOp 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 @@ -562,6 +562,9 @@ , CasMutVarOp , CatchOp , RaiseOp + , RaiseUnderflowOp + , RaiseOverflowOp + , RaiseDivZeroOp , RaiseIOOp , MaskAsyncExceptionsOp , MaskUninterruptibleOp diff --git a/ghc-lib/stage0/compiler/build/primop-out-of-line.hs-incl b/ghc-lib/stage0/compiler/build/primop-out-of-line.hs-incl --- a/ghc-lib/stage0/compiler/build/primop-out-of-line.hs-incl +++ b/ghc-lib/stage0/compiler/build/primop-out-of-line.hs-incl @@ -33,6 +33,9 @@ primOpOutOfLine CasMutVarOp = True primOpOutOfLine CatchOp = True primOpOutOfLine RaiseOp = True +primOpOutOfLine RaiseUnderflowOp = True +primOpOutOfLine RaiseOverflowOp = True +primOpOutOfLine RaiseDivZeroOp = True primOpOutOfLine RaiseIOOp = True primOpOutOfLine MaskAsyncExceptionsOp = True primOpOutOfLine MaskUninterruptibleOp = True 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 @@ -562,6 +562,9 @@ primOpInfo CasMutVarOp = mkGenPrimOp (fsLit "casMutVar#") [levity1TyVarInf, deltaTyVarSpec, levPolyAlphaTyVarSpec] [mkMutVarPrimTy deltaTy levPolyAlphaTy, levPolyAlphaTy, levPolyAlphaTy, mkStatePrimTy deltaTy] ((mkTupleTy Unboxed [mkStatePrimTy deltaTy, intPrimTy, levPolyAlphaTy])) primOpInfo CatchOp = mkGenPrimOp (fsLit "catch#") [runtimeRep1TyVarInf, levity2TyVarInf, openAlphaTyVarSpec, levPolyBetaTyVarSpec] [(mkVisFunTyMany (mkStatePrimTy realWorldTy) ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, openAlphaTy]))), (mkVisFunTyMany (levPolyBetaTy) ((mkVisFunTyMany (mkStatePrimTy realWorldTy) ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, openAlphaTy]))))), mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, openAlphaTy])) primOpInfo RaiseOp = mkGenPrimOp (fsLit "raise#") [levity1TyVarInf, runtimeRep2TyVarInf, levPolyAlphaTyVarSpec, openBetaTyVarSpec] [levPolyAlphaTy] (openBetaTy) +primOpInfo RaiseUnderflowOp = mkGenPrimOp (fsLit "raiseUnderflow#") [runtimeRep2TyVarInf, openBetaTyVarSpec] [(mkTupleTy Unboxed [])] (openBetaTy) +primOpInfo RaiseOverflowOp = mkGenPrimOp (fsLit "raiseOverflow#") [runtimeRep2TyVarInf, openBetaTyVarSpec] [(mkTupleTy Unboxed [])] (openBetaTy) +primOpInfo RaiseDivZeroOp = mkGenPrimOp (fsLit "raiseDivZero#") [runtimeRep2TyVarInf, openBetaTyVarSpec] [(mkTupleTy Unboxed [])] (openBetaTy) primOpInfo RaiseIOOp = mkGenPrimOp (fsLit "raiseIO#") [levity1TyVarInf, runtimeRep2TyVarInf, levPolyAlphaTyVarSpec, openBetaTyVarSpec] [levPolyAlphaTy, mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, openBetaTy])) primOpInfo MaskAsyncExceptionsOp = mkGenPrimOp (fsLit "maskAsyncExceptions#") [runtimeRep1TyVarInf, openAlphaTyVarSpec] [(mkVisFunTyMany (mkStatePrimTy realWorldTy) ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, openAlphaTy]))), mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, openAlphaTy])) primOpInfo MaskUninterruptibleOp = mkGenPrimOp (fsLit "maskUninterruptible#") [runtimeRep1TyVarInf, openAlphaTyVarSpec] [(mkVisFunTyMany (mkStatePrimTy realWorldTy) ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, openAlphaTy]))), mkStatePrimTy realWorldTy] ((mkTupleTy Unboxed [mkStatePrimTy realWorldTy, openAlphaTy])) @@ -661,16 +664,16 @@ primOpInfo (VecBroadcastOp IntVec 32 W16) = mkGenPrimOp (fsLit "broadcastInt16X32#") [] [int16PrimTy] (int16X32PrimTy) primOpInfo (VecBroadcastOp IntVec 16 W32) = mkGenPrimOp (fsLit "broadcastInt32X16#") [] [int32PrimTy] (int32X16PrimTy) primOpInfo (VecBroadcastOp IntVec 8 W64) = mkGenPrimOp (fsLit "broadcastInt64X8#") [] [int64PrimTy] (int64X8PrimTy) -primOpInfo (VecBroadcastOp WordVec 16 W8) = mkGenPrimOp (fsLit "broadcastWord8X16#") [] [wordPrimTy] (word8X16PrimTy) -primOpInfo (VecBroadcastOp WordVec 8 W16) = mkGenPrimOp (fsLit "broadcastWord16X8#") [] [wordPrimTy] (word16X8PrimTy) +primOpInfo (VecBroadcastOp WordVec 16 W8) = mkGenPrimOp (fsLit "broadcastWord8X16#") [] [word8PrimTy] (word8X16PrimTy) +primOpInfo (VecBroadcastOp WordVec 8 W16) = mkGenPrimOp (fsLit "broadcastWord16X8#") [] [word16PrimTy] (word16X8PrimTy) primOpInfo (VecBroadcastOp WordVec 4 W32) = mkGenPrimOp (fsLit "broadcastWord32X4#") [] [word32PrimTy] (word32X4PrimTy) primOpInfo (VecBroadcastOp WordVec 2 W64) = mkGenPrimOp (fsLit "broadcastWord64X2#") [] [word64PrimTy] (word64X2PrimTy) -primOpInfo (VecBroadcastOp WordVec 32 W8) = mkGenPrimOp (fsLit "broadcastWord8X32#") [] [wordPrimTy] (word8X32PrimTy) -primOpInfo (VecBroadcastOp WordVec 16 W16) = mkGenPrimOp (fsLit "broadcastWord16X16#") [] [wordPrimTy] (word16X16PrimTy) +primOpInfo (VecBroadcastOp WordVec 32 W8) = mkGenPrimOp (fsLit "broadcastWord8X32#") [] [word8PrimTy] (word8X32PrimTy) +primOpInfo (VecBroadcastOp WordVec 16 W16) = mkGenPrimOp (fsLit "broadcastWord16X16#") [] [word16PrimTy] (word16X16PrimTy) primOpInfo (VecBroadcastOp WordVec 8 W32) = mkGenPrimOp (fsLit "broadcastWord32X8#") [] [word32PrimTy] (word32X8PrimTy) primOpInfo (VecBroadcastOp WordVec 4 W64) = mkGenPrimOp (fsLit "broadcastWord64X4#") [] [word64PrimTy] (word64X4PrimTy) -primOpInfo (VecBroadcastOp WordVec 64 W8) = mkGenPrimOp (fsLit "broadcastWord8X64#") [] [wordPrimTy] (word8X64PrimTy) -primOpInfo (VecBroadcastOp WordVec 32 W16) = mkGenPrimOp (fsLit "broadcastWord16X32#") [] [wordPrimTy] (word16X32PrimTy) +primOpInfo (VecBroadcastOp WordVec 64 W8) = mkGenPrimOp (fsLit "broadcastWord8X64#") [] [word8PrimTy] (word8X64PrimTy) +primOpInfo (VecBroadcastOp WordVec 32 W16) = mkGenPrimOp (fsLit "broadcastWord16X32#") [] [word16PrimTy] (word16X32PrimTy) primOpInfo (VecBroadcastOp WordVec 16 W32) = mkGenPrimOp (fsLit "broadcastWord32X16#") [] [word32PrimTy] (word32X16PrimTy) primOpInfo (VecBroadcastOp WordVec 8 W64) = mkGenPrimOp (fsLit "broadcastWord64X8#") [] [word64PrimTy] (word64X8PrimTy) primOpInfo (VecBroadcastOp FloatVec 4 W32) = mkGenPrimOp (fsLit "broadcastFloatX4#") [] [floatPrimTy] (floatX4PrimTy) @@ -691,16 +694,16 @@ primOpInfo (VecPackOp IntVec 32 W16) = mkGenPrimOp (fsLit "packInt16X32#") [] [(mkTupleTy Unboxed [int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy])] (int16X32PrimTy) primOpInfo (VecPackOp IntVec 16 W32) = mkGenPrimOp (fsLit "packInt32X16#") [] [(mkTupleTy Unboxed [int32PrimTy, int32PrimTy, int32PrimTy, int32PrimTy, int32PrimTy, int32PrimTy, int32PrimTy, int32PrimTy, int32PrimTy, int32PrimTy, int32PrimTy, int32PrimTy, int32PrimTy, int32PrimTy, int32PrimTy, int32PrimTy])] (int32X16PrimTy) primOpInfo (VecPackOp IntVec 8 W64) = mkGenPrimOp (fsLit "packInt64X8#") [] [(mkTupleTy Unboxed [int64PrimTy, int64PrimTy, int64PrimTy, int64PrimTy, int64PrimTy, int64PrimTy, int64PrimTy, int64PrimTy])] (int64X8PrimTy) -primOpInfo (VecPackOp WordVec 16 W8) = mkGenPrimOp (fsLit "packWord8X16#") [] [(mkTupleTy Unboxed [wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy])] (word8X16PrimTy) -primOpInfo (VecPackOp WordVec 8 W16) = mkGenPrimOp (fsLit "packWord16X8#") [] [(mkTupleTy Unboxed [wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy])] (word16X8PrimTy) +primOpInfo (VecPackOp WordVec 16 W8) = mkGenPrimOp (fsLit "packWord8X16#") [] [(mkTupleTy Unboxed [word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy])] (word8X16PrimTy) +primOpInfo (VecPackOp WordVec 8 W16) = mkGenPrimOp (fsLit "packWord16X8#") [] [(mkTupleTy Unboxed [word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy])] (word16X8PrimTy) primOpInfo (VecPackOp WordVec 4 W32) = mkGenPrimOp (fsLit "packWord32X4#") [] [(mkTupleTy Unboxed [word32PrimTy, word32PrimTy, word32PrimTy, word32PrimTy])] (word32X4PrimTy) primOpInfo (VecPackOp WordVec 2 W64) = mkGenPrimOp (fsLit "packWord64X2#") [] [(mkTupleTy Unboxed [word64PrimTy, word64PrimTy])] (word64X2PrimTy) -primOpInfo (VecPackOp WordVec 32 W8) = mkGenPrimOp (fsLit "packWord8X32#") [] [(mkTupleTy Unboxed [wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy])] (word8X32PrimTy) -primOpInfo (VecPackOp WordVec 16 W16) = mkGenPrimOp (fsLit "packWord16X16#") [] [(mkTupleTy Unboxed [wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy])] (word16X16PrimTy) +primOpInfo (VecPackOp WordVec 32 W8) = mkGenPrimOp (fsLit "packWord8X32#") [] [(mkTupleTy Unboxed [word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy])] (word8X32PrimTy) +primOpInfo (VecPackOp WordVec 16 W16) = mkGenPrimOp (fsLit "packWord16X16#") [] [(mkTupleTy Unboxed [word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy])] (word16X16PrimTy) primOpInfo (VecPackOp WordVec 8 W32) = mkGenPrimOp (fsLit "packWord32X8#") [] [(mkTupleTy Unboxed [word32PrimTy, word32PrimTy, word32PrimTy, word32PrimTy, word32PrimTy, word32PrimTy, word32PrimTy, word32PrimTy])] (word32X8PrimTy) primOpInfo (VecPackOp WordVec 4 W64) = mkGenPrimOp (fsLit "packWord64X4#") [] [(mkTupleTy Unboxed [word64PrimTy, word64PrimTy, word64PrimTy, word64PrimTy])] (word64X4PrimTy) -primOpInfo (VecPackOp WordVec 64 W8) = mkGenPrimOp (fsLit "packWord8X64#") [] [(mkTupleTy Unboxed [wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy])] (word8X64PrimTy) -primOpInfo (VecPackOp WordVec 32 W16) = mkGenPrimOp (fsLit "packWord16X32#") [] [(mkTupleTy Unboxed [wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy])] (word16X32PrimTy) +primOpInfo (VecPackOp WordVec 64 W8) = mkGenPrimOp (fsLit "packWord8X64#") [] [(mkTupleTy Unboxed [word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy])] (word8X64PrimTy) +primOpInfo (VecPackOp WordVec 32 W16) = mkGenPrimOp (fsLit "packWord16X32#") [] [(mkTupleTy Unboxed [word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy])] (word16X32PrimTy) primOpInfo (VecPackOp WordVec 16 W32) = mkGenPrimOp (fsLit "packWord32X16#") [] [(mkTupleTy Unboxed [word32PrimTy, word32PrimTy, word32PrimTy, word32PrimTy, word32PrimTy, word32PrimTy, word32PrimTy, word32PrimTy, word32PrimTy, word32PrimTy, word32PrimTy, word32PrimTy, word32PrimTy, word32PrimTy, word32PrimTy, word32PrimTy])] (word32X16PrimTy) primOpInfo (VecPackOp WordVec 8 W64) = mkGenPrimOp (fsLit "packWord64X8#") [] [(mkTupleTy Unboxed [word64PrimTy, word64PrimTy, word64PrimTy, word64PrimTy, word64PrimTy, word64PrimTy, word64PrimTy, word64PrimTy])] (word64X8PrimTy) primOpInfo (VecPackOp FloatVec 4 W32) = mkGenPrimOp (fsLit "packFloatX4#") [] [(mkTupleTy Unboxed [floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy])] (floatX4PrimTy) @@ -721,16 +724,16 @@ primOpInfo (VecUnpackOp IntVec 32 W16) = mkGenPrimOp (fsLit "unpackInt16X32#") [] [int16X32PrimTy] ((mkTupleTy Unboxed [int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy, int16PrimTy])) primOpInfo (VecUnpackOp IntVec 16 W32) = mkGenPrimOp (fsLit "unpackInt32X16#") [] [int32X16PrimTy] ((mkTupleTy Unboxed [int32PrimTy, int32PrimTy, int32PrimTy, int32PrimTy, int32PrimTy, int32PrimTy, int32PrimTy, int32PrimTy, int32PrimTy, int32PrimTy, int32PrimTy, int32PrimTy, int32PrimTy, int32PrimTy, int32PrimTy, int32PrimTy])) primOpInfo (VecUnpackOp IntVec 8 W64) = mkGenPrimOp (fsLit "unpackInt64X8#") [] [int64X8PrimTy] ((mkTupleTy Unboxed [int64PrimTy, int64PrimTy, int64PrimTy, int64PrimTy, int64PrimTy, int64PrimTy, int64PrimTy, int64PrimTy])) -primOpInfo (VecUnpackOp WordVec 16 W8) = mkGenPrimOp (fsLit "unpackWord8X16#") [] [word8X16PrimTy] ((mkTupleTy Unboxed [wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy])) -primOpInfo (VecUnpackOp WordVec 8 W16) = mkGenPrimOp (fsLit "unpackWord16X8#") [] [word16X8PrimTy] ((mkTupleTy Unboxed [wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy])) +primOpInfo (VecUnpackOp WordVec 16 W8) = mkGenPrimOp (fsLit "unpackWord8X16#") [] [word8X16PrimTy] ((mkTupleTy Unboxed [word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy])) +primOpInfo (VecUnpackOp WordVec 8 W16) = mkGenPrimOp (fsLit "unpackWord16X8#") [] [word16X8PrimTy] ((mkTupleTy Unboxed [word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy])) primOpInfo (VecUnpackOp WordVec 4 W32) = mkGenPrimOp (fsLit "unpackWord32X4#") [] [word32X4PrimTy] ((mkTupleTy Unboxed [word32PrimTy, word32PrimTy, word32PrimTy, word32PrimTy])) primOpInfo (VecUnpackOp WordVec 2 W64) = mkGenPrimOp (fsLit "unpackWord64X2#") [] [word64X2PrimTy] ((mkTupleTy Unboxed [word64PrimTy, word64PrimTy])) -primOpInfo (VecUnpackOp WordVec 32 W8) = mkGenPrimOp (fsLit "unpackWord8X32#") [] [word8X32PrimTy] ((mkTupleTy Unboxed [wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy])) -primOpInfo (VecUnpackOp WordVec 16 W16) = mkGenPrimOp (fsLit "unpackWord16X16#") [] [word16X16PrimTy] ((mkTupleTy Unboxed [wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy])) +primOpInfo (VecUnpackOp WordVec 32 W8) = mkGenPrimOp (fsLit "unpackWord8X32#") [] [word8X32PrimTy] ((mkTupleTy Unboxed [word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy])) +primOpInfo (VecUnpackOp WordVec 16 W16) = mkGenPrimOp (fsLit "unpackWord16X16#") [] [word16X16PrimTy] ((mkTupleTy Unboxed [word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy])) primOpInfo (VecUnpackOp WordVec 8 W32) = mkGenPrimOp (fsLit "unpackWord32X8#") [] [word32X8PrimTy] ((mkTupleTy Unboxed [word32PrimTy, word32PrimTy, word32PrimTy, word32PrimTy, word32PrimTy, word32PrimTy, word32PrimTy, word32PrimTy])) primOpInfo (VecUnpackOp WordVec 4 W64) = mkGenPrimOp (fsLit "unpackWord64X4#") [] [word64X4PrimTy] ((mkTupleTy Unboxed [word64PrimTy, word64PrimTy, word64PrimTy, word64PrimTy])) -primOpInfo (VecUnpackOp WordVec 64 W8) = mkGenPrimOp (fsLit "unpackWord8X64#") [] [word8X64PrimTy] ((mkTupleTy Unboxed [wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy])) -primOpInfo (VecUnpackOp WordVec 32 W16) = mkGenPrimOp (fsLit "unpackWord16X32#") [] [word16X32PrimTy] ((mkTupleTy Unboxed [wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy, wordPrimTy])) +primOpInfo (VecUnpackOp WordVec 64 W8) = mkGenPrimOp (fsLit "unpackWord8X64#") [] [word8X64PrimTy] ((mkTupleTy Unboxed [word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy, word8PrimTy])) +primOpInfo (VecUnpackOp WordVec 32 W16) = mkGenPrimOp (fsLit "unpackWord16X32#") [] [word16X32PrimTy] ((mkTupleTy Unboxed [word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy, word16PrimTy])) primOpInfo (VecUnpackOp WordVec 16 W32) = mkGenPrimOp (fsLit "unpackWord32X16#") [] [word32X16PrimTy] ((mkTupleTy Unboxed [word32PrimTy, word32PrimTy, word32PrimTy, word32PrimTy, word32PrimTy, word32PrimTy, word32PrimTy, word32PrimTy, word32PrimTy, word32PrimTy, word32PrimTy, word32PrimTy, word32PrimTy, word32PrimTy, word32PrimTy, word32PrimTy])) primOpInfo (VecUnpackOp WordVec 8 W64) = mkGenPrimOp (fsLit "unpackWord64X8#") [] [word64X8PrimTy] ((mkTupleTy Unboxed [word64PrimTy, word64PrimTy, word64PrimTy, word64PrimTy, word64PrimTy, word64PrimTy, word64PrimTy, word64PrimTy])) primOpInfo (VecUnpackOp FloatVec 4 W32) = mkGenPrimOp (fsLit "unpackFloatX4#") [] [floatX4PrimTy] ((mkTupleTy Unboxed [floatPrimTy, floatPrimTy, floatPrimTy, floatPrimTy])) @@ -751,16 +754,16 @@ primOpInfo (VecInsertOp IntVec 32 W16) = mkGenPrimOp (fsLit "insertInt16X32#") [] [int16X32PrimTy, int16PrimTy, intPrimTy] (int16X32PrimTy) primOpInfo (VecInsertOp IntVec 16 W32) = mkGenPrimOp (fsLit "insertInt32X16#") [] [int32X16PrimTy, int32PrimTy, intPrimTy] (int32X16PrimTy) primOpInfo (VecInsertOp IntVec 8 W64) = mkGenPrimOp (fsLit "insertInt64X8#") [] [int64X8PrimTy, int64PrimTy, intPrimTy] (int64X8PrimTy) -primOpInfo (VecInsertOp WordVec 16 W8) = mkGenPrimOp (fsLit "insertWord8X16#") [] [word8X16PrimTy, wordPrimTy, intPrimTy] (word8X16PrimTy) -primOpInfo (VecInsertOp WordVec 8 W16) = mkGenPrimOp (fsLit "insertWord16X8#") [] [word16X8PrimTy, wordPrimTy, intPrimTy] (word16X8PrimTy) +primOpInfo (VecInsertOp WordVec 16 W8) = mkGenPrimOp (fsLit "insertWord8X16#") [] [word8X16PrimTy, word8PrimTy, intPrimTy] (word8X16PrimTy) +primOpInfo (VecInsertOp WordVec 8 W16) = mkGenPrimOp (fsLit "insertWord16X8#") [] [word16X8PrimTy, word16PrimTy, intPrimTy] (word16X8PrimTy) primOpInfo (VecInsertOp WordVec 4 W32) = mkGenPrimOp (fsLit "insertWord32X4#") [] [word32X4PrimTy, word32PrimTy, intPrimTy] (word32X4PrimTy) primOpInfo (VecInsertOp WordVec 2 W64) = mkGenPrimOp (fsLit "insertWord64X2#") [] [word64X2PrimTy, word64PrimTy, intPrimTy] (word64X2PrimTy) -primOpInfo (VecInsertOp WordVec 32 W8) = mkGenPrimOp (fsLit "insertWord8X32#") [] [word8X32PrimTy, wordPrimTy, intPrimTy] (word8X32PrimTy) -primOpInfo (VecInsertOp WordVec 16 W16) = mkGenPrimOp (fsLit "insertWord16X16#") [] [word16X16PrimTy, wordPrimTy, intPrimTy] (word16X16PrimTy) +primOpInfo (VecInsertOp WordVec 32 W8) = mkGenPrimOp (fsLit "insertWord8X32#") [] [word8X32PrimTy, word8PrimTy, intPrimTy] (word8X32PrimTy) +primOpInfo (VecInsertOp WordVec 16 W16) = mkGenPrimOp (fsLit "insertWord16X16#") [] [word16X16PrimTy, word16PrimTy, intPrimTy] (word16X16PrimTy) primOpInfo (VecInsertOp WordVec 8 W32) = mkGenPrimOp (fsLit "insertWord32X8#") [] [word32X8PrimTy, word32PrimTy, intPrimTy] (word32X8PrimTy) primOpInfo (VecInsertOp WordVec 4 W64) = mkGenPrimOp (fsLit "insertWord64X4#") [] [word64X4PrimTy, word64PrimTy, intPrimTy] (word64X4PrimTy) -primOpInfo (VecInsertOp WordVec 64 W8) = mkGenPrimOp (fsLit "insertWord8X64#") [] [word8X64PrimTy, wordPrimTy, intPrimTy] (word8X64PrimTy) -primOpInfo (VecInsertOp WordVec 32 W16) = mkGenPrimOp (fsLit "insertWord16X32#") [] [word16X32PrimTy, wordPrimTy, intPrimTy] (word16X32PrimTy) +primOpInfo (VecInsertOp WordVec 64 W8) = mkGenPrimOp (fsLit "insertWord8X64#") [] [word8X64PrimTy, word8PrimTy, intPrimTy] (word8X64PrimTy) +primOpInfo (VecInsertOp WordVec 32 W16) = mkGenPrimOp (fsLit "insertWord16X32#") [] [word16X32PrimTy, word16PrimTy, intPrimTy] (word16X32PrimTy) primOpInfo (VecInsertOp WordVec 16 W32) = mkGenPrimOp (fsLit "insertWord32X16#") [] [word32X16PrimTy, word32PrimTy, intPrimTy] (word32X16PrimTy) primOpInfo (VecInsertOp WordVec 8 W64) = mkGenPrimOp (fsLit "insertWord64X8#") [] [word64X8PrimTy, word64PrimTy, intPrimTy] (word64X8PrimTy) primOpInfo (VecInsertOp FloatVec 4 W32) = mkGenPrimOp (fsLit "insertFloatX4#") [] [floatX4PrimTy, floatPrimTy, intPrimTy] (floatX4PrimTy) diff --git a/ghc-lib/stage0/compiler/build/primop-strictness.hs-incl b/ghc-lib/stage0/compiler/build/primop-strictness.hs-incl --- a/ghc-lib/stage0/compiler/build/primop-strictness.hs-incl +++ b/ghc-lib/stage0/compiler/build/primop-strictness.hs-incl @@ -2,6 +2,9 @@ , lazyApply2Dmd , topDmd] topDiv primOpStrictness RaiseOp = \ _arity -> mkClosedDmdSig [topDmd] botDiv +primOpStrictness RaiseUnderflowOp = \ _arity -> mkClosedDmdSig [topDmd] botDiv +primOpStrictness RaiseOverflowOp = \ _arity -> mkClosedDmdSig [topDmd] botDiv +primOpStrictness RaiseDivZeroOp = \ _arity -> mkClosedDmdSig [topDmd] botDiv primOpStrictness RaiseIOOp = \ _arity -> mkClosedDmdSig [topDmd, topDmd] exnDiv primOpStrictness MaskAsyncExceptionsOp = \ _arity -> mkClosedDmdSig [strictOnceApply1Dmd,topDmd] topDiv primOpStrictness MaskUninterruptibleOp = \ _arity -> mkClosedDmdSig [strictOnceApply1Dmd,topDmd] topDiv 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,1312 +1,1315 @@ maxPrimOpTag :: Int -maxPrimOpTag = 1308 -primOpTag :: PrimOp -> Int -primOpTag CharGtOp = 0 -primOpTag CharGeOp = 1 -primOpTag CharEqOp = 2 -primOpTag CharNeOp = 3 -primOpTag CharLtOp = 4 -primOpTag CharLeOp = 5 -primOpTag OrdOp = 6 -primOpTag Int8ToIntOp = 7 -primOpTag IntToInt8Op = 8 -primOpTag Int8NegOp = 9 -primOpTag Int8AddOp = 10 -primOpTag Int8SubOp = 11 -primOpTag Int8MulOp = 12 -primOpTag Int8QuotOp = 13 -primOpTag Int8RemOp = 14 -primOpTag Int8QuotRemOp = 15 -primOpTag Int8SllOp = 16 -primOpTag Int8SraOp = 17 -primOpTag Int8SrlOp = 18 -primOpTag Int8ToWord8Op = 19 -primOpTag Int8EqOp = 20 -primOpTag Int8GeOp = 21 -primOpTag Int8GtOp = 22 -primOpTag Int8LeOp = 23 -primOpTag Int8LtOp = 24 -primOpTag Int8NeOp = 25 -primOpTag Word8ToWordOp = 26 -primOpTag WordToWord8Op = 27 -primOpTag Word8AddOp = 28 -primOpTag Word8SubOp = 29 -primOpTag Word8MulOp = 30 -primOpTag Word8QuotOp = 31 -primOpTag Word8RemOp = 32 -primOpTag Word8QuotRemOp = 33 -primOpTag Word8AndOp = 34 -primOpTag Word8OrOp = 35 -primOpTag Word8XorOp = 36 -primOpTag Word8NotOp = 37 -primOpTag Word8SllOp = 38 -primOpTag Word8SrlOp = 39 -primOpTag Word8ToInt8Op = 40 -primOpTag Word8EqOp = 41 -primOpTag Word8GeOp = 42 -primOpTag Word8GtOp = 43 -primOpTag Word8LeOp = 44 -primOpTag Word8LtOp = 45 -primOpTag Word8NeOp = 46 -primOpTag Int16ToIntOp = 47 -primOpTag IntToInt16Op = 48 -primOpTag Int16NegOp = 49 -primOpTag Int16AddOp = 50 -primOpTag Int16SubOp = 51 -primOpTag Int16MulOp = 52 -primOpTag Int16QuotOp = 53 -primOpTag Int16RemOp = 54 -primOpTag Int16QuotRemOp = 55 -primOpTag Int16SllOp = 56 -primOpTag Int16SraOp = 57 -primOpTag Int16SrlOp = 58 -primOpTag Int16ToWord16Op = 59 -primOpTag Int16EqOp = 60 -primOpTag Int16GeOp = 61 -primOpTag Int16GtOp = 62 -primOpTag Int16LeOp = 63 -primOpTag Int16LtOp = 64 -primOpTag Int16NeOp = 65 -primOpTag Word16ToWordOp = 66 -primOpTag WordToWord16Op = 67 -primOpTag Word16AddOp = 68 -primOpTag Word16SubOp = 69 -primOpTag Word16MulOp = 70 -primOpTag Word16QuotOp = 71 -primOpTag Word16RemOp = 72 -primOpTag Word16QuotRemOp = 73 -primOpTag Word16AndOp = 74 -primOpTag Word16OrOp = 75 -primOpTag Word16XorOp = 76 -primOpTag Word16NotOp = 77 -primOpTag Word16SllOp = 78 -primOpTag Word16SrlOp = 79 -primOpTag Word16ToInt16Op = 80 -primOpTag Word16EqOp = 81 -primOpTag Word16GeOp = 82 -primOpTag Word16GtOp = 83 -primOpTag Word16LeOp = 84 -primOpTag Word16LtOp = 85 -primOpTag Word16NeOp = 86 -primOpTag Int32ToIntOp = 87 -primOpTag IntToInt32Op = 88 -primOpTag Int32NegOp = 89 -primOpTag Int32AddOp = 90 -primOpTag Int32SubOp = 91 -primOpTag Int32MulOp = 92 -primOpTag Int32QuotOp = 93 -primOpTag Int32RemOp = 94 -primOpTag Int32QuotRemOp = 95 -primOpTag Int32SllOp = 96 -primOpTag Int32SraOp = 97 -primOpTag Int32SrlOp = 98 -primOpTag Int32ToWord32Op = 99 -primOpTag Int32EqOp = 100 -primOpTag Int32GeOp = 101 -primOpTag Int32GtOp = 102 -primOpTag Int32LeOp = 103 -primOpTag Int32LtOp = 104 -primOpTag Int32NeOp = 105 -primOpTag Word32ToWordOp = 106 -primOpTag WordToWord32Op = 107 -primOpTag Word32AddOp = 108 -primOpTag Word32SubOp = 109 -primOpTag Word32MulOp = 110 -primOpTag Word32QuotOp = 111 -primOpTag Word32RemOp = 112 -primOpTag Word32QuotRemOp = 113 -primOpTag Word32AndOp = 114 -primOpTag Word32OrOp = 115 -primOpTag Word32XorOp = 116 -primOpTag Word32NotOp = 117 -primOpTag Word32SllOp = 118 -primOpTag Word32SrlOp = 119 -primOpTag Word32ToInt32Op = 120 -primOpTag Word32EqOp = 121 -primOpTag Word32GeOp = 122 -primOpTag Word32GtOp = 123 -primOpTag Word32LeOp = 124 -primOpTag Word32LtOp = 125 -primOpTag Word32NeOp = 126 -primOpTag Int64ToIntOp = 127 -primOpTag IntToInt64Op = 128 -primOpTag Int64NegOp = 129 -primOpTag Int64AddOp = 130 -primOpTag Int64SubOp = 131 -primOpTag Int64MulOp = 132 -primOpTag Int64QuotOp = 133 -primOpTag Int64RemOp = 134 -primOpTag Int64SllOp = 135 -primOpTag Int64SraOp = 136 -primOpTag Int64SrlOp = 137 -primOpTag Int64ToWord64Op = 138 -primOpTag Int64EqOp = 139 -primOpTag Int64GeOp = 140 -primOpTag Int64GtOp = 141 -primOpTag Int64LeOp = 142 -primOpTag Int64LtOp = 143 -primOpTag Int64NeOp = 144 -primOpTag Word64ToWordOp = 145 -primOpTag WordToWord64Op = 146 -primOpTag Word64AddOp = 147 -primOpTag Word64SubOp = 148 -primOpTag Word64MulOp = 149 -primOpTag Word64QuotOp = 150 -primOpTag Word64RemOp = 151 -primOpTag Word64AndOp = 152 -primOpTag Word64OrOp = 153 -primOpTag Word64XorOp = 154 -primOpTag Word64NotOp = 155 -primOpTag Word64SllOp = 156 -primOpTag Word64SrlOp = 157 -primOpTag Word64ToInt64Op = 158 -primOpTag Word64EqOp = 159 -primOpTag Word64GeOp = 160 -primOpTag Word64GtOp = 161 -primOpTag Word64LeOp = 162 -primOpTag Word64LtOp = 163 -primOpTag Word64NeOp = 164 -primOpTag IntAddOp = 165 -primOpTag IntSubOp = 166 -primOpTag IntMulOp = 167 -primOpTag IntMul2Op = 168 -primOpTag IntMulMayOfloOp = 169 -primOpTag IntQuotOp = 170 -primOpTag IntRemOp = 171 -primOpTag IntQuotRemOp = 172 -primOpTag IntAndOp = 173 -primOpTag IntOrOp = 174 -primOpTag IntXorOp = 175 -primOpTag IntNotOp = 176 -primOpTag IntNegOp = 177 -primOpTag IntAddCOp = 178 -primOpTag IntSubCOp = 179 -primOpTag IntGtOp = 180 -primOpTag IntGeOp = 181 -primOpTag IntEqOp = 182 -primOpTag IntNeOp = 183 -primOpTag IntLtOp = 184 -primOpTag IntLeOp = 185 -primOpTag ChrOp = 186 -primOpTag IntToWordOp = 187 -primOpTag IntToFloatOp = 188 -primOpTag IntToDoubleOp = 189 -primOpTag WordToFloatOp = 190 -primOpTag WordToDoubleOp = 191 -primOpTag IntSllOp = 192 -primOpTag IntSraOp = 193 -primOpTag IntSrlOp = 194 -primOpTag WordAddOp = 195 -primOpTag WordAddCOp = 196 -primOpTag WordSubCOp = 197 -primOpTag WordAdd2Op = 198 -primOpTag WordSubOp = 199 -primOpTag WordMulOp = 200 -primOpTag WordMul2Op = 201 -primOpTag WordQuotOp = 202 -primOpTag WordRemOp = 203 -primOpTag WordQuotRemOp = 204 -primOpTag WordQuotRem2Op = 205 -primOpTag WordAndOp = 206 -primOpTag WordOrOp = 207 -primOpTag WordXorOp = 208 -primOpTag WordNotOp = 209 -primOpTag WordSllOp = 210 -primOpTag WordSrlOp = 211 -primOpTag WordToIntOp = 212 -primOpTag WordGtOp = 213 -primOpTag WordGeOp = 214 -primOpTag WordEqOp = 215 -primOpTag WordNeOp = 216 -primOpTag WordLtOp = 217 -primOpTag WordLeOp = 218 -primOpTag PopCnt8Op = 219 -primOpTag PopCnt16Op = 220 -primOpTag PopCnt32Op = 221 -primOpTag PopCnt64Op = 222 -primOpTag PopCntOp = 223 -primOpTag Pdep8Op = 224 -primOpTag Pdep16Op = 225 -primOpTag Pdep32Op = 226 -primOpTag Pdep64Op = 227 -primOpTag PdepOp = 228 -primOpTag Pext8Op = 229 -primOpTag Pext16Op = 230 -primOpTag Pext32Op = 231 -primOpTag Pext64Op = 232 -primOpTag PextOp = 233 -primOpTag Clz8Op = 234 -primOpTag Clz16Op = 235 -primOpTag Clz32Op = 236 -primOpTag Clz64Op = 237 -primOpTag ClzOp = 238 -primOpTag Ctz8Op = 239 -primOpTag Ctz16Op = 240 -primOpTag Ctz32Op = 241 -primOpTag Ctz64Op = 242 -primOpTag CtzOp = 243 -primOpTag BSwap16Op = 244 -primOpTag BSwap32Op = 245 -primOpTag BSwap64Op = 246 -primOpTag BSwapOp = 247 -primOpTag BRev8Op = 248 -primOpTag BRev16Op = 249 -primOpTag BRev32Op = 250 -primOpTag BRev64Op = 251 -primOpTag BRevOp = 252 -primOpTag Narrow8IntOp = 253 -primOpTag Narrow16IntOp = 254 -primOpTag Narrow32IntOp = 255 -primOpTag Narrow8WordOp = 256 -primOpTag Narrow16WordOp = 257 -primOpTag Narrow32WordOp = 258 -primOpTag DoubleGtOp = 259 -primOpTag DoubleGeOp = 260 -primOpTag DoubleEqOp = 261 -primOpTag DoubleNeOp = 262 -primOpTag DoubleLtOp = 263 -primOpTag DoubleLeOp = 264 -primOpTag DoubleAddOp = 265 -primOpTag DoubleSubOp = 266 -primOpTag DoubleMulOp = 267 -primOpTag DoubleDivOp = 268 -primOpTag DoubleNegOp = 269 -primOpTag DoubleFabsOp = 270 -primOpTag DoubleToIntOp = 271 -primOpTag DoubleToFloatOp = 272 -primOpTag DoubleExpOp = 273 -primOpTag DoubleExpM1Op = 274 -primOpTag DoubleLogOp = 275 -primOpTag DoubleLog1POp = 276 -primOpTag DoubleSqrtOp = 277 -primOpTag DoubleSinOp = 278 -primOpTag DoubleCosOp = 279 -primOpTag DoubleTanOp = 280 -primOpTag DoubleAsinOp = 281 -primOpTag DoubleAcosOp = 282 -primOpTag DoubleAtanOp = 283 -primOpTag DoubleSinhOp = 284 -primOpTag DoubleCoshOp = 285 -primOpTag DoubleTanhOp = 286 -primOpTag DoubleAsinhOp = 287 -primOpTag DoubleAcoshOp = 288 -primOpTag DoubleAtanhOp = 289 -primOpTag DoublePowerOp = 290 -primOpTag DoubleDecode_2IntOp = 291 -primOpTag DoubleDecode_Int64Op = 292 -primOpTag FloatGtOp = 293 -primOpTag FloatGeOp = 294 -primOpTag FloatEqOp = 295 -primOpTag FloatNeOp = 296 -primOpTag FloatLtOp = 297 -primOpTag FloatLeOp = 298 -primOpTag FloatAddOp = 299 -primOpTag FloatSubOp = 300 -primOpTag FloatMulOp = 301 -primOpTag FloatDivOp = 302 -primOpTag FloatNegOp = 303 -primOpTag FloatFabsOp = 304 -primOpTag FloatToIntOp = 305 -primOpTag FloatExpOp = 306 -primOpTag FloatExpM1Op = 307 -primOpTag FloatLogOp = 308 -primOpTag FloatLog1POp = 309 -primOpTag FloatSqrtOp = 310 -primOpTag FloatSinOp = 311 -primOpTag FloatCosOp = 312 -primOpTag FloatTanOp = 313 -primOpTag FloatAsinOp = 314 -primOpTag FloatAcosOp = 315 -primOpTag FloatAtanOp = 316 -primOpTag FloatSinhOp = 317 -primOpTag FloatCoshOp = 318 -primOpTag FloatTanhOp = 319 -primOpTag FloatAsinhOp = 320 -primOpTag FloatAcoshOp = 321 -primOpTag FloatAtanhOp = 322 -primOpTag FloatPowerOp = 323 -primOpTag FloatToDoubleOp = 324 -primOpTag FloatDecode_IntOp = 325 -primOpTag NewArrayOp = 326 -primOpTag ReadArrayOp = 327 -primOpTag WriteArrayOp = 328 -primOpTag SizeofArrayOp = 329 -primOpTag SizeofMutableArrayOp = 330 -primOpTag IndexArrayOp = 331 -primOpTag UnsafeFreezeArrayOp = 332 -primOpTag UnsafeThawArrayOp = 333 -primOpTag CopyArrayOp = 334 -primOpTag CopyMutableArrayOp = 335 -primOpTag CloneArrayOp = 336 -primOpTag CloneMutableArrayOp = 337 -primOpTag FreezeArrayOp = 338 -primOpTag ThawArrayOp = 339 -primOpTag CasArrayOp = 340 -primOpTag NewSmallArrayOp = 341 -primOpTag ShrinkSmallMutableArrayOp_Char = 342 -primOpTag ReadSmallArrayOp = 343 -primOpTag WriteSmallArrayOp = 344 -primOpTag SizeofSmallArrayOp = 345 -primOpTag SizeofSmallMutableArrayOp = 346 -primOpTag GetSizeofSmallMutableArrayOp = 347 -primOpTag IndexSmallArrayOp = 348 -primOpTag UnsafeFreezeSmallArrayOp = 349 -primOpTag UnsafeThawSmallArrayOp = 350 -primOpTag CopySmallArrayOp = 351 -primOpTag CopySmallMutableArrayOp = 352 -primOpTag CloneSmallArrayOp = 353 -primOpTag CloneSmallMutableArrayOp = 354 -primOpTag FreezeSmallArrayOp = 355 -primOpTag ThawSmallArrayOp = 356 -primOpTag CasSmallArrayOp = 357 -primOpTag NewByteArrayOp_Char = 358 -primOpTag NewPinnedByteArrayOp_Char = 359 -primOpTag NewAlignedPinnedByteArrayOp_Char = 360 -primOpTag MutableByteArrayIsPinnedOp = 361 -primOpTag ByteArrayIsPinnedOp = 362 -primOpTag ByteArrayContents_Char = 363 -primOpTag MutableByteArrayContents_Char = 364 -primOpTag ShrinkMutableByteArrayOp_Char = 365 -primOpTag ResizeMutableByteArrayOp_Char = 366 -primOpTag UnsafeFreezeByteArrayOp = 367 -primOpTag SizeofByteArrayOp = 368 -primOpTag SizeofMutableByteArrayOp = 369 -primOpTag GetSizeofMutableByteArrayOp = 370 -primOpTag IndexByteArrayOp_Char = 371 -primOpTag IndexByteArrayOp_WideChar = 372 -primOpTag IndexByteArrayOp_Int = 373 -primOpTag IndexByteArrayOp_Word = 374 -primOpTag IndexByteArrayOp_Addr = 375 -primOpTag IndexByteArrayOp_Float = 376 -primOpTag IndexByteArrayOp_Double = 377 -primOpTag IndexByteArrayOp_StablePtr = 378 -primOpTag IndexByteArrayOp_Int8 = 379 -primOpTag IndexByteArrayOp_Int16 = 380 -primOpTag IndexByteArrayOp_Int32 = 381 -primOpTag IndexByteArrayOp_Int64 = 382 -primOpTag IndexByteArrayOp_Word8 = 383 -primOpTag IndexByteArrayOp_Word16 = 384 -primOpTag IndexByteArrayOp_Word32 = 385 -primOpTag IndexByteArrayOp_Word64 = 386 -primOpTag IndexByteArrayOp_Word8AsChar = 387 -primOpTag IndexByteArrayOp_Word8AsWideChar = 388 -primOpTag IndexByteArrayOp_Word8AsInt = 389 -primOpTag IndexByteArrayOp_Word8AsWord = 390 -primOpTag IndexByteArrayOp_Word8AsAddr = 391 -primOpTag IndexByteArrayOp_Word8AsFloat = 392 -primOpTag IndexByteArrayOp_Word8AsDouble = 393 -primOpTag IndexByteArrayOp_Word8AsStablePtr = 394 -primOpTag IndexByteArrayOp_Word8AsInt16 = 395 -primOpTag IndexByteArrayOp_Word8AsInt32 = 396 -primOpTag IndexByteArrayOp_Word8AsInt64 = 397 -primOpTag IndexByteArrayOp_Word8AsWord16 = 398 -primOpTag IndexByteArrayOp_Word8AsWord32 = 399 -primOpTag IndexByteArrayOp_Word8AsWord64 = 400 -primOpTag ReadByteArrayOp_Char = 401 -primOpTag ReadByteArrayOp_WideChar = 402 -primOpTag ReadByteArrayOp_Int = 403 -primOpTag ReadByteArrayOp_Word = 404 -primOpTag ReadByteArrayOp_Addr = 405 -primOpTag ReadByteArrayOp_Float = 406 -primOpTag ReadByteArrayOp_Double = 407 -primOpTag ReadByteArrayOp_StablePtr = 408 -primOpTag ReadByteArrayOp_Int8 = 409 -primOpTag ReadByteArrayOp_Int16 = 410 -primOpTag ReadByteArrayOp_Int32 = 411 -primOpTag ReadByteArrayOp_Int64 = 412 -primOpTag ReadByteArrayOp_Word8 = 413 -primOpTag ReadByteArrayOp_Word16 = 414 -primOpTag ReadByteArrayOp_Word32 = 415 -primOpTag ReadByteArrayOp_Word64 = 416 -primOpTag ReadByteArrayOp_Word8AsChar = 417 -primOpTag ReadByteArrayOp_Word8AsWideChar = 418 -primOpTag ReadByteArrayOp_Word8AsInt = 419 -primOpTag ReadByteArrayOp_Word8AsWord = 420 -primOpTag ReadByteArrayOp_Word8AsAddr = 421 -primOpTag ReadByteArrayOp_Word8AsFloat = 422 -primOpTag ReadByteArrayOp_Word8AsDouble = 423 -primOpTag ReadByteArrayOp_Word8AsStablePtr = 424 -primOpTag ReadByteArrayOp_Word8AsInt16 = 425 -primOpTag ReadByteArrayOp_Word8AsInt32 = 426 -primOpTag ReadByteArrayOp_Word8AsInt64 = 427 -primOpTag ReadByteArrayOp_Word8AsWord16 = 428 -primOpTag ReadByteArrayOp_Word8AsWord32 = 429 -primOpTag ReadByteArrayOp_Word8AsWord64 = 430 -primOpTag WriteByteArrayOp_Char = 431 -primOpTag WriteByteArrayOp_WideChar = 432 -primOpTag WriteByteArrayOp_Int = 433 -primOpTag WriteByteArrayOp_Word = 434 -primOpTag WriteByteArrayOp_Addr = 435 -primOpTag WriteByteArrayOp_Float = 436 -primOpTag WriteByteArrayOp_Double = 437 -primOpTag WriteByteArrayOp_StablePtr = 438 -primOpTag WriteByteArrayOp_Int8 = 439 -primOpTag WriteByteArrayOp_Int16 = 440 -primOpTag WriteByteArrayOp_Int32 = 441 -primOpTag WriteByteArrayOp_Int64 = 442 -primOpTag WriteByteArrayOp_Word8 = 443 -primOpTag WriteByteArrayOp_Word16 = 444 -primOpTag WriteByteArrayOp_Word32 = 445 -primOpTag WriteByteArrayOp_Word64 = 446 -primOpTag WriteByteArrayOp_Word8AsChar = 447 -primOpTag WriteByteArrayOp_Word8AsWideChar = 448 -primOpTag WriteByteArrayOp_Word8AsInt = 449 -primOpTag WriteByteArrayOp_Word8AsWord = 450 -primOpTag WriteByteArrayOp_Word8AsAddr = 451 -primOpTag WriteByteArrayOp_Word8AsFloat = 452 -primOpTag WriteByteArrayOp_Word8AsDouble = 453 -primOpTag WriteByteArrayOp_Word8AsStablePtr = 454 -primOpTag WriteByteArrayOp_Word8AsInt16 = 455 -primOpTag WriteByteArrayOp_Word8AsInt32 = 456 -primOpTag WriteByteArrayOp_Word8AsInt64 = 457 -primOpTag WriteByteArrayOp_Word8AsWord16 = 458 -primOpTag WriteByteArrayOp_Word8AsWord32 = 459 -primOpTag WriteByteArrayOp_Word8AsWord64 = 460 -primOpTag CompareByteArraysOp = 461 -primOpTag CopyByteArrayOp = 462 -primOpTag CopyMutableByteArrayOp = 463 -primOpTag CopyByteArrayToAddrOp = 464 -primOpTag CopyMutableByteArrayToAddrOp = 465 -primOpTag CopyAddrToByteArrayOp = 466 -primOpTag SetByteArrayOp = 467 -primOpTag AtomicReadByteArrayOp_Int = 468 -primOpTag AtomicWriteByteArrayOp_Int = 469 -primOpTag CasByteArrayOp_Int = 470 -primOpTag CasByteArrayOp_Int8 = 471 -primOpTag CasByteArrayOp_Int16 = 472 -primOpTag CasByteArrayOp_Int32 = 473 -primOpTag CasByteArrayOp_Int64 = 474 -primOpTag FetchAddByteArrayOp_Int = 475 -primOpTag FetchSubByteArrayOp_Int = 476 -primOpTag FetchAndByteArrayOp_Int = 477 -primOpTag FetchNandByteArrayOp_Int = 478 -primOpTag FetchOrByteArrayOp_Int = 479 -primOpTag FetchXorByteArrayOp_Int = 480 -primOpTag AddrAddOp = 481 -primOpTag AddrSubOp = 482 -primOpTag AddrRemOp = 483 -primOpTag AddrToIntOp = 484 -primOpTag IntToAddrOp = 485 -primOpTag AddrGtOp = 486 -primOpTag AddrGeOp = 487 -primOpTag AddrEqOp = 488 -primOpTag AddrNeOp = 489 -primOpTag AddrLtOp = 490 -primOpTag AddrLeOp = 491 -primOpTag IndexOffAddrOp_Char = 492 -primOpTag IndexOffAddrOp_WideChar = 493 -primOpTag IndexOffAddrOp_Int = 494 -primOpTag IndexOffAddrOp_Word = 495 -primOpTag IndexOffAddrOp_Addr = 496 -primOpTag IndexOffAddrOp_Float = 497 -primOpTag IndexOffAddrOp_Double = 498 -primOpTag IndexOffAddrOp_StablePtr = 499 -primOpTag IndexOffAddrOp_Int8 = 500 -primOpTag IndexOffAddrOp_Int16 = 501 -primOpTag IndexOffAddrOp_Int32 = 502 -primOpTag IndexOffAddrOp_Int64 = 503 -primOpTag IndexOffAddrOp_Word8 = 504 -primOpTag IndexOffAddrOp_Word16 = 505 -primOpTag IndexOffAddrOp_Word32 = 506 -primOpTag IndexOffAddrOp_Word64 = 507 -primOpTag ReadOffAddrOp_Char = 508 -primOpTag ReadOffAddrOp_WideChar = 509 -primOpTag ReadOffAddrOp_Int = 510 -primOpTag ReadOffAddrOp_Word = 511 -primOpTag ReadOffAddrOp_Addr = 512 -primOpTag ReadOffAddrOp_Float = 513 -primOpTag ReadOffAddrOp_Double = 514 -primOpTag ReadOffAddrOp_StablePtr = 515 -primOpTag ReadOffAddrOp_Int8 = 516 -primOpTag ReadOffAddrOp_Int16 = 517 -primOpTag ReadOffAddrOp_Int32 = 518 -primOpTag ReadOffAddrOp_Int64 = 519 -primOpTag ReadOffAddrOp_Word8 = 520 -primOpTag ReadOffAddrOp_Word16 = 521 -primOpTag ReadOffAddrOp_Word32 = 522 -primOpTag ReadOffAddrOp_Word64 = 523 -primOpTag WriteOffAddrOp_Char = 524 -primOpTag WriteOffAddrOp_WideChar = 525 -primOpTag WriteOffAddrOp_Int = 526 -primOpTag WriteOffAddrOp_Word = 527 -primOpTag WriteOffAddrOp_Addr = 528 -primOpTag WriteOffAddrOp_Float = 529 -primOpTag WriteOffAddrOp_Double = 530 -primOpTag WriteOffAddrOp_StablePtr = 531 -primOpTag WriteOffAddrOp_Int8 = 532 -primOpTag WriteOffAddrOp_Int16 = 533 -primOpTag WriteOffAddrOp_Int32 = 534 -primOpTag WriteOffAddrOp_Int64 = 535 -primOpTag WriteOffAddrOp_Word8 = 536 -primOpTag WriteOffAddrOp_Word16 = 537 -primOpTag WriteOffAddrOp_Word32 = 538 -primOpTag WriteOffAddrOp_Word64 = 539 -primOpTag InterlockedExchange_Addr = 540 -primOpTag InterlockedExchange_Word = 541 -primOpTag CasAddrOp_Addr = 542 -primOpTag CasAddrOp_Word = 543 -primOpTag CasAddrOp_Word8 = 544 -primOpTag CasAddrOp_Word16 = 545 -primOpTag CasAddrOp_Word32 = 546 -primOpTag CasAddrOp_Word64 = 547 -primOpTag FetchAddAddrOp_Word = 548 -primOpTag FetchSubAddrOp_Word = 549 -primOpTag FetchAndAddrOp_Word = 550 -primOpTag FetchNandAddrOp_Word = 551 -primOpTag FetchOrAddrOp_Word = 552 -primOpTag FetchXorAddrOp_Word = 553 -primOpTag AtomicReadAddrOp_Word = 554 -primOpTag AtomicWriteAddrOp_Word = 555 -primOpTag NewMutVarOp = 556 -primOpTag ReadMutVarOp = 557 -primOpTag WriteMutVarOp = 558 -primOpTag AtomicModifyMutVar2Op = 559 -primOpTag AtomicModifyMutVar_Op = 560 -primOpTag CasMutVarOp = 561 -primOpTag CatchOp = 562 -primOpTag RaiseOp = 563 -primOpTag RaiseIOOp = 564 -primOpTag MaskAsyncExceptionsOp = 565 -primOpTag MaskUninterruptibleOp = 566 -primOpTag UnmaskAsyncExceptionsOp = 567 -primOpTag MaskStatus = 568 -primOpTag NewPromptTagOp = 569 -primOpTag PromptOp = 570 -primOpTag Control0Op = 571 -primOpTag AtomicallyOp = 572 -primOpTag RetryOp = 573 -primOpTag CatchRetryOp = 574 -primOpTag CatchSTMOp = 575 -primOpTag NewTVarOp = 576 -primOpTag ReadTVarOp = 577 -primOpTag ReadTVarIOOp = 578 -primOpTag WriteTVarOp = 579 -primOpTag NewMVarOp = 580 -primOpTag TakeMVarOp = 581 -primOpTag TryTakeMVarOp = 582 -primOpTag PutMVarOp = 583 -primOpTag TryPutMVarOp = 584 -primOpTag ReadMVarOp = 585 -primOpTag TryReadMVarOp = 586 -primOpTag IsEmptyMVarOp = 587 -primOpTag NewIOPortOp = 588 -primOpTag ReadIOPortOp = 589 -primOpTag WriteIOPortOp = 590 -primOpTag DelayOp = 591 -primOpTag WaitReadOp = 592 -primOpTag WaitWriteOp = 593 -primOpTag ForkOp = 594 -primOpTag ForkOnOp = 595 -primOpTag KillThreadOp = 596 -primOpTag YieldOp = 597 -primOpTag MyThreadIdOp = 598 -primOpTag LabelThreadOp = 599 -primOpTag IsCurrentThreadBoundOp = 600 -primOpTag NoDuplicateOp = 601 -primOpTag GetThreadLabelOp = 602 -primOpTag ThreadStatusOp = 603 -primOpTag ListThreadsOp = 604 -primOpTag MkWeakOp = 605 -primOpTag MkWeakNoFinalizerOp = 606 -primOpTag AddCFinalizerToWeakOp = 607 -primOpTag DeRefWeakOp = 608 -primOpTag FinalizeWeakOp = 609 -primOpTag TouchOp = 610 -primOpTag MakeStablePtrOp = 611 -primOpTag DeRefStablePtrOp = 612 -primOpTag EqStablePtrOp = 613 -primOpTag MakeStableNameOp = 614 -primOpTag StableNameToIntOp = 615 -primOpTag CompactNewOp = 616 -primOpTag CompactResizeOp = 617 -primOpTag CompactContainsOp = 618 -primOpTag CompactContainsAnyOp = 619 -primOpTag CompactGetFirstBlockOp = 620 -primOpTag CompactGetNextBlockOp = 621 -primOpTag CompactAllocateBlockOp = 622 -primOpTag CompactFixupPointersOp = 623 -primOpTag CompactAdd = 624 -primOpTag CompactAddWithSharing = 625 -primOpTag CompactSize = 626 -primOpTag ReallyUnsafePtrEqualityOp = 627 -primOpTag ParOp = 628 -primOpTag SparkOp = 629 -primOpTag SeqOp = 630 -primOpTag GetSparkOp = 631 -primOpTag NumSparks = 632 -primOpTag KeepAliveOp = 633 -primOpTag DataToTagOp = 634 -primOpTag TagToEnumOp = 635 -primOpTag AddrToAnyOp = 636 -primOpTag AnyToAddrOp = 637 -primOpTag MkApUpd0_Op = 638 -primOpTag NewBCOOp = 639 -primOpTag UnpackClosureOp = 640 -primOpTag ClosureSizeOp = 641 -primOpTag GetApStackValOp = 642 -primOpTag GetCCSOfOp = 643 -primOpTag GetCurrentCCSOp = 644 -primOpTag ClearCCSOp = 645 -primOpTag WhereFromOp = 646 -primOpTag TraceEventOp = 647 -primOpTag TraceEventBinaryOp = 648 -primOpTag TraceMarkerOp = 649 -primOpTag SetThreadAllocationCounter = 650 -primOpTag (VecBroadcastOp IntVec 16 W8) = 651 -primOpTag (VecBroadcastOp IntVec 8 W16) = 652 -primOpTag (VecBroadcastOp IntVec 4 W32) = 653 -primOpTag (VecBroadcastOp IntVec 2 W64) = 654 -primOpTag (VecBroadcastOp IntVec 32 W8) = 655 -primOpTag (VecBroadcastOp IntVec 16 W16) = 656 -primOpTag (VecBroadcastOp IntVec 8 W32) = 657 -primOpTag (VecBroadcastOp IntVec 4 W64) = 658 -primOpTag (VecBroadcastOp IntVec 64 W8) = 659 -primOpTag (VecBroadcastOp IntVec 32 W16) = 660 -primOpTag (VecBroadcastOp IntVec 16 W32) = 661 -primOpTag (VecBroadcastOp IntVec 8 W64) = 662 -primOpTag (VecBroadcastOp WordVec 16 W8) = 663 -primOpTag (VecBroadcastOp WordVec 8 W16) = 664 -primOpTag (VecBroadcastOp WordVec 4 W32) = 665 -primOpTag (VecBroadcastOp WordVec 2 W64) = 666 -primOpTag (VecBroadcastOp WordVec 32 W8) = 667 -primOpTag (VecBroadcastOp WordVec 16 W16) = 668 -primOpTag (VecBroadcastOp WordVec 8 W32) = 669 -primOpTag (VecBroadcastOp WordVec 4 W64) = 670 -primOpTag (VecBroadcastOp WordVec 64 W8) = 671 -primOpTag (VecBroadcastOp WordVec 32 W16) = 672 -primOpTag (VecBroadcastOp WordVec 16 W32) = 673 -primOpTag (VecBroadcastOp WordVec 8 W64) = 674 -primOpTag (VecBroadcastOp FloatVec 4 W32) = 675 -primOpTag (VecBroadcastOp FloatVec 2 W64) = 676 -primOpTag (VecBroadcastOp FloatVec 8 W32) = 677 -primOpTag (VecBroadcastOp FloatVec 4 W64) = 678 -primOpTag (VecBroadcastOp FloatVec 16 W32) = 679 -primOpTag (VecBroadcastOp FloatVec 8 W64) = 680 -primOpTag (VecPackOp IntVec 16 W8) = 681 -primOpTag (VecPackOp IntVec 8 W16) = 682 -primOpTag (VecPackOp IntVec 4 W32) = 683 -primOpTag (VecPackOp IntVec 2 W64) = 684 -primOpTag (VecPackOp IntVec 32 W8) = 685 -primOpTag (VecPackOp IntVec 16 W16) = 686 -primOpTag (VecPackOp IntVec 8 W32) = 687 -primOpTag (VecPackOp IntVec 4 W64) = 688 -primOpTag (VecPackOp IntVec 64 W8) = 689 -primOpTag (VecPackOp IntVec 32 W16) = 690 -primOpTag (VecPackOp IntVec 16 W32) = 691 -primOpTag (VecPackOp IntVec 8 W64) = 692 -primOpTag (VecPackOp WordVec 16 W8) = 693 -primOpTag (VecPackOp WordVec 8 W16) = 694 -primOpTag (VecPackOp WordVec 4 W32) = 695 -primOpTag (VecPackOp WordVec 2 W64) = 696 -primOpTag (VecPackOp WordVec 32 W8) = 697 -primOpTag (VecPackOp WordVec 16 W16) = 698 -primOpTag (VecPackOp WordVec 8 W32) = 699 -primOpTag (VecPackOp WordVec 4 W64) = 700 -primOpTag (VecPackOp WordVec 64 W8) = 701 -primOpTag (VecPackOp WordVec 32 W16) = 702 -primOpTag (VecPackOp WordVec 16 W32) = 703 -primOpTag (VecPackOp WordVec 8 W64) = 704 -primOpTag (VecPackOp FloatVec 4 W32) = 705 -primOpTag (VecPackOp FloatVec 2 W64) = 706 -primOpTag (VecPackOp FloatVec 8 W32) = 707 -primOpTag (VecPackOp FloatVec 4 W64) = 708 -primOpTag (VecPackOp FloatVec 16 W32) = 709 -primOpTag (VecPackOp FloatVec 8 W64) = 710 -primOpTag (VecUnpackOp IntVec 16 W8) = 711 -primOpTag (VecUnpackOp IntVec 8 W16) = 712 -primOpTag (VecUnpackOp IntVec 4 W32) = 713 -primOpTag (VecUnpackOp IntVec 2 W64) = 714 -primOpTag (VecUnpackOp IntVec 32 W8) = 715 -primOpTag (VecUnpackOp IntVec 16 W16) = 716 -primOpTag (VecUnpackOp IntVec 8 W32) = 717 -primOpTag (VecUnpackOp IntVec 4 W64) = 718 -primOpTag (VecUnpackOp IntVec 64 W8) = 719 -primOpTag (VecUnpackOp IntVec 32 W16) = 720 -primOpTag (VecUnpackOp IntVec 16 W32) = 721 -primOpTag (VecUnpackOp IntVec 8 W64) = 722 -primOpTag (VecUnpackOp WordVec 16 W8) = 723 -primOpTag (VecUnpackOp WordVec 8 W16) = 724 -primOpTag (VecUnpackOp WordVec 4 W32) = 725 -primOpTag (VecUnpackOp WordVec 2 W64) = 726 -primOpTag (VecUnpackOp WordVec 32 W8) = 727 -primOpTag (VecUnpackOp WordVec 16 W16) = 728 -primOpTag (VecUnpackOp WordVec 8 W32) = 729 -primOpTag (VecUnpackOp WordVec 4 W64) = 730 -primOpTag (VecUnpackOp WordVec 64 W8) = 731 -primOpTag (VecUnpackOp WordVec 32 W16) = 732 -primOpTag (VecUnpackOp WordVec 16 W32) = 733 -primOpTag (VecUnpackOp WordVec 8 W64) = 734 -primOpTag (VecUnpackOp FloatVec 4 W32) = 735 -primOpTag (VecUnpackOp FloatVec 2 W64) = 736 -primOpTag (VecUnpackOp FloatVec 8 W32) = 737 -primOpTag (VecUnpackOp FloatVec 4 W64) = 738 -primOpTag (VecUnpackOp FloatVec 16 W32) = 739 -primOpTag (VecUnpackOp FloatVec 8 W64) = 740 -primOpTag (VecInsertOp IntVec 16 W8) = 741 -primOpTag (VecInsertOp IntVec 8 W16) = 742 -primOpTag (VecInsertOp IntVec 4 W32) = 743 -primOpTag (VecInsertOp IntVec 2 W64) = 744 -primOpTag (VecInsertOp IntVec 32 W8) = 745 -primOpTag (VecInsertOp IntVec 16 W16) = 746 -primOpTag (VecInsertOp IntVec 8 W32) = 747 -primOpTag (VecInsertOp IntVec 4 W64) = 748 -primOpTag (VecInsertOp IntVec 64 W8) = 749 -primOpTag (VecInsertOp IntVec 32 W16) = 750 -primOpTag (VecInsertOp IntVec 16 W32) = 751 -primOpTag (VecInsertOp IntVec 8 W64) = 752 -primOpTag (VecInsertOp WordVec 16 W8) = 753 -primOpTag (VecInsertOp WordVec 8 W16) = 754 -primOpTag (VecInsertOp WordVec 4 W32) = 755 -primOpTag (VecInsertOp WordVec 2 W64) = 756 -primOpTag (VecInsertOp WordVec 32 W8) = 757 -primOpTag (VecInsertOp WordVec 16 W16) = 758 -primOpTag (VecInsertOp WordVec 8 W32) = 759 -primOpTag (VecInsertOp WordVec 4 W64) = 760 -primOpTag (VecInsertOp WordVec 64 W8) = 761 -primOpTag (VecInsertOp WordVec 32 W16) = 762 -primOpTag (VecInsertOp WordVec 16 W32) = 763 -primOpTag (VecInsertOp WordVec 8 W64) = 764 -primOpTag (VecInsertOp FloatVec 4 W32) = 765 -primOpTag (VecInsertOp FloatVec 2 W64) = 766 -primOpTag (VecInsertOp FloatVec 8 W32) = 767 -primOpTag (VecInsertOp FloatVec 4 W64) = 768 -primOpTag (VecInsertOp FloatVec 16 W32) = 769 -primOpTag (VecInsertOp FloatVec 8 W64) = 770 -primOpTag (VecAddOp IntVec 16 W8) = 771 -primOpTag (VecAddOp IntVec 8 W16) = 772 -primOpTag (VecAddOp IntVec 4 W32) = 773 -primOpTag (VecAddOp IntVec 2 W64) = 774 -primOpTag (VecAddOp IntVec 32 W8) = 775 -primOpTag (VecAddOp IntVec 16 W16) = 776 -primOpTag (VecAddOp IntVec 8 W32) = 777 -primOpTag (VecAddOp IntVec 4 W64) = 778 -primOpTag (VecAddOp IntVec 64 W8) = 779 -primOpTag (VecAddOp IntVec 32 W16) = 780 -primOpTag (VecAddOp IntVec 16 W32) = 781 -primOpTag (VecAddOp IntVec 8 W64) = 782 -primOpTag (VecAddOp WordVec 16 W8) = 783 -primOpTag (VecAddOp WordVec 8 W16) = 784 -primOpTag (VecAddOp WordVec 4 W32) = 785 -primOpTag (VecAddOp WordVec 2 W64) = 786 -primOpTag (VecAddOp WordVec 32 W8) = 787 -primOpTag (VecAddOp WordVec 16 W16) = 788 -primOpTag (VecAddOp WordVec 8 W32) = 789 -primOpTag (VecAddOp WordVec 4 W64) = 790 -primOpTag (VecAddOp WordVec 64 W8) = 791 -primOpTag (VecAddOp WordVec 32 W16) = 792 -primOpTag (VecAddOp WordVec 16 W32) = 793 -primOpTag (VecAddOp WordVec 8 W64) = 794 -primOpTag (VecAddOp FloatVec 4 W32) = 795 -primOpTag (VecAddOp FloatVec 2 W64) = 796 -primOpTag (VecAddOp FloatVec 8 W32) = 797 -primOpTag (VecAddOp FloatVec 4 W64) = 798 -primOpTag (VecAddOp FloatVec 16 W32) = 799 -primOpTag (VecAddOp FloatVec 8 W64) = 800 -primOpTag (VecSubOp IntVec 16 W8) = 801 -primOpTag (VecSubOp IntVec 8 W16) = 802 -primOpTag (VecSubOp IntVec 4 W32) = 803 -primOpTag (VecSubOp IntVec 2 W64) = 804 -primOpTag (VecSubOp IntVec 32 W8) = 805 -primOpTag (VecSubOp IntVec 16 W16) = 806 -primOpTag (VecSubOp IntVec 8 W32) = 807 -primOpTag (VecSubOp IntVec 4 W64) = 808 -primOpTag (VecSubOp IntVec 64 W8) = 809 -primOpTag (VecSubOp IntVec 32 W16) = 810 -primOpTag (VecSubOp IntVec 16 W32) = 811 -primOpTag (VecSubOp IntVec 8 W64) = 812 -primOpTag (VecSubOp WordVec 16 W8) = 813 -primOpTag (VecSubOp WordVec 8 W16) = 814 -primOpTag (VecSubOp WordVec 4 W32) = 815 -primOpTag (VecSubOp WordVec 2 W64) = 816 -primOpTag (VecSubOp WordVec 32 W8) = 817 -primOpTag (VecSubOp WordVec 16 W16) = 818 -primOpTag (VecSubOp WordVec 8 W32) = 819 -primOpTag (VecSubOp WordVec 4 W64) = 820 -primOpTag (VecSubOp WordVec 64 W8) = 821 -primOpTag (VecSubOp WordVec 32 W16) = 822 -primOpTag (VecSubOp WordVec 16 W32) = 823 -primOpTag (VecSubOp WordVec 8 W64) = 824 -primOpTag (VecSubOp FloatVec 4 W32) = 825 -primOpTag (VecSubOp FloatVec 2 W64) = 826 -primOpTag (VecSubOp FloatVec 8 W32) = 827 -primOpTag (VecSubOp FloatVec 4 W64) = 828 -primOpTag (VecSubOp FloatVec 16 W32) = 829 -primOpTag (VecSubOp FloatVec 8 W64) = 830 -primOpTag (VecMulOp IntVec 16 W8) = 831 -primOpTag (VecMulOp IntVec 8 W16) = 832 -primOpTag (VecMulOp IntVec 4 W32) = 833 -primOpTag (VecMulOp IntVec 2 W64) = 834 -primOpTag (VecMulOp IntVec 32 W8) = 835 -primOpTag (VecMulOp IntVec 16 W16) = 836 -primOpTag (VecMulOp IntVec 8 W32) = 837 -primOpTag (VecMulOp IntVec 4 W64) = 838 -primOpTag (VecMulOp IntVec 64 W8) = 839 -primOpTag (VecMulOp IntVec 32 W16) = 840 -primOpTag (VecMulOp IntVec 16 W32) = 841 -primOpTag (VecMulOp IntVec 8 W64) = 842 -primOpTag (VecMulOp WordVec 16 W8) = 843 -primOpTag (VecMulOp WordVec 8 W16) = 844 -primOpTag (VecMulOp WordVec 4 W32) = 845 -primOpTag (VecMulOp WordVec 2 W64) = 846 -primOpTag (VecMulOp WordVec 32 W8) = 847 -primOpTag (VecMulOp WordVec 16 W16) = 848 -primOpTag (VecMulOp WordVec 8 W32) = 849 -primOpTag (VecMulOp WordVec 4 W64) = 850 -primOpTag (VecMulOp WordVec 64 W8) = 851 -primOpTag (VecMulOp WordVec 32 W16) = 852 -primOpTag (VecMulOp WordVec 16 W32) = 853 -primOpTag (VecMulOp WordVec 8 W64) = 854 -primOpTag (VecMulOp FloatVec 4 W32) = 855 -primOpTag (VecMulOp FloatVec 2 W64) = 856 -primOpTag (VecMulOp FloatVec 8 W32) = 857 -primOpTag (VecMulOp FloatVec 4 W64) = 858 -primOpTag (VecMulOp FloatVec 16 W32) = 859 -primOpTag (VecMulOp FloatVec 8 W64) = 860 -primOpTag (VecDivOp FloatVec 4 W32) = 861 -primOpTag (VecDivOp FloatVec 2 W64) = 862 -primOpTag (VecDivOp FloatVec 8 W32) = 863 -primOpTag (VecDivOp FloatVec 4 W64) = 864 -primOpTag (VecDivOp FloatVec 16 W32) = 865 -primOpTag (VecDivOp FloatVec 8 W64) = 866 -primOpTag (VecQuotOp IntVec 16 W8) = 867 -primOpTag (VecQuotOp IntVec 8 W16) = 868 -primOpTag (VecQuotOp IntVec 4 W32) = 869 -primOpTag (VecQuotOp IntVec 2 W64) = 870 -primOpTag (VecQuotOp IntVec 32 W8) = 871 -primOpTag (VecQuotOp IntVec 16 W16) = 872 -primOpTag (VecQuotOp IntVec 8 W32) = 873 -primOpTag (VecQuotOp IntVec 4 W64) = 874 -primOpTag (VecQuotOp IntVec 64 W8) = 875 -primOpTag (VecQuotOp IntVec 32 W16) = 876 -primOpTag (VecQuotOp IntVec 16 W32) = 877 -primOpTag (VecQuotOp IntVec 8 W64) = 878 -primOpTag (VecQuotOp WordVec 16 W8) = 879 -primOpTag (VecQuotOp WordVec 8 W16) = 880 -primOpTag (VecQuotOp WordVec 4 W32) = 881 -primOpTag (VecQuotOp WordVec 2 W64) = 882 -primOpTag (VecQuotOp WordVec 32 W8) = 883 -primOpTag (VecQuotOp WordVec 16 W16) = 884 -primOpTag (VecQuotOp WordVec 8 W32) = 885 -primOpTag (VecQuotOp WordVec 4 W64) = 886 -primOpTag (VecQuotOp WordVec 64 W8) = 887 -primOpTag (VecQuotOp WordVec 32 W16) = 888 -primOpTag (VecQuotOp WordVec 16 W32) = 889 -primOpTag (VecQuotOp WordVec 8 W64) = 890 -primOpTag (VecRemOp IntVec 16 W8) = 891 -primOpTag (VecRemOp IntVec 8 W16) = 892 -primOpTag (VecRemOp IntVec 4 W32) = 893 -primOpTag (VecRemOp IntVec 2 W64) = 894 -primOpTag (VecRemOp IntVec 32 W8) = 895 -primOpTag (VecRemOp IntVec 16 W16) = 896 -primOpTag (VecRemOp IntVec 8 W32) = 897 -primOpTag (VecRemOp IntVec 4 W64) = 898 -primOpTag (VecRemOp IntVec 64 W8) = 899 -primOpTag (VecRemOp IntVec 32 W16) = 900 -primOpTag (VecRemOp IntVec 16 W32) = 901 -primOpTag (VecRemOp IntVec 8 W64) = 902 -primOpTag (VecRemOp WordVec 16 W8) = 903 -primOpTag (VecRemOp WordVec 8 W16) = 904 -primOpTag (VecRemOp WordVec 4 W32) = 905 -primOpTag (VecRemOp WordVec 2 W64) = 906 -primOpTag (VecRemOp WordVec 32 W8) = 907 -primOpTag (VecRemOp WordVec 16 W16) = 908 -primOpTag (VecRemOp WordVec 8 W32) = 909 -primOpTag (VecRemOp WordVec 4 W64) = 910 -primOpTag (VecRemOp WordVec 64 W8) = 911 -primOpTag (VecRemOp WordVec 32 W16) = 912 -primOpTag (VecRemOp WordVec 16 W32) = 913 -primOpTag (VecRemOp WordVec 8 W64) = 914 -primOpTag (VecNegOp IntVec 16 W8) = 915 -primOpTag (VecNegOp IntVec 8 W16) = 916 -primOpTag (VecNegOp IntVec 4 W32) = 917 -primOpTag (VecNegOp IntVec 2 W64) = 918 -primOpTag (VecNegOp IntVec 32 W8) = 919 -primOpTag (VecNegOp IntVec 16 W16) = 920 -primOpTag (VecNegOp IntVec 8 W32) = 921 -primOpTag (VecNegOp IntVec 4 W64) = 922 -primOpTag (VecNegOp IntVec 64 W8) = 923 -primOpTag (VecNegOp IntVec 32 W16) = 924 -primOpTag (VecNegOp IntVec 16 W32) = 925 -primOpTag (VecNegOp IntVec 8 W64) = 926 -primOpTag (VecNegOp FloatVec 4 W32) = 927 -primOpTag (VecNegOp FloatVec 2 W64) = 928 -primOpTag (VecNegOp FloatVec 8 W32) = 929 -primOpTag (VecNegOp FloatVec 4 W64) = 930 -primOpTag (VecNegOp FloatVec 16 W32) = 931 -primOpTag (VecNegOp FloatVec 8 W64) = 932 -primOpTag (VecIndexByteArrayOp IntVec 16 W8) = 933 -primOpTag (VecIndexByteArrayOp IntVec 8 W16) = 934 -primOpTag (VecIndexByteArrayOp IntVec 4 W32) = 935 -primOpTag (VecIndexByteArrayOp IntVec 2 W64) = 936 -primOpTag (VecIndexByteArrayOp IntVec 32 W8) = 937 -primOpTag (VecIndexByteArrayOp IntVec 16 W16) = 938 -primOpTag (VecIndexByteArrayOp IntVec 8 W32) = 939 -primOpTag (VecIndexByteArrayOp IntVec 4 W64) = 940 -primOpTag (VecIndexByteArrayOp IntVec 64 W8) = 941 -primOpTag (VecIndexByteArrayOp IntVec 32 W16) = 942 -primOpTag (VecIndexByteArrayOp IntVec 16 W32) = 943 -primOpTag (VecIndexByteArrayOp IntVec 8 W64) = 944 -primOpTag (VecIndexByteArrayOp WordVec 16 W8) = 945 -primOpTag (VecIndexByteArrayOp WordVec 8 W16) = 946 -primOpTag (VecIndexByteArrayOp WordVec 4 W32) = 947 -primOpTag (VecIndexByteArrayOp WordVec 2 W64) = 948 -primOpTag (VecIndexByteArrayOp WordVec 32 W8) = 949 -primOpTag (VecIndexByteArrayOp WordVec 16 W16) = 950 -primOpTag (VecIndexByteArrayOp WordVec 8 W32) = 951 -primOpTag (VecIndexByteArrayOp WordVec 4 W64) = 952 -primOpTag (VecIndexByteArrayOp WordVec 64 W8) = 953 -primOpTag (VecIndexByteArrayOp WordVec 32 W16) = 954 -primOpTag (VecIndexByteArrayOp WordVec 16 W32) = 955 -primOpTag (VecIndexByteArrayOp WordVec 8 W64) = 956 -primOpTag (VecIndexByteArrayOp FloatVec 4 W32) = 957 -primOpTag (VecIndexByteArrayOp FloatVec 2 W64) = 958 -primOpTag (VecIndexByteArrayOp FloatVec 8 W32) = 959 -primOpTag (VecIndexByteArrayOp FloatVec 4 W64) = 960 -primOpTag (VecIndexByteArrayOp FloatVec 16 W32) = 961 -primOpTag (VecIndexByteArrayOp FloatVec 8 W64) = 962 -primOpTag (VecReadByteArrayOp IntVec 16 W8) = 963 -primOpTag (VecReadByteArrayOp IntVec 8 W16) = 964 -primOpTag (VecReadByteArrayOp IntVec 4 W32) = 965 -primOpTag (VecReadByteArrayOp IntVec 2 W64) = 966 -primOpTag (VecReadByteArrayOp IntVec 32 W8) = 967 -primOpTag (VecReadByteArrayOp IntVec 16 W16) = 968 -primOpTag (VecReadByteArrayOp IntVec 8 W32) = 969 -primOpTag (VecReadByteArrayOp IntVec 4 W64) = 970 -primOpTag (VecReadByteArrayOp IntVec 64 W8) = 971 -primOpTag (VecReadByteArrayOp IntVec 32 W16) = 972 -primOpTag (VecReadByteArrayOp IntVec 16 W32) = 973 -primOpTag (VecReadByteArrayOp IntVec 8 W64) = 974 -primOpTag (VecReadByteArrayOp WordVec 16 W8) = 975 -primOpTag (VecReadByteArrayOp WordVec 8 W16) = 976 -primOpTag (VecReadByteArrayOp WordVec 4 W32) = 977 -primOpTag (VecReadByteArrayOp WordVec 2 W64) = 978 -primOpTag (VecReadByteArrayOp WordVec 32 W8) = 979 -primOpTag (VecReadByteArrayOp WordVec 16 W16) = 980 -primOpTag (VecReadByteArrayOp WordVec 8 W32) = 981 -primOpTag (VecReadByteArrayOp WordVec 4 W64) = 982 -primOpTag (VecReadByteArrayOp WordVec 64 W8) = 983 -primOpTag (VecReadByteArrayOp WordVec 32 W16) = 984 -primOpTag (VecReadByteArrayOp WordVec 16 W32) = 985 -primOpTag (VecReadByteArrayOp WordVec 8 W64) = 986 -primOpTag (VecReadByteArrayOp FloatVec 4 W32) = 987 -primOpTag (VecReadByteArrayOp FloatVec 2 W64) = 988 -primOpTag (VecReadByteArrayOp FloatVec 8 W32) = 989 -primOpTag (VecReadByteArrayOp FloatVec 4 W64) = 990 -primOpTag (VecReadByteArrayOp FloatVec 16 W32) = 991 -primOpTag (VecReadByteArrayOp FloatVec 8 W64) = 992 -primOpTag (VecWriteByteArrayOp IntVec 16 W8) = 993 -primOpTag (VecWriteByteArrayOp IntVec 8 W16) = 994 -primOpTag (VecWriteByteArrayOp IntVec 4 W32) = 995 -primOpTag (VecWriteByteArrayOp IntVec 2 W64) = 996 -primOpTag (VecWriteByteArrayOp IntVec 32 W8) = 997 -primOpTag (VecWriteByteArrayOp IntVec 16 W16) = 998 -primOpTag (VecWriteByteArrayOp IntVec 8 W32) = 999 -primOpTag (VecWriteByteArrayOp IntVec 4 W64) = 1000 -primOpTag (VecWriteByteArrayOp IntVec 64 W8) = 1001 -primOpTag (VecWriteByteArrayOp IntVec 32 W16) = 1002 -primOpTag (VecWriteByteArrayOp IntVec 16 W32) = 1003 -primOpTag (VecWriteByteArrayOp IntVec 8 W64) = 1004 -primOpTag (VecWriteByteArrayOp WordVec 16 W8) = 1005 -primOpTag (VecWriteByteArrayOp WordVec 8 W16) = 1006 -primOpTag (VecWriteByteArrayOp WordVec 4 W32) = 1007 -primOpTag (VecWriteByteArrayOp WordVec 2 W64) = 1008 -primOpTag (VecWriteByteArrayOp WordVec 32 W8) = 1009 -primOpTag (VecWriteByteArrayOp WordVec 16 W16) = 1010 -primOpTag (VecWriteByteArrayOp WordVec 8 W32) = 1011 -primOpTag (VecWriteByteArrayOp WordVec 4 W64) = 1012 -primOpTag (VecWriteByteArrayOp WordVec 64 W8) = 1013 -primOpTag (VecWriteByteArrayOp WordVec 32 W16) = 1014 -primOpTag (VecWriteByteArrayOp WordVec 16 W32) = 1015 -primOpTag (VecWriteByteArrayOp WordVec 8 W64) = 1016 -primOpTag (VecWriteByteArrayOp FloatVec 4 W32) = 1017 -primOpTag (VecWriteByteArrayOp FloatVec 2 W64) = 1018 -primOpTag (VecWriteByteArrayOp FloatVec 8 W32) = 1019 -primOpTag (VecWriteByteArrayOp FloatVec 4 W64) = 1020 -primOpTag (VecWriteByteArrayOp FloatVec 16 W32) = 1021 -primOpTag (VecWriteByteArrayOp FloatVec 8 W64) = 1022 -primOpTag (VecIndexOffAddrOp IntVec 16 W8) = 1023 -primOpTag (VecIndexOffAddrOp IntVec 8 W16) = 1024 -primOpTag (VecIndexOffAddrOp IntVec 4 W32) = 1025 -primOpTag (VecIndexOffAddrOp IntVec 2 W64) = 1026 -primOpTag (VecIndexOffAddrOp IntVec 32 W8) = 1027 -primOpTag (VecIndexOffAddrOp IntVec 16 W16) = 1028 -primOpTag (VecIndexOffAddrOp IntVec 8 W32) = 1029 -primOpTag (VecIndexOffAddrOp IntVec 4 W64) = 1030 -primOpTag (VecIndexOffAddrOp IntVec 64 W8) = 1031 -primOpTag (VecIndexOffAddrOp IntVec 32 W16) = 1032 -primOpTag (VecIndexOffAddrOp IntVec 16 W32) = 1033 -primOpTag (VecIndexOffAddrOp IntVec 8 W64) = 1034 -primOpTag (VecIndexOffAddrOp WordVec 16 W8) = 1035 -primOpTag (VecIndexOffAddrOp WordVec 8 W16) = 1036 -primOpTag (VecIndexOffAddrOp WordVec 4 W32) = 1037 -primOpTag (VecIndexOffAddrOp WordVec 2 W64) = 1038 -primOpTag (VecIndexOffAddrOp WordVec 32 W8) = 1039 -primOpTag (VecIndexOffAddrOp WordVec 16 W16) = 1040 -primOpTag (VecIndexOffAddrOp WordVec 8 W32) = 1041 -primOpTag (VecIndexOffAddrOp WordVec 4 W64) = 1042 -primOpTag (VecIndexOffAddrOp WordVec 64 W8) = 1043 -primOpTag (VecIndexOffAddrOp WordVec 32 W16) = 1044 -primOpTag (VecIndexOffAddrOp WordVec 16 W32) = 1045 -primOpTag (VecIndexOffAddrOp WordVec 8 W64) = 1046 -primOpTag (VecIndexOffAddrOp FloatVec 4 W32) = 1047 -primOpTag (VecIndexOffAddrOp FloatVec 2 W64) = 1048 -primOpTag (VecIndexOffAddrOp FloatVec 8 W32) = 1049 -primOpTag (VecIndexOffAddrOp FloatVec 4 W64) = 1050 -primOpTag (VecIndexOffAddrOp FloatVec 16 W32) = 1051 -primOpTag (VecIndexOffAddrOp FloatVec 8 W64) = 1052 -primOpTag (VecReadOffAddrOp IntVec 16 W8) = 1053 -primOpTag (VecReadOffAddrOp IntVec 8 W16) = 1054 -primOpTag (VecReadOffAddrOp IntVec 4 W32) = 1055 -primOpTag (VecReadOffAddrOp IntVec 2 W64) = 1056 -primOpTag (VecReadOffAddrOp IntVec 32 W8) = 1057 -primOpTag (VecReadOffAddrOp IntVec 16 W16) = 1058 -primOpTag (VecReadOffAddrOp IntVec 8 W32) = 1059 -primOpTag (VecReadOffAddrOp IntVec 4 W64) = 1060 -primOpTag (VecReadOffAddrOp IntVec 64 W8) = 1061 -primOpTag (VecReadOffAddrOp IntVec 32 W16) = 1062 -primOpTag (VecReadOffAddrOp IntVec 16 W32) = 1063 -primOpTag (VecReadOffAddrOp IntVec 8 W64) = 1064 -primOpTag (VecReadOffAddrOp WordVec 16 W8) = 1065 -primOpTag (VecReadOffAddrOp WordVec 8 W16) = 1066 -primOpTag (VecReadOffAddrOp WordVec 4 W32) = 1067 -primOpTag (VecReadOffAddrOp WordVec 2 W64) = 1068 -primOpTag (VecReadOffAddrOp WordVec 32 W8) = 1069 -primOpTag (VecReadOffAddrOp WordVec 16 W16) = 1070 -primOpTag (VecReadOffAddrOp WordVec 8 W32) = 1071 -primOpTag (VecReadOffAddrOp WordVec 4 W64) = 1072 -primOpTag (VecReadOffAddrOp WordVec 64 W8) = 1073 -primOpTag (VecReadOffAddrOp WordVec 32 W16) = 1074 -primOpTag (VecReadOffAddrOp WordVec 16 W32) = 1075 -primOpTag (VecReadOffAddrOp WordVec 8 W64) = 1076 -primOpTag (VecReadOffAddrOp FloatVec 4 W32) = 1077 -primOpTag (VecReadOffAddrOp FloatVec 2 W64) = 1078 -primOpTag (VecReadOffAddrOp FloatVec 8 W32) = 1079 -primOpTag (VecReadOffAddrOp FloatVec 4 W64) = 1080 -primOpTag (VecReadOffAddrOp FloatVec 16 W32) = 1081 -primOpTag (VecReadOffAddrOp FloatVec 8 W64) = 1082 -primOpTag (VecWriteOffAddrOp IntVec 16 W8) = 1083 -primOpTag (VecWriteOffAddrOp IntVec 8 W16) = 1084 -primOpTag (VecWriteOffAddrOp IntVec 4 W32) = 1085 -primOpTag (VecWriteOffAddrOp IntVec 2 W64) = 1086 -primOpTag (VecWriteOffAddrOp IntVec 32 W8) = 1087 -primOpTag (VecWriteOffAddrOp IntVec 16 W16) = 1088 -primOpTag (VecWriteOffAddrOp IntVec 8 W32) = 1089 -primOpTag (VecWriteOffAddrOp IntVec 4 W64) = 1090 -primOpTag (VecWriteOffAddrOp IntVec 64 W8) = 1091 -primOpTag (VecWriteOffAddrOp IntVec 32 W16) = 1092 -primOpTag (VecWriteOffAddrOp IntVec 16 W32) = 1093 -primOpTag (VecWriteOffAddrOp IntVec 8 W64) = 1094 -primOpTag (VecWriteOffAddrOp WordVec 16 W8) = 1095 -primOpTag (VecWriteOffAddrOp WordVec 8 W16) = 1096 -primOpTag (VecWriteOffAddrOp WordVec 4 W32) = 1097 -primOpTag (VecWriteOffAddrOp WordVec 2 W64) = 1098 -primOpTag (VecWriteOffAddrOp WordVec 32 W8) = 1099 -primOpTag (VecWriteOffAddrOp WordVec 16 W16) = 1100 -primOpTag (VecWriteOffAddrOp WordVec 8 W32) = 1101 -primOpTag (VecWriteOffAddrOp WordVec 4 W64) = 1102 -primOpTag (VecWriteOffAddrOp WordVec 64 W8) = 1103 -primOpTag (VecWriteOffAddrOp WordVec 32 W16) = 1104 -primOpTag (VecWriteOffAddrOp WordVec 16 W32) = 1105 -primOpTag (VecWriteOffAddrOp WordVec 8 W64) = 1106 -primOpTag (VecWriteOffAddrOp FloatVec 4 W32) = 1107 -primOpTag (VecWriteOffAddrOp FloatVec 2 W64) = 1108 -primOpTag (VecWriteOffAddrOp FloatVec 8 W32) = 1109 -primOpTag (VecWriteOffAddrOp FloatVec 4 W64) = 1110 -primOpTag (VecWriteOffAddrOp FloatVec 16 W32) = 1111 -primOpTag (VecWriteOffAddrOp FloatVec 8 W64) = 1112 -primOpTag (VecIndexScalarByteArrayOp IntVec 16 W8) = 1113 -primOpTag (VecIndexScalarByteArrayOp IntVec 8 W16) = 1114 -primOpTag (VecIndexScalarByteArrayOp IntVec 4 W32) = 1115 -primOpTag (VecIndexScalarByteArrayOp IntVec 2 W64) = 1116 -primOpTag (VecIndexScalarByteArrayOp IntVec 32 W8) = 1117 -primOpTag (VecIndexScalarByteArrayOp IntVec 16 W16) = 1118 -primOpTag (VecIndexScalarByteArrayOp IntVec 8 W32) = 1119 -primOpTag (VecIndexScalarByteArrayOp IntVec 4 W64) = 1120 -primOpTag (VecIndexScalarByteArrayOp IntVec 64 W8) = 1121 -primOpTag (VecIndexScalarByteArrayOp IntVec 32 W16) = 1122 -primOpTag (VecIndexScalarByteArrayOp IntVec 16 W32) = 1123 -primOpTag (VecIndexScalarByteArrayOp IntVec 8 W64) = 1124 -primOpTag (VecIndexScalarByteArrayOp WordVec 16 W8) = 1125 -primOpTag (VecIndexScalarByteArrayOp WordVec 8 W16) = 1126 -primOpTag (VecIndexScalarByteArrayOp WordVec 4 W32) = 1127 -primOpTag (VecIndexScalarByteArrayOp WordVec 2 W64) = 1128 -primOpTag (VecIndexScalarByteArrayOp WordVec 32 W8) = 1129 -primOpTag (VecIndexScalarByteArrayOp WordVec 16 W16) = 1130 -primOpTag (VecIndexScalarByteArrayOp WordVec 8 W32) = 1131 -primOpTag (VecIndexScalarByteArrayOp WordVec 4 W64) = 1132 -primOpTag (VecIndexScalarByteArrayOp WordVec 64 W8) = 1133 -primOpTag (VecIndexScalarByteArrayOp WordVec 32 W16) = 1134 -primOpTag (VecIndexScalarByteArrayOp WordVec 16 W32) = 1135 -primOpTag (VecIndexScalarByteArrayOp WordVec 8 W64) = 1136 -primOpTag (VecIndexScalarByteArrayOp FloatVec 4 W32) = 1137 -primOpTag (VecIndexScalarByteArrayOp FloatVec 2 W64) = 1138 -primOpTag (VecIndexScalarByteArrayOp FloatVec 8 W32) = 1139 -primOpTag (VecIndexScalarByteArrayOp FloatVec 4 W64) = 1140 -primOpTag (VecIndexScalarByteArrayOp FloatVec 16 W32) = 1141 -primOpTag (VecIndexScalarByteArrayOp FloatVec 8 W64) = 1142 -primOpTag (VecReadScalarByteArrayOp IntVec 16 W8) = 1143 -primOpTag (VecReadScalarByteArrayOp IntVec 8 W16) = 1144 -primOpTag (VecReadScalarByteArrayOp IntVec 4 W32) = 1145 -primOpTag (VecReadScalarByteArrayOp IntVec 2 W64) = 1146 -primOpTag (VecReadScalarByteArrayOp IntVec 32 W8) = 1147 -primOpTag (VecReadScalarByteArrayOp IntVec 16 W16) = 1148 -primOpTag (VecReadScalarByteArrayOp IntVec 8 W32) = 1149 -primOpTag (VecReadScalarByteArrayOp IntVec 4 W64) = 1150 -primOpTag (VecReadScalarByteArrayOp IntVec 64 W8) = 1151 -primOpTag (VecReadScalarByteArrayOp IntVec 32 W16) = 1152 -primOpTag (VecReadScalarByteArrayOp IntVec 16 W32) = 1153 -primOpTag (VecReadScalarByteArrayOp IntVec 8 W64) = 1154 -primOpTag (VecReadScalarByteArrayOp WordVec 16 W8) = 1155 -primOpTag (VecReadScalarByteArrayOp WordVec 8 W16) = 1156 -primOpTag (VecReadScalarByteArrayOp WordVec 4 W32) = 1157 -primOpTag (VecReadScalarByteArrayOp WordVec 2 W64) = 1158 -primOpTag (VecReadScalarByteArrayOp WordVec 32 W8) = 1159 -primOpTag (VecReadScalarByteArrayOp WordVec 16 W16) = 1160 -primOpTag (VecReadScalarByteArrayOp WordVec 8 W32) = 1161 -primOpTag (VecReadScalarByteArrayOp WordVec 4 W64) = 1162 -primOpTag (VecReadScalarByteArrayOp WordVec 64 W8) = 1163 -primOpTag (VecReadScalarByteArrayOp WordVec 32 W16) = 1164 -primOpTag (VecReadScalarByteArrayOp WordVec 16 W32) = 1165 -primOpTag (VecReadScalarByteArrayOp WordVec 8 W64) = 1166 -primOpTag (VecReadScalarByteArrayOp FloatVec 4 W32) = 1167 -primOpTag (VecReadScalarByteArrayOp FloatVec 2 W64) = 1168 -primOpTag (VecReadScalarByteArrayOp FloatVec 8 W32) = 1169 -primOpTag (VecReadScalarByteArrayOp FloatVec 4 W64) = 1170 -primOpTag (VecReadScalarByteArrayOp FloatVec 16 W32) = 1171 -primOpTag (VecReadScalarByteArrayOp FloatVec 8 W64) = 1172 -primOpTag (VecWriteScalarByteArrayOp IntVec 16 W8) = 1173 -primOpTag (VecWriteScalarByteArrayOp IntVec 8 W16) = 1174 -primOpTag (VecWriteScalarByteArrayOp IntVec 4 W32) = 1175 -primOpTag (VecWriteScalarByteArrayOp IntVec 2 W64) = 1176 -primOpTag (VecWriteScalarByteArrayOp IntVec 32 W8) = 1177 -primOpTag (VecWriteScalarByteArrayOp IntVec 16 W16) = 1178 -primOpTag (VecWriteScalarByteArrayOp IntVec 8 W32) = 1179 -primOpTag (VecWriteScalarByteArrayOp IntVec 4 W64) = 1180 -primOpTag (VecWriteScalarByteArrayOp IntVec 64 W8) = 1181 -primOpTag (VecWriteScalarByteArrayOp IntVec 32 W16) = 1182 -primOpTag (VecWriteScalarByteArrayOp IntVec 16 W32) = 1183 -primOpTag (VecWriteScalarByteArrayOp IntVec 8 W64) = 1184 -primOpTag (VecWriteScalarByteArrayOp WordVec 16 W8) = 1185 -primOpTag (VecWriteScalarByteArrayOp WordVec 8 W16) = 1186 -primOpTag (VecWriteScalarByteArrayOp WordVec 4 W32) = 1187 -primOpTag (VecWriteScalarByteArrayOp WordVec 2 W64) = 1188 -primOpTag (VecWriteScalarByteArrayOp WordVec 32 W8) = 1189 -primOpTag (VecWriteScalarByteArrayOp WordVec 16 W16) = 1190 -primOpTag (VecWriteScalarByteArrayOp WordVec 8 W32) = 1191 -primOpTag (VecWriteScalarByteArrayOp WordVec 4 W64) = 1192 -primOpTag (VecWriteScalarByteArrayOp WordVec 64 W8) = 1193 -primOpTag (VecWriteScalarByteArrayOp WordVec 32 W16) = 1194 -primOpTag (VecWriteScalarByteArrayOp WordVec 16 W32) = 1195 -primOpTag (VecWriteScalarByteArrayOp WordVec 8 W64) = 1196 -primOpTag (VecWriteScalarByteArrayOp FloatVec 4 W32) = 1197 -primOpTag (VecWriteScalarByteArrayOp FloatVec 2 W64) = 1198 -primOpTag (VecWriteScalarByteArrayOp FloatVec 8 W32) = 1199 -primOpTag (VecWriteScalarByteArrayOp FloatVec 4 W64) = 1200 -primOpTag (VecWriteScalarByteArrayOp FloatVec 16 W32) = 1201 -primOpTag (VecWriteScalarByteArrayOp FloatVec 8 W64) = 1202 -primOpTag (VecIndexScalarOffAddrOp IntVec 16 W8) = 1203 -primOpTag (VecIndexScalarOffAddrOp IntVec 8 W16) = 1204 -primOpTag (VecIndexScalarOffAddrOp IntVec 4 W32) = 1205 -primOpTag (VecIndexScalarOffAddrOp IntVec 2 W64) = 1206 -primOpTag (VecIndexScalarOffAddrOp IntVec 32 W8) = 1207 -primOpTag (VecIndexScalarOffAddrOp IntVec 16 W16) = 1208 -primOpTag (VecIndexScalarOffAddrOp IntVec 8 W32) = 1209 -primOpTag (VecIndexScalarOffAddrOp IntVec 4 W64) = 1210 -primOpTag (VecIndexScalarOffAddrOp IntVec 64 W8) = 1211 -primOpTag (VecIndexScalarOffAddrOp IntVec 32 W16) = 1212 -primOpTag (VecIndexScalarOffAddrOp IntVec 16 W32) = 1213 -primOpTag (VecIndexScalarOffAddrOp IntVec 8 W64) = 1214 -primOpTag (VecIndexScalarOffAddrOp WordVec 16 W8) = 1215 -primOpTag (VecIndexScalarOffAddrOp WordVec 8 W16) = 1216 -primOpTag (VecIndexScalarOffAddrOp WordVec 4 W32) = 1217 -primOpTag (VecIndexScalarOffAddrOp WordVec 2 W64) = 1218 -primOpTag (VecIndexScalarOffAddrOp WordVec 32 W8) = 1219 -primOpTag (VecIndexScalarOffAddrOp WordVec 16 W16) = 1220 -primOpTag (VecIndexScalarOffAddrOp WordVec 8 W32) = 1221 -primOpTag (VecIndexScalarOffAddrOp WordVec 4 W64) = 1222 -primOpTag (VecIndexScalarOffAddrOp WordVec 64 W8) = 1223 -primOpTag (VecIndexScalarOffAddrOp WordVec 32 W16) = 1224 -primOpTag (VecIndexScalarOffAddrOp WordVec 16 W32) = 1225 -primOpTag (VecIndexScalarOffAddrOp WordVec 8 W64) = 1226 -primOpTag (VecIndexScalarOffAddrOp FloatVec 4 W32) = 1227 -primOpTag (VecIndexScalarOffAddrOp FloatVec 2 W64) = 1228 -primOpTag (VecIndexScalarOffAddrOp FloatVec 8 W32) = 1229 -primOpTag (VecIndexScalarOffAddrOp FloatVec 4 W64) = 1230 -primOpTag (VecIndexScalarOffAddrOp FloatVec 16 W32) = 1231 -primOpTag (VecIndexScalarOffAddrOp FloatVec 8 W64) = 1232 -primOpTag (VecReadScalarOffAddrOp IntVec 16 W8) = 1233 -primOpTag (VecReadScalarOffAddrOp IntVec 8 W16) = 1234 -primOpTag (VecReadScalarOffAddrOp IntVec 4 W32) = 1235 -primOpTag (VecReadScalarOffAddrOp IntVec 2 W64) = 1236 -primOpTag (VecReadScalarOffAddrOp IntVec 32 W8) = 1237 -primOpTag (VecReadScalarOffAddrOp IntVec 16 W16) = 1238 -primOpTag (VecReadScalarOffAddrOp IntVec 8 W32) = 1239 -primOpTag (VecReadScalarOffAddrOp IntVec 4 W64) = 1240 -primOpTag (VecReadScalarOffAddrOp IntVec 64 W8) = 1241 -primOpTag (VecReadScalarOffAddrOp IntVec 32 W16) = 1242 -primOpTag (VecReadScalarOffAddrOp IntVec 16 W32) = 1243 -primOpTag (VecReadScalarOffAddrOp IntVec 8 W64) = 1244 -primOpTag (VecReadScalarOffAddrOp WordVec 16 W8) = 1245 -primOpTag (VecReadScalarOffAddrOp WordVec 8 W16) = 1246 -primOpTag (VecReadScalarOffAddrOp WordVec 4 W32) = 1247 -primOpTag (VecReadScalarOffAddrOp WordVec 2 W64) = 1248 -primOpTag (VecReadScalarOffAddrOp WordVec 32 W8) = 1249 -primOpTag (VecReadScalarOffAddrOp WordVec 16 W16) = 1250 -primOpTag (VecReadScalarOffAddrOp WordVec 8 W32) = 1251 -primOpTag (VecReadScalarOffAddrOp WordVec 4 W64) = 1252 -primOpTag (VecReadScalarOffAddrOp WordVec 64 W8) = 1253 -primOpTag (VecReadScalarOffAddrOp WordVec 32 W16) = 1254 -primOpTag (VecReadScalarOffAddrOp WordVec 16 W32) = 1255 -primOpTag (VecReadScalarOffAddrOp WordVec 8 W64) = 1256 -primOpTag (VecReadScalarOffAddrOp FloatVec 4 W32) = 1257 -primOpTag (VecReadScalarOffAddrOp FloatVec 2 W64) = 1258 -primOpTag (VecReadScalarOffAddrOp FloatVec 8 W32) = 1259 -primOpTag (VecReadScalarOffAddrOp FloatVec 4 W64) = 1260 -primOpTag (VecReadScalarOffAddrOp FloatVec 16 W32) = 1261 -primOpTag (VecReadScalarOffAddrOp FloatVec 8 W64) = 1262 -primOpTag (VecWriteScalarOffAddrOp IntVec 16 W8) = 1263 -primOpTag (VecWriteScalarOffAddrOp IntVec 8 W16) = 1264 -primOpTag (VecWriteScalarOffAddrOp IntVec 4 W32) = 1265 -primOpTag (VecWriteScalarOffAddrOp IntVec 2 W64) = 1266 -primOpTag (VecWriteScalarOffAddrOp IntVec 32 W8) = 1267 -primOpTag (VecWriteScalarOffAddrOp IntVec 16 W16) = 1268 -primOpTag (VecWriteScalarOffAddrOp IntVec 8 W32) = 1269 -primOpTag (VecWriteScalarOffAddrOp IntVec 4 W64) = 1270 -primOpTag (VecWriteScalarOffAddrOp IntVec 64 W8) = 1271 -primOpTag (VecWriteScalarOffAddrOp IntVec 32 W16) = 1272 -primOpTag (VecWriteScalarOffAddrOp IntVec 16 W32) = 1273 -primOpTag (VecWriteScalarOffAddrOp IntVec 8 W64) = 1274 -primOpTag (VecWriteScalarOffAddrOp WordVec 16 W8) = 1275 -primOpTag (VecWriteScalarOffAddrOp WordVec 8 W16) = 1276 -primOpTag (VecWriteScalarOffAddrOp WordVec 4 W32) = 1277 -primOpTag (VecWriteScalarOffAddrOp WordVec 2 W64) = 1278 -primOpTag (VecWriteScalarOffAddrOp WordVec 32 W8) = 1279 -primOpTag (VecWriteScalarOffAddrOp WordVec 16 W16) = 1280 -primOpTag (VecWriteScalarOffAddrOp WordVec 8 W32) = 1281 -primOpTag (VecWriteScalarOffAddrOp WordVec 4 W64) = 1282 -primOpTag (VecWriteScalarOffAddrOp WordVec 64 W8) = 1283 -primOpTag (VecWriteScalarOffAddrOp WordVec 32 W16) = 1284 -primOpTag (VecWriteScalarOffAddrOp WordVec 16 W32) = 1285 -primOpTag (VecWriteScalarOffAddrOp WordVec 8 W64) = 1286 -primOpTag (VecWriteScalarOffAddrOp FloatVec 4 W32) = 1287 -primOpTag (VecWriteScalarOffAddrOp FloatVec 2 W64) = 1288 -primOpTag (VecWriteScalarOffAddrOp FloatVec 8 W32) = 1289 -primOpTag (VecWriteScalarOffAddrOp FloatVec 4 W64) = 1290 -primOpTag (VecWriteScalarOffAddrOp FloatVec 16 W32) = 1291 -primOpTag (VecWriteScalarOffAddrOp FloatVec 8 W64) = 1292 -primOpTag PrefetchByteArrayOp3 = 1293 -primOpTag PrefetchMutableByteArrayOp3 = 1294 -primOpTag PrefetchAddrOp3 = 1295 -primOpTag PrefetchValueOp3 = 1296 -primOpTag PrefetchByteArrayOp2 = 1297 -primOpTag PrefetchMutableByteArrayOp2 = 1298 -primOpTag PrefetchAddrOp2 = 1299 -primOpTag PrefetchValueOp2 = 1300 -primOpTag PrefetchByteArrayOp1 = 1301 -primOpTag PrefetchMutableByteArrayOp1 = 1302 -primOpTag PrefetchAddrOp1 = 1303 -primOpTag PrefetchValueOp1 = 1304 -primOpTag PrefetchByteArrayOp0 = 1305 -primOpTag PrefetchMutableByteArrayOp0 = 1306 -primOpTag PrefetchAddrOp0 = 1307 -primOpTag PrefetchValueOp0 = 1308 +maxPrimOpTag = 1311 +primOpTag :: PrimOp -> Int +primOpTag CharGtOp = 0 +primOpTag CharGeOp = 1 +primOpTag CharEqOp = 2 +primOpTag CharNeOp = 3 +primOpTag CharLtOp = 4 +primOpTag CharLeOp = 5 +primOpTag OrdOp = 6 +primOpTag Int8ToIntOp = 7 +primOpTag IntToInt8Op = 8 +primOpTag Int8NegOp = 9 +primOpTag Int8AddOp = 10 +primOpTag Int8SubOp = 11 +primOpTag Int8MulOp = 12 +primOpTag Int8QuotOp = 13 +primOpTag Int8RemOp = 14 +primOpTag Int8QuotRemOp = 15 +primOpTag Int8SllOp = 16 +primOpTag Int8SraOp = 17 +primOpTag Int8SrlOp = 18 +primOpTag Int8ToWord8Op = 19 +primOpTag Int8EqOp = 20 +primOpTag Int8GeOp = 21 +primOpTag Int8GtOp = 22 +primOpTag Int8LeOp = 23 +primOpTag Int8LtOp = 24 +primOpTag Int8NeOp = 25 +primOpTag Word8ToWordOp = 26 +primOpTag WordToWord8Op = 27 +primOpTag Word8AddOp = 28 +primOpTag Word8SubOp = 29 +primOpTag Word8MulOp = 30 +primOpTag Word8QuotOp = 31 +primOpTag Word8RemOp = 32 +primOpTag Word8QuotRemOp = 33 +primOpTag Word8AndOp = 34 +primOpTag Word8OrOp = 35 +primOpTag Word8XorOp = 36 +primOpTag Word8NotOp = 37 +primOpTag Word8SllOp = 38 +primOpTag Word8SrlOp = 39 +primOpTag Word8ToInt8Op = 40 +primOpTag Word8EqOp = 41 +primOpTag Word8GeOp = 42 +primOpTag Word8GtOp = 43 +primOpTag Word8LeOp = 44 +primOpTag Word8LtOp = 45 +primOpTag Word8NeOp = 46 +primOpTag Int16ToIntOp = 47 +primOpTag IntToInt16Op = 48 +primOpTag Int16NegOp = 49 +primOpTag Int16AddOp = 50 +primOpTag Int16SubOp = 51 +primOpTag Int16MulOp = 52 +primOpTag Int16QuotOp = 53 +primOpTag Int16RemOp = 54 +primOpTag Int16QuotRemOp = 55 +primOpTag Int16SllOp = 56 +primOpTag Int16SraOp = 57 +primOpTag Int16SrlOp = 58 +primOpTag Int16ToWord16Op = 59 +primOpTag Int16EqOp = 60 +primOpTag Int16GeOp = 61 +primOpTag Int16GtOp = 62 +primOpTag Int16LeOp = 63 +primOpTag Int16LtOp = 64 +primOpTag Int16NeOp = 65 +primOpTag Word16ToWordOp = 66 +primOpTag WordToWord16Op = 67 +primOpTag Word16AddOp = 68 +primOpTag Word16SubOp = 69 +primOpTag Word16MulOp = 70 +primOpTag Word16QuotOp = 71 +primOpTag Word16RemOp = 72 +primOpTag Word16QuotRemOp = 73 +primOpTag Word16AndOp = 74 +primOpTag Word16OrOp = 75 +primOpTag Word16XorOp = 76 +primOpTag Word16NotOp = 77 +primOpTag Word16SllOp = 78 +primOpTag Word16SrlOp = 79 +primOpTag Word16ToInt16Op = 80 +primOpTag Word16EqOp = 81 +primOpTag Word16GeOp = 82 +primOpTag Word16GtOp = 83 +primOpTag Word16LeOp = 84 +primOpTag Word16LtOp = 85 +primOpTag Word16NeOp = 86 +primOpTag Int32ToIntOp = 87 +primOpTag IntToInt32Op = 88 +primOpTag Int32NegOp = 89 +primOpTag Int32AddOp = 90 +primOpTag Int32SubOp = 91 +primOpTag Int32MulOp = 92 +primOpTag Int32QuotOp = 93 +primOpTag Int32RemOp = 94 +primOpTag Int32QuotRemOp = 95 +primOpTag Int32SllOp = 96 +primOpTag Int32SraOp = 97 +primOpTag Int32SrlOp = 98 +primOpTag Int32ToWord32Op = 99 +primOpTag Int32EqOp = 100 +primOpTag Int32GeOp = 101 +primOpTag Int32GtOp = 102 +primOpTag Int32LeOp = 103 +primOpTag Int32LtOp = 104 +primOpTag Int32NeOp = 105 +primOpTag Word32ToWordOp = 106 +primOpTag WordToWord32Op = 107 +primOpTag Word32AddOp = 108 +primOpTag Word32SubOp = 109 +primOpTag Word32MulOp = 110 +primOpTag Word32QuotOp = 111 +primOpTag Word32RemOp = 112 +primOpTag Word32QuotRemOp = 113 +primOpTag Word32AndOp = 114 +primOpTag Word32OrOp = 115 +primOpTag Word32XorOp = 116 +primOpTag Word32NotOp = 117 +primOpTag Word32SllOp = 118 +primOpTag Word32SrlOp = 119 +primOpTag Word32ToInt32Op = 120 +primOpTag Word32EqOp = 121 +primOpTag Word32GeOp = 122 +primOpTag Word32GtOp = 123 +primOpTag Word32LeOp = 124 +primOpTag Word32LtOp = 125 +primOpTag Word32NeOp = 126 +primOpTag Int64ToIntOp = 127 +primOpTag IntToInt64Op = 128 +primOpTag Int64NegOp = 129 +primOpTag Int64AddOp = 130 +primOpTag Int64SubOp = 131 +primOpTag Int64MulOp = 132 +primOpTag Int64QuotOp = 133 +primOpTag Int64RemOp = 134 +primOpTag Int64SllOp = 135 +primOpTag Int64SraOp = 136 +primOpTag Int64SrlOp = 137 +primOpTag Int64ToWord64Op = 138 +primOpTag Int64EqOp = 139 +primOpTag Int64GeOp = 140 +primOpTag Int64GtOp = 141 +primOpTag Int64LeOp = 142 +primOpTag Int64LtOp = 143 +primOpTag Int64NeOp = 144 +primOpTag Word64ToWordOp = 145 +primOpTag WordToWord64Op = 146 +primOpTag Word64AddOp = 147 +primOpTag Word64SubOp = 148 +primOpTag Word64MulOp = 149 +primOpTag Word64QuotOp = 150 +primOpTag Word64RemOp = 151 +primOpTag Word64AndOp = 152 +primOpTag Word64OrOp = 153 +primOpTag Word64XorOp = 154 +primOpTag Word64NotOp = 155 +primOpTag Word64SllOp = 156 +primOpTag Word64SrlOp = 157 +primOpTag Word64ToInt64Op = 158 +primOpTag Word64EqOp = 159 +primOpTag Word64GeOp = 160 +primOpTag Word64GtOp = 161 +primOpTag Word64LeOp = 162 +primOpTag Word64LtOp = 163 +primOpTag Word64NeOp = 164 +primOpTag IntAddOp = 165 +primOpTag IntSubOp = 166 +primOpTag IntMulOp = 167 +primOpTag IntMul2Op = 168 +primOpTag IntMulMayOfloOp = 169 +primOpTag IntQuotOp = 170 +primOpTag IntRemOp = 171 +primOpTag IntQuotRemOp = 172 +primOpTag IntAndOp = 173 +primOpTag IntOrOp = 174 +primOpTag IntXorOp = 175 +primOpTag IntNotOp = 176 +primOpTag IntNegOp = 177 +primOpTag IntAddCOp = 178 +primOpTag IntSubCOp = 179 +primOpTag IntGtOp = 180 +primOpTag IntGeOp = 181 +primOpTag IntEqOp = 182 +primOpTag IntNeOp = 183 +primOpTag IntLtOp = 184 +primOpTag IntLeOp = 185 +primOpTag ChrOp = 186 +primOpTag IntToWordOp = 187 +primOpTag IntToFloatOp = 188 +primOpTag IntToDoubleOp = 189 +primOpTag WordToFloatOp = 190 +primOpTag WordToDoubleOp = 191 +primOpTag IntSllOp = 192 +primOpTag IntSraOp = 193 +primOpTag IntSrlOp = 194 +primOpTag WordAddOp = 195 +primOpTag WordAddCOp = 196 +primOpTag WordSubCOp = 197 +primOpTag WordAdd2Op = 198 +primOpTag WordSubOp = 199 +primOpTag WordMulOp = 200 +primOpTag WordMul2Op = 201 +primOpTag WordQuotOp = 202 +primOpTag WordRemOp = 203 +primOpTag WordQuotRemOp = 204 +primOpTag WordQuotRem2Op = 205 +primOpTag WordAndOp = 206 +primOpTag WordOrOp = 207 +primOpTag WordXorOp = 208 +primOpTag WordNotOp = 209 +primOpTag WordSllOp = 210 +primOpTag WordSrlOp = 211 +primOpTag WordToIntOp = 212 +primOpTag WordGtOp = 213 +primOpTag WordGeOp = 214 +primOpTag WordEqOp = 215 +primOpTag WordNeOp = 216 +primOpTag WordLtOp = 217 +primOpTag WordLeOp = 218 +primOpTag PopCnt8Op = 219 +primOpTag PopCnt16Op = 220 +primOpTag PopCnt32Op = 221 +primOpTag PopCnt64Op = 222 +primOpTag PopCntOp = 223 +primOpTag Pdep8Op = 224 +primOpTag Pdep16Op = 225 +primOpTag Pdep32Op = 226 +primOpTag Pdep64Op = 227 +primOpTag PdepOp = 228 +primOpTag Pext8Op = 229 +primOpTag Pext16Op = 230 +primOpTag Pext32Op = 231 +primOpTag Pext64Op = 232 +primOpTag PextOp = 233 +primOpTag Clz8Op = 234 +primOpTag Clz16Op = 235 +primOpTag Clz32Op = 236 +primOpTag Clz64Op = 237 +primOpTag ClzOp = 238 +primOpTag Ctz8Op = 239 +primOpTag Ctz16Op = 240 +primOpTag Ctz32Op = 241 +primOpTag Ctz64Op = 242 +primOpTag CtzOp = 243 +primOpTag BSwap16Op = 244 +primOpTag BSwap32Op = 245 +primOpTag BSwap64Op = 246 +primOpTag BSwapOp = 247 +primOpTag BRev8Op = 248 +primOpTag BRev16Op = 249 +primOpTag BRev32Op = 250 +primOpTag BRev64Op = 251 +primOpTag BRevOp = 252 +primOpTag Narrow8IntOp = 253 +primOpTag Narrow16IntOp = 254 +primOpTag Narrow32IntOp = 255 +primOpTag Narrow8WordOp = 256 +primOpTag Narrow16WordOp = 257 +primOpTag Narrow32WordOp = 258 +primOpTag DoubleGtOp = 259 +primOpTag DoubleGeOp = 260 +primOpTag DoubleEqOp = 261 +primOpTag DoubleNeOp = 262 +primOpTag DoubleLtOp = 263 +primOpTag DoubleLeOp = 264 +primOpTag DoubleAddOp = 265 +primOpTag DoubleSubOp = 266 +primOpTag DoubleMulOp = 267 +primOpTag DoubleDivOp = 268 +primOpTag DoubleNegOp = 269 +primOpTag DoubleFabsOp = 270 +primOpTag DoubleToIntOp = 271 +primOpTag DoubleToFloatOp = 272 +primOpTag DoubleExpOp = 273 +primOpTag DoubleExpM1Op = 274 +primOpTag DoubleLogOp = 275 +primOpTag DoubleLog1POp = 276 +primOpTag DoubleSqrtOp = 277 +primOpTag DoubleSinOp = 278 +primOpTag DoubleCosOp = 279 +primOpTag DoubleTanOp = 280 +primOpTag DoubleAsinOp = 281 +primOpTag DoubleAcosOp = 282 +primOpTag DoubleAtanOp = 283 +primOpTag DoubleSinhOp = 284 +primOpTag DoubleCoshOp = 285 +primOpTag DoubleTanhOp = 286 +primOpTag DoubleAsinhOp = 287 +primOpTag DoubleAcoshOp = 288 +primOpTag DoubleAtanhOp = 289 +primOpTag DoublePowerOp = 290 +primOpTag DoubleDecode_2IntOp = 291 +primOpTag DoubleDecode_Int64Op = 292 +primOpTag FloatGtOp = 293 +primOpTag FloatGeOp = 294 +primOpTag FloatEqOp = 295 +primOpTag FloatNeOp = 296 +primOpTag FloatLtOp = 297 +primOpTag FloatLeOp = 298 +primOpTag FloatAddOp = 299 +primOpTag FloatSubOp = 300 +primOpTag FloatMulOp = 301 +primOpTag FloatDivOp = 302 +primOpTag FloatNegOp = 303 +primOpTag FloatFabsOp = 304 +primOpTag FloatToIntOp = 305 +primOpTag FloatExpOp = 306 +primOpTag FloatExpM1Op = 307 +primOpTag FloatLogOp = 308 +primOpTag FloatLog1POp = 309 +primOpTag FloatSqrtOp = 310 +primOpTag FloatSinOp = 311 +primOpTag FloatCosOp = 312 +primOpTag FloatTanOp = 313 +primOpTag FloatAsinOp = 314 +primOpTag FloatAcosOp = 315 +primOpTag FloatAtanOp = 316 +primOpTag FloatSinhOp = 317 +primOpTag FloatCoshOp = 318 +primOpTag FloatTanhOp = 319 +primOpTag FloatAsinhOp = 320 +primOpTag FloatAcoshOp = 321 +primOpTag FloatAtanhOp = 322 +primOpTag FloatPowerOp = 323 +primOpTag FloatToDoubleOp = 324 +primOpTag FloatDecode_IntOp = 325 +primOpTag NewArrayOp = 326 +primOpTag ReadArrayOp = 327 +primOpTag WriteArrayOp = 328 +primOpTag SizeofArrayOp = 329 +primOpTag SizeofMutableArrayOp = 330 +primOpTag IndexArrayOp = 331 +primOpTag UnsafeFreezeArrayOp = 332 +primOpTag UnsafeThawArrayOp = 333 +primOpTag CopyArrayOp = 334 +primOpTag CopyMutableArrayOp = 335 +primOpTag CloneArrayOp = 336 +primOpTag CloneMutableArrayOp = 337 +primOpTag FreezeArrayOp = 338 +primOpTag ThawArrayOp = 339 +primOpTag CasArrayOp = 340 +primOpTag NewSmallArrayOp = 341 +primOpTag ShrinkSmallMutableArrayOp_Char = 342 +primOpTag ReadSmallArrayOp = 343 +primOpTag WriteSmallArrayOp = 344 +primOpTag SizeofSmallArrayOp = 345 +primOpTag SizeofSmallMutableArrayOp = 346 +primOpTag GetSizeofSmallMutableArrayOp = 347 +primOpTag IndexSmallArrayOp = 348 +primOpTag UnsafeFreezeSmallArrayOp = 349 +primOpTag UnsafeThawSmallArrayOp = 350 +primOpTag CopySmallArrayOp = 351 +primOpTag CopySmallMutableArrayOp = 352 +primOpTag CloneSmallArrayOp = 353 +primOpTag CloneSmallMutableArrayOp = 354 +primOpTag FreezeSmallArrayOp = 355 +primOpTag ThawSmallArrayOp = 356 +primOpTag CasSmallArrayOp = 357 +primOpTag NewByteArrayOp_Char = 358 +primOpTag NewPinnedByteArrayOp_Char = 359 +primOpTag NewAlignedPinnedByteArrayOp_Char = 360 +primOpTag MutableByteArrayIsPinnedOp = 361 +primOpTag ByteArrayIsPinnedOp = 362 +primOpTag ByteArrayContents_Char = 363 +primOpTag MutableByteArrayContents_Char = 364 +primOpTag ShrinkMutableByteArrayOp_Char = 365 +primOpTag ResizeMutableByteArrayOp_Char = 366 +primOpTag UnsafeFreezeByteArrayOp = 367 +primOpTag SizeofByteArrayOp = 368 +primOpTag SizeofMutableByteArrayOp = 369 +primOpTag GetSizeofMutableByteArrayOp = 370 +primOpTag IndexByteArrayOp_Char = 371 +primOpTag IndexByteArrayOp_WideChar = 372 +primOpTag IndexByteArrayOp_Int = 373 +primOpTag IndexByteArrayOp_Word = 374 +primOpTag IndexByteArrayOp_Addr = 375 +primOpTag IndexByteArrayOp_Float = 376 +primOpTag IndexByteArrayOp_Double = 377 +primOpTag IndexByteArrayOp_StablePtr = 378 +primOpTag IndexByteArrayOp_Int8 = 379 +primOpTag IndexByteArrayOp_Int16 = 380 +primOpTag IndexByteArrayOp_Int32 = 381 +primOpTag IndexByteArrayOp_Int64 = 382 +primOpTag IndexByteArrayOp_Word8 = 383 +primOpTag IndexByteArrayOp_Word16 = 384 +primOpTag IndexByteArrayOp_Word32 = 385 +primOpTag IndexByteArrayOp_Word64 = 386 +primOpTag IndexByteArrayOp_Word8AsChar = 387 +primOpTag IndexByteArrayOp_Word8AsWideChar = 388 +primOpTag IndexByteArrayOp_Word8AsInt = 389 +primOpTag IndexByteArrayOp_Word8AsWord = 390 +primOpTag IndexByteArrayOp_Word8AsAddr = 391 +primOpTag IndexByteArrayOp_Word8AsFloat = 392 +primOpTag IndexByteArrayOp_Word8AsDouble = 393 +primOpTag IndexByteArrayOp_Word8AsStablePtr = 394 +primOpTag IndexByteArrayOp_Word8AsInt16 = 395 +primOpTag IndexByteArrayOp_Word8AsInt32 = 396 +primOpTag IndexByteArrayOp_Word8AsInt64 = 397 +primOpTag IndexByteArrayOp_Word8AsWord16 = 398 +primOpTag IndexByteArrayOp_Word8AsWord32 = 399 +primOpTag IndexByteArrayOp_Word8AsWord64 = 400 +primOpTag ReadByteArrayOp_Char = 401 +primOpTag ReadByteArrayOp_WideChar = 402 +primOpTag ReadByteArrayOp_Int = 403 +primOpTag ReadByteArrayOp_Word = 404 +primOpTag ReadByteArrayOp_Addr = 405 +primOpTag ReadByteArrayOp_Float = 406 +primOpTag ReadByteArrayOp_Double = 407 +primOpTag ReadByteArrayOp_StablePtr = 408 +primOpTag ReadByteArrayOp_Int8 = 409 +primOpTag ReadByteArrayOp_Int16 = 410 +primOpTag ReadByteArrayOp_Int32 = 411 +primOpTag ReadByteArrayOp_Int64 = 412 +primOpTag ReadByteArrayOp_Word8 = 413 +primOpTag ReadByteArrayOp_Word16 = 414 +primOpTag ReadByteArrayOp_Word32 = 415 +primOpTag ReadByteArrayOp_Word64 = 416 +primOpTag ReadByteArrayOp_Word8AsChar = 417 +primOpTag ReadByteArrayOp_Word8AsWideChar = 418 +primOpTag ReadByteArrayOp_Word8AsInt = 419 +primOpTag ReadByteArrayOp_Word8AsWord = 420 +primOpTag ReadByteArrayOp_Word8AsAddr = 421 +primOpTag ReadByteArrayOp_Word8AsFloat = 422 +primOpTag ReadByteArrayOp_Word8AsDouble = 423 +primOpTag ReadByteArrayOp_Word8AsStablePtr = 424 +primOpTag ReadByteArrayOp_Word8AsInt16 = 425 +primOpTag ReadByteArrayOp_Word8AsInt32 = 426 +primOpTag ReadByteArrayOp_Word8AsInt64 = 427 +primOpTag ReadByteArrayOp_Word8AsWord16 = 428 +primOpTag ReadByteArrayOp_Word8AsWord32 = 429 +primOpTag ReadByteArrayOp_Word8AsWord64 = 430 +primOpTag WriteByteArrayOp_Char = 431 +primOpTag WriteByteArrayOp_WideChar = 432 +primOpTag WriteByteArrayOp_Int = 433 +primOpTag WriteByteArrayOp_Word = 434 +primOpTag WriteByteArrayOp_Addr = 435 +primOpTag WriteByteArrayOp_Float = 436 +primOpTag WriteByteArrayOp_Double = 437 +primOpTag WriteByteArrayOp_StablePtr = 438 +primOpTag WriteByteArrayOp_Int8 = 439 +primOpTag WriteByteArrayOp_Int16 = 440 +primOpTag WriteByteArrayOp_Int32 = 441 +primOpTag WriteByteArrayOp_Int64 = 442 +primOpTag WriteByteArrayOp_Word8 = 443 +primOpTag WriteByteArrayOp_Word16 = 444 +primOpTag WriteByteArrayOp_Word32 = 445 +primOpTag WriteByteArrayOp_Word64 = 446 +primOpTag WriteByteArrayOp_Word8AsChar = 447 +primOpTag WriteByteArrayOp_Word8AsWideChar = 448 +primOpTag WriteByteArrayOp_Word8AsInt = 449 +primOpTag WriteByteArrayOp_Word8AsWord = 450 +primOpTag WriteByteArrayOp_Word8AsAddr = 451 +primOpTag WriteByteArrayOp_Word8AsFloat = 452 +primOpTag WriteByteArrayOp_Word8AsDouble = 453 +primOpTag WriteByteArrayOp_Word8AsStablePtr = 454 +primOpTag WriteByteArrayOp_Word8AsInt16 = 455 +primOpTag WriteByteArrayOp_Word8AsInt32 = 456 +primOpTag WriteByteArrayOp_Word8AsInt64 = 457 +primOpTag WriteByteArrayOp_Word8AsWord16 = 458 +primOpTag WriteByteArrayOp_Word8AsWord32 = 459 +primOpTag WriteByteArrayOp_Word8AsWord64 = 460 +primOpTag CompareByteArraysOp = 461 +primOpTag CopyByteArrayOp = 462 +primOpTag CopyMutableByteArrayOp = 463 +primOpTag CopyByteArrayToAddrOp = 464 +primOpTag CopyMutableByteArrayToAddrOp = 465 +primOpTag CopyAddrToByteArrayOp = 466 +primOpTag SetByteArrayOp = 467 +primOpTag AtomicReadByteArrayOp_Int = 468 +primOpTag AtomicWriteByteArrayOp_Int = 469 +primOpTag CasByteArrayOp_Int = 470 +primOpTag CasByteArrayOp_Int8 = 471 +primOpTag CasByteArrayOp_Int16 = 472 +primOpTag CasByteArrayOp_Int32 = 473 +primOpTag CasByteArrayOp_Int64 = 474 +primOpTag FetchAddByteArrayOp_Int = 475 +primOpTag FetchSubByteArrayOp_Int = 476 +primOpTag FetchAndByteArrayOp_Int = 477 +primOpTag FetchNandByteArrayOp_Int = 478 +primOpTag FetchOrByteArrayOp_Int = 479 +primOpTag FetchXorByteArrayOp_Int = 480 +primOpTag AddrAddOp = 481 +primOpTag AddrSubOp = 482 +primOpTag AddrRemOp = 483 +primOpTag AddrToIntOp = 484 +primOpTag IntToAddrOp = 485 +primOpTag AddrGtOp = 486 +primOpTag AddrGeOp = 487 +primOpTag AddrEqOp = 488 +primOpTag AddrNeOp = 489 +primOpTag AddrLtOp = 490 +primOpTag AddrLeOp = 491 +primOpTag IndexOffAddrOp_Char = 492 +primOpTag IndexOffAddrOp_WideChar = 493 +primOpTag IndexOffAddrOp_Int = 494 +primOpTag IndexOffAddrOp_Word = 495 +primOpTag IndexOffAddrOp_Addr = 496 +primOpTag IndexOffAddrOp_Float = 497 +primOpTag IndexOffAddrOp_Double = 498 +primOpTag IndexOffAddrOp_StablePtr = 499 +primOpTag IndexOffAddrOp_Int8 = 500 +primOpTag IndexOffAddrOp_Int16 = 501 +primOpTag IndexOffAddrOp_Int32 = 502 +primOpTag IndexOffAddrOp_Int64 = 503 +primOpTag IndexOffAddrOp_Word8 = 504 +primOpTag IndexOffAddrOp_Word16 = 505 +primOpTag IndexOffAddrOp_Word32 = 506 +primOpTag IndexOffAddrOp_Word64 = 507 +primOpTag ReadOffAddrOp_Char = 508 +primOpTag ReadOffAddrOp_WideChar = 509 +primOpTag ReadOffAddrOp_Int = 510 +primOpTag ReadOffAddrOp_Word = 511 +primOpTag ReadOffAddrOp_Addr = 512 +primOpTag ReadOffAddrOp_Float = 513 +primOpTag ReadOffAddrOp_Double = 514 +primOpTag ReadOffAddrOp_StablePtr = 515 +primOpTag ReadOffAddrOp_Int8 = 516 +primOpTag ReadOffAddrOp_Int16 = 517 +primOpTag ReadOffAddrOp_Int32 = 518 +primOpTag ReadOffAddrOp_Int64 = 519 +primOpTag ReadOffAddrOp_Word8 = 520 +primOpTag ReadOffAddrOp_Word16 = 521 +primOpTag ReadOffAddrOp_Word32 = 522 +primOpTag ReadOffAddrOp_Word64 = 523 +primOpTag WriteOffAddrOp_Char = 524 +primOpTag WriteOffAddrOp_WideChar = 525 +primOpTag WriteOffAddrOp_Int = 526 +primOpTag WriteOffAddrOp_Word = 527 +primOpTag WriteOffAddrOp_Addr = 528 +primOpTag WriteOffAddrOp_Float = 529 +primOpTag WriteOffAddrOp_Double = 530 +primOpTag WriteOffAddrOp_StablePtr = 531 +primOpTag WriteOffAddrOp_Int8 = 532 +primOpTag WriteOffAddrOp_Int16 = 533 +primOpTag WriteOffAddrOp_Int32 = 534 +primOpTag WriteOffAddrOp_Int64 = 535 +primOpTag WriteOffAddrOp_Word8 = 536 +primOpTag WriteOffAddrOp_Word16 = 537 +primOpTag WriteOffAddrOp_Word32 = 538 +primOpTag WriteOffAddrOp_Word64 = 539 +primOpTag InterlockedExchange_Addr = 540 +primOpTag InterlockedExchange_Word = 541 +primOpTag CasAddrOp_Addr = 542 +primOpTag CasAddrOp_Word = 543 +primOpTag CasAddrOp_Word8 = 544 +primOpTag CasAddrOp_Word16 = 545 +primOpTag CasAddrOp_Word32 = 546 +primOpTag CasAddrOp_Word64 = 547 +primOpTag FetchAddAddrOp_Word = 548 +primOpTag FetchSubAddrOp_Word = 549 +primOpTag FetchAndAddrOp_Word = 550 +primOpTag FetchNandAddrOp_Word = 551 +primOpTag FetchOrAddrOp_Word = 552 +primOpTag FetchXorAddrOp_Word = 553 +primOpTag AtomicReadAddrOp_Word = 554 +primOpTag AtomicWriteAddrOp_Word = 555 +primOpTag NewMutVarOp = 556 +primOpTag ReadMutVarOp = 557 +primOpTag WriteMutVarOp = 558 +primOpTag AtomicModifyMutVar2Op = 559 +primOpTag AtomicModifyMutVar_Op = 560 +primOpTag CasMutVarOp = 561 +primOpTag CatchOp = 562 +primOpTag RaiseOp = 563 +primOpTag RaiseUnderflowOp = 564 +primOpTag RaiseOverflowOp = 565 +primOpTag RaiseDivZeroOp = 566 +primOpTag RaiseIOOp = 567 +primOpTag MaskAsyncExceptionsOp = 568 +primOpTag MaskUninterruptibleOp = 569 +primOpTag UnmaskAsyncExceptionsOp = 570 +primOpTag MaskStatus = 571 +primOpTag NewPromptTagOp = 572 +primOpTag PromptOp = 573 +primOpTag Control0Op = 574 +primOpTag AtomicallyOp = 575 +primOpTag RetryOp = 576 +primOpTag CatchRetryOp = 577 +primOpTag CatchSTMOp = 578 +primOpTag NewTVarOp = 579 +primOpTag ReadTVarOp = 580 +primOpTag ReadTVarIOOp = 581 +primOpTag WriteTVarOp = 582 +primOpTag NewMVarOp = 583 +primOpTag TakeMVarOp = 584 +primOpTag TryTakeMVarOp = 585 +primOpTag PutMVarOp = 586 +primOpTag TryPutMVarOp = 587 +primOpTag ReadMVarOp = 588 +primOpTag TryReadMVarOp = 589 +primOpTag IsEmptyMVarOp = 590 +primOpTag NewIOPortOp = 591 +primOpTag ReadIOPortOp = 592 +primOpTag WriteIOPortOp = 593 +primOpTag DelayOp = 594 +primOpTag WaitReadOp = 595 +primOpTag WaitWriteOp = 596 +primOpTag ForkOp = 597 +primOpTag ForkOnOp = 598 +primOpTag KillThreadOp = 599 +primOpTag YieldOp = 600 +primOpTag MyThreadIdOp = 601 +primOpTag LabelThreadOp = 602 +primOpTag IsCurrentThreadBoundOp = 603 +primOpTag NoDuplicateOp = 604 +primOpTag GetThreadLabelOp = 605 +primOpTag ThreadStatusOp = 606 +primOpTag ListThreadsOp = 607 +primOpTag MkWeakOp = 608 +primOpTag MkWeakNoFinalizerOp = 609 +primOpTag AddCFinalizerToWeakOp = 610 +primOpTag DeRefWeakOp = 611 +primOpTag FinalizeWeakOp = 612 +primOpTag TouchOp = 613 +primOpTag MakeStablePtrOp = 614 +primOpTag DeRefStablePtrOp = 615 +primOpTag EqStablePtrOp = 616 +primOpTag MakeStableNameOp = 617 +primOpTag StableNameToIntOp = 618 +primOpTag CompactNewOp = 619 +primOpTag CompactResizeOp = 620 +primOpTag CompactContainsOp = 621 +primOpTag CompactContainsAnyOp = 622 +primOpTag CompactGetFirstBlockOp = 623 +primOpTag CompactGetNextBlockOp = 624 +primOpTag CompactAllocateBlockOp = 625 +primOpTag CompactFixupPointersOp = 626 +primOpTag CompactAdd = 627 +primOpTag CompactAddWithSharing = 628 +primOpTag CompactSize = 629 +primOpTag ReallyUnsafePtrEqualityOp = 630 +primOpTag ParOp = 631 +primOpTag SparkOp = 632 +primOpTag SeqOp = 633 +primOpTag GetSparkOp = 634 +primOpTag NumSparks = 635 +primOpTag KeepAliveOp = 636 +primOpTag DataToTagOp = 637 +primOpTag TagToEnumOp = 638 +primOpTag AddrToAnyOp = 639 +primOpTag AnyToAddrOp = 640 +primOpTag MkApUpd0_Op = 641 +primOpTag NewBCOOp = 642 +primOpTag UnpackClosureOp = 643 +primOpTag ClosureSizeOp = 644 +primOpTag GetApStackValOp = 645 +primOpTag GetCCSOfOp = 646 +primOpTag GetCurrentCCSOp = 647 +primOpTag ClearCCSOp = 648 +primOpTag WhereFromOp = 649 +primOpTag TraceEventOp = 650 +primOpTag TraceEventBinaryOp = 651 +primOpTag TraceMarkerOp = 652 +primOpTag SetThreadAllocationCounter = 653 +primOpTag (VecBroadcastOp IntVec 16 W8) = 654 +primOpTag (VecBroadcastOp IntVec 8 W16) = 655 +primOpTag (VecBroadcastOp IntVec 4 W32) = 656 +primOpTag (VecBroadcastOp IntVec 2 W64) = 657 +primOpTag (VecBroadcastOp IntVec 32 W8) = 658 +primOpTag (VecBroadcastOp IntVec 16 W16) = 659 +primOpTag (VecBroadcastOp IntVec 8 W32) = 660 +primOpTag (VecBroadcastOp IntVec 4 W64) = 661 +primOpTag (VecBroadcastOp IntVec 64 W8) = 662 +primOpTag (VecBroadcastOp IntVec 32 W16) = 663 +primOpTag (VecBroadcastOp IntVec 16 W32) = 664 +primOpTag (VecBroadcastOp IntVec 8 W64) = 665 +primOpTag (VecBroadcastOp WordVec 16 W8) = 666 +primOpTag (VecBroadcastOp WordVec 8 W16) = 667 +primOpTag (VecBroadcastOp WordVec 4 W32) = 668 +primOpTag (VecBroadcastOp WordVec 2 W64) = 669 +primOpTag (VecBroadcastOp WordVec 32 W8) = 670 +primOpTag (VecBroadcastOp WordVec 16 W16) = 671 +primOpTag (VecBroadcastOp WordVec 8 W32) = 672 +primOpTag (VecBroadcastOp WordVec 4 W64) = 673 +primOpTag (VecBroadcastOp WordVec 64 W8) = 674 +primOpTag (VecBroadcastOp WordVec 32 W16) = 675 +primOpTag (VecBroadcastOp WordVec 16 W32) = 676 +primOpTag (VecBroadcastOp WordVec 8 W64) = 677 +primOpTag (VecBroadcastOp FloatVec 4 W32) = 678 +primOpTag (VecBroadcastOp FloatVec 2 W64) = 679 +primOpTag (VecBroadcastOp FloatVec 8 W32) = 680 +primOpTag (VecBroadcastOp FloatVec 4 W64) = 681 +primOpTag (VecBroadcastOp FloatVec 16 W32) = 682 +primOpTag (VecBroadcastOp FloatVec 8 W64) = 683 +primOpTag (VecPackOp IntVec 16 W8) = 684 +primOpTag (VecPackOp IntVec 8 W16) = 685 +primOpTag (VecPackOp IntVec 4 W32) = 686 +primOpTag (VecPackOp IntVec 2 W64) = 687 +primOpTag (VecPackOp IntVec 32 W8) = 688 +primOpTag (VecPackOp IntVec 16 W16) = 689 +primOpTag (VecPackOp IntVec 8 W32) = 690 +primOpTag (VecPackOp IntVec 4 W64) = 691 +primOpTag (VecPackOp IntVec 64 W8) = 692 +primOpTag (VecPackOp IntVec 32 W16) = 693 +primOpTag (VecPackOp IntVec 16 W32) = 694 +primOpTag (VecPackOp IntVec 8 W64) = 695 +primOpTag (VecPackOp WordVec 16 W8) = 696 +primOpTag (VecPackOp WordVec 8 W16) = 697 +primOpTag (VecPackOp WordVec 4 W32) = 698 +primOpTag (VecPackOp WordVec 2 W64) = 699 +primOpTag (VecPackOp WordVec 32 W8) = 700 +primOpTag (VecPackOp WordVec 16 W16) = 701 +primOpTag (VecPackOp WordVec 8 W32) = 702 +primOpTag (VecPackOp WordVec 4 W64) = 703 +primOpTag (VecPackOp WordVec 64 W8) = 704 +primOpTag (VecPackOp WordVec 32 W16) = 705 +primOpTag (VecPackOp WordVec 16 W32) = 706 +primOpTag (VecPackOp WordVec 8 W64) = 707 +primOpTag (VecPackOp FloatVec 4 W32) = 708 +primOpTag (VecPackOp FloatVec 2 W64) = 709 +primOpTag (VecPackOp FloatVec 8 W32) = 710 +primOpTag (VecPackOp FloatVec 4 W64) = 711 +primOpTag (VecPackOp FloatVec 16 W32) = 712 +primOpTag (VecPackOp FloatVec 8 W64) = 713 +primOpTag (VecUnpackOp IntVec 16 W8) = 714 +primOpTag (VecUnpackOp IntVec 8 W16) = 715 +primOpTag (VecUnpackOp IntVec 4 W32) = 716 +primOpTag (VecUnpackOp IntVec 2 W64) = 717 +primOpTag (VecUnpackOp IntVec 32 W8) = 718 +primOpTag (VecUnpackOp IntVec 16 W16) = 719 +primOpTag (VecUnpackOp IntVec 8 W32) = 720 +primOpTag (VecUnpackOp IntVec 4 W64) = 721 +primOpTag (VecUnpackOp IntVec 64 W8) = 722 +primOpTag (VecUnpackOp IntVec 32 W16) = 723 +primOpTag (VecUnpackOp IntVec 16 W32) = 724 +primOpTag (VecUnpackOp IntVec 8 W64) = 725 +primOpTag (VecUnpackOp WordVec 16 W8) = 726 +primOpTag (VecUnpackOp WordVec 8 W16) = 727 +primOpTag (VecUnpackOp WordVec 4 W32) = 728 +primOpTag (VecUnpackOp WordVec 2 W64) = 729 +primOpTag (VecUnpackOp WordVec 32 W8) = 730 +primOpTag (VecUnpackOp WordVec 16 W16) = 731 +primOpTag (VecUnpackOp WordVec 8 W32) = 732 +primOpTag (VecUnpackOp WordVec 4 W64) = 733 +primOpTag (VecUnpackOp WordVec 64 W8) = 734 +primOpTag (VecUnpackOp WordVec 32 W16) = 735 +primOpTag (VecUnpackOp WordVec 16 W32) = 736 +primOpTag (VecUnpackOp WordVec 8 W64) = 737 +primOpTag (VecUnpackOp FloatVec 4 W32) = 738 +primOpTag (VecUnpackOp FloatVec 2 W64) = 739 +primOpTag (VecUnpackOp FloatVec 8 W32) = 740 +primOpTag (VecUnpackOp FloatVec 4 W64) = 741 +primOpTag (VecUnpackOp FloatVec 16 W32) = 742 +primOpTag (VecUnpackOp FloatVec 8 W64) = 743 +primOpTag (VecInsertOp IntVec 16 W8) = 744 +primOpTag (VecInsertOp IntVec 8 W16) = 745 +primOpTag (VecInsertOp IntVec 4 W32) = 746 +primOpTag (VecInsertOp IntVec 2 W64) = 747 +primOpTag (VecInsertOp IntVec 32 W8) = 748 +primOpTag (VecInsertOp IntVec 16 W16) = 749 +primOpTag (VecInsertOp IntVec 8 W32) = 750 +primOpTag (VecInsertOp IntVec 4 W64) = 751 +primOpTag (VecInsertOp IntVec 64 W8) = 752 +primOpTag (VecInsertOp IntVec 32 W16) = 753 +primOpTag (VecInsertOp IntVec 16 W32) = 754 +primOpTag (VecInsertOp IntVec 8 W64) = 755 +primOpTag (VecInsertOp WordVec 16 W8) = 756 +primOpTag (VecInsertOp WordVec 8 W16) = 757 +primOpTag (VecInsertOp WordVec 4 W32) = 758 +primOpTag (VecInsertOp WordVec 2 W64) = 759 +primOpTag (VecInsertOp WordVec 32 W8) = 760 +primOpTag (VecInsertOp WordVec 16 W16) = 761 +primOpTag (VecInsertOp WordVec 8 W32) = 762 +primOpTag (VecInsertOp WordVec 4 W64) = 763 +primOpTag (VecInsertOp WordVec 64 W8) = 764 +primOpTag (VecInsertOp WordVec 32 W16) = 765 +primOpTag (VecInsertOp WordVec 16 W32) = 766 +primOpTag (VecInsertOp WordVec 8 W64) = 767 +primOpTag (VecInsertOp FloatVec 4 W32) = 768 +primOpTag (VecInsertOp FloatVec 2 W64) = 769 +primOpTag (VecInsertOp FloatVec 8 W32) = 770 +primOpTag (VecInsertOp FloatVec 4 W64) = 771 +primOpTag (VecInsertOp FloatVec 16 W32) = 772 +primOpTag (VecInsertOp FloatVec 8 W64) = 773 +primOpTag (VecAddOp IntVec 16 W8) = 774 +primOpTag (VecAddOp IntVec 8 W16) = 775 +primOpTag (VecAddOp IntVec 4 W32) = 776 +primOpTag (VecAddOp IntVec 2 W64) = 777 +primOpTag (VecAddOp IntVec 32 W8) = 778 +primOpTag (VecAddOp IntVec 16 W16) = 779 +primOpTag (VecAddOp IntVec 8 W32) = 780 +primOpTag (VecAddOp IntVec 4 W64) = 781 +primOpTag (VecAddOp IntVec 64 W8) = 782 +primOpTag (VecAddOp IntVec 32 W16) = 783 +primOpTag (VecAddOp IntVec 16 W32) = 784 +primOpTag (VecAddOp IntVec 8 W64) = 785 +primOpTag (VecAddOp WordVec 16 W8) = 786 +primOpTag (VecAddOp WordVec 8 W16) = 787 +primOpTag (VecAddOp WordVec 4 W32) = 788 +primOpTag (VecAddOp WordVec 2 W64) = 789 +primOpTag (VecAddOp WordVec 32 W8) = 790 +primOpTag (VecAddOp WordVec 16 W16) = 791 +primOpTag (VecAddOp WordVec 8 W32) = 792 +primOpTag (VecAddOp WordVec 4 W64) = 793 +primOpTag (VecAddOp WordVec 64 W8) = 794 +primOpTag (VecAddOp WordVec 32 W16) = 795 +primOpTag (VecAddOp WordVec 16 W32) = 796 +primOpTag (VecAddOp WordVec 8 W64) = 797 +primOpTag (VecAddOp FloatVec 4 W32) = 798 +primOpTag (VecAddOp FloatVec 2 W64) = 799 +primOpTag (VecAddOp FloatVec 8 W32) = 800 +primOpTag (VecAddOp FloatVec 4 W64) = 801 +primOpTag (VecAddOp FloatVec 16 W32) = 802 +primOpTag (VecAddOp FloatVec 8 W64) = 803 +primOpTag (VecSubOp IntVec 16 W8) = 804 +primOpTag (VecSubOp IntVec 8 W16) = 805 +primOpTag (VecSubOp IntVec 4 W32) = 806 +primOpTag (VecSubOp IntVec 2 W64) = 807 +primOpTag (VecSubOp IntVec 32 W8) = 808 +primOpTag (VecSubOp IntVec 16 W16) = 809 +primOpTag (VecSubOp IntVec 8 W32) = 810 +primOpTag (VecSubOp IntVec 4 W64) = 811 +primOpTag (VecSubOp IntVec 64 W8) = 812 +primOpTag (VecSubOp IntVec 32 W16) = 813 +primOpTag (VecSubOp IntVec 16 W32) = 814 +primOpTag (VecSubOp IntVec 8 W64) = 815 +primOpTag (VecSubOp WordVec 16 W8) = 816 +primOpTag (VecSubOp WordVec 8 W16) = 817 +primOpTag (VecSubOp WordVec 4 W32) = 818 +primOpTag (VecSubOp WordVec 2 W64) = 819 +primOpTag (VecSubOp WordVec 32 W8) = 820 +primOpTag (VecSubOp WordVec 16 W16) = 821 +primOpTag (VecSubOp WordVec 8 W32) = 822 +primOpTag (VecSubOp WordVec 4 W64) = 823 +primOpTag (VecSubOp WordVec 64 W8) = 824 +primOpTag (VecSubOp WordVec 32 W16) = 825 +primOpTag (VecSubOp WordVec 16 W32) = 826 +primOpTag (VecSubOp WordVec 8 W64) = 827 +primOpTag (VecSubOp FloatVec 4 W32) = 828 +primOpTag (VecSubOp FloatVec 2 W64) = 829 +primOpTag (VecSubOp FloatVec 8 W32) = 830 +primOpTag (VecSubOp FloatVec 4 W64) = 831 +primOpTag (VecSubOp FloatVec 16 W32) = 832 +primOpTag (VecSubOp FloatVec 8 W64) = 833 +primOpTag (VecMulOp IntVec 16 W8) = 834 +primOpTag (VecMulOp IntVec 8 W16) = 835 +primOpTag (VecMulOp IntVec 4 W32) = 836 +primOpTag (VecMulOp IntVec 2 W64) = 837 +primOpTag (VecMulOp IntVec 32 W8) = 838 +primOpTag (VecMulOp IntVec 16 W16) = 839 +primOpTag (VecMulOp IntVec 8 W32) = 840 +primOpTag (VecMulOp IntVec 4 W64) = 841 +primOpTag (VecMulOp IntVec 64 W8) = 842 +primOpTag (VecMulOp IntVec 32 W16) = 843 +primOpTag (VecMulOp IntVec 16 W32) = 844 +primOpTag (VecMulOp IntVec 8 W64) = 845 +primOpTag (VecMulOp WordVec 16 W8) = 846 +primOpTag (VecMulOp WordVec 8 W16) = 847 +primOpTag (VecMulOp WordVec 4 W32) = 848 +primOpTag (VecMulOp WordVec 2 W64) = 849 +primOpTag (VecMulOp WordVec 32 W8) = 850 +primOpTag (VecMulOp WordVec 16 W16) = 851 +primOpTag (VecMulOp WordVec 8 W32) = 852 +primOpTag (VecMulOp WordVec 4 W64) = 853 +primOpTag (VecMulOp WordVec 64 W8) = 854 +primOpTag (VecMulOp WordVec 32 W16) = 855 +primOpTag (VecMulOp WordVec 16 W32) = 856 +primOpTag (VecMulOp WordVec 8 W64) = 857 +primOpTag (VecMulOp FloatVec 4 W32) = 858 +primOpTag (VecMulOp FloatVec 2 W64) = 859 +primOpTag (VecMulOp FloatVec 8 W32) = 860 +primOpTag (VecMulOp FloatVec 4 W64) = 861 +primOpTag (VecMulOp FloatVec 16 W32) = 862 +primOpTag (VecMulOp FloatVec 8 W64) = 863 +primOpTag (VecDivOp FloatVec 4 W32) = 864 +primOpTag (VecDivOp FloatVec 2 W64) = 865 +primOpTag (VecDivOp FloatVec 8 W32) = 866 +primOpTag (VecDivOp FloatVec 4 W64) = 867 +primOpTag (VecDivOp FloatVec 16 W32) = 868 +primOpTag (VecDivOp FloatVec 8 W64) = 869 +primOpTag (VecQuotOp IntVec 16 W8) = 870 +primOpTag (VecQuotOp IntVec 8 W16) = 871 +primOpTag (VecQuotOp IntVec 4 W32) = 872 +primOpTag (VecQuotOp IntVec 2 W64) = 873 +primOpTag (VecQuotOp IntVec 32 W8) = 874 +primOpTag (VecQuotOp IntVec 16 W16) = 875 +primOpTag (VecQuotOp IntVec 8 W32) = 876 +primOpTag (VecQuotOp IntVec 4 W64) = 877 +primOpTag (VecQuotOp IntVec 64 W8) = 878 +primOpTag (VecQuotOp IntVec 32 W16) = 879 +primOpTag (VecQuotOp IntVec 16 W32) = 880 +primOpTag (VecQuotOp IntVec 8 W64) = 881 +primOpTag (VecQuotOp WordVec 16 W8) = 882 +primOpTag (VecQuotOp WordVec 8 W16) = 883 +primOpTag (VecQuotOp WordVec 4 W32) = 884 +primOpTag (VecQuotOp WordVec 2 W64) = 885 +primOpTag (VecQuotOp WordVec 32 W8) = 886 +primOpTag (VecQuotOp WordVec 16 W16) = 887 +primOpTag (VecQuotOp WordVec 8 W32) = 888 +primOpTag (VecQuotOp WordVec 4 W64) = 889 +primOpTag (VecQuotOp WordVec 64 W8) = 890 +primOpTag (VecQuotOp WordVec 32 W16) = 891 +primOpTag (VecQuotOp WordVec 16 W32) = 892 +primOpTag (VecQuotOp WordVec 8 W64) = 893 +primOpTag (VecRemOp IntVec 16 W8) = 894 +primOpTag (VecRemOp IntVec 8 W16) = 895 +primOpTag (VecRemOp IntVec 4 W32) = 896 +primOpTag (VecRemOp IntVec 2 W64) = 897 +primOpTag (VecRemOp IntVec 32 W8) = 898 +primOpTag (VecRemOp IntVec 16 W16) = 899 +primOpTag (VecRemOp IntVec 8 W32) = 900 +primOpTag (VecRemOp IntVec 4 W64) = 901 +primOpTag (VecRemOp IntVec 64 W8) = 902 +primOpTag (VecRemOp IntVec 32 W16) = 903 +primOpTag (VecRemOp IntVec 16 W32) = 904 +primOpTag (VecRemOp IntVec 8 W64) = 905 +primOpTag (VecRemOp WordVec 16 W8) = 906 +primOpTag (VecRemOp WordVec 8 W16) = 907 +primOpTag (VecRemOp WordVec 4 W32) = 908 +primOpTag (VecRemOp WordVec 2 W64) = 909 +primOpTag (VecRemOp WordVec 32 W8) = 910 +primOpTag (VecRemOp WordVec 16 W16) = 911 +primOpTag (VecRemOp WordVec 8 W32) = 912 +primOpTag (VecRemOp WordVec 4 W64) = 913 +primOpTag (VecRemOp WordVec 64 W8) = 914 +primOpTag (VecRemOp WordVec 32 W16) = 915 +primOpTag (VecRemOp WordVec 16 W32) = 916 +primOpTag (VecRemOp WordVec 8 W64) = 917 +primOpTag (VecNegOp IntVec 16 W8) = 918 +primOpTag (VecNegOp IntVec 8 W16) = 919 +primOpTag (VecNegOp IntVec 4 W32) = 920 +primOpTag (VecNegOp IntVec 2 W64) = 921 +primOpTag (VecNegOp IntVec 32 W8) = 922 +primOpTag (VecNegOp IntVec 16 W16) = 923 +primOpTag (VecNegOp IntVec 8 W32) = 924 +primOpTag (VecNegOp IntVec 4 W64) = 925 +primOpTag (VecNegOp IntVec 64 W8) = 926 +primOpTag (VecNegOp IntVec 32 W16) = 927 +primOpTag (VecNegOp IntVec 16 W32) = 928 +primOpTag (VecNegOp IntVec 8 W64) = 929 +primOpTag (VecNegOp FloatVec 4 W32) = 930 +primOpTag (VecNegOp FloatVec 2 W64) = 931 +primOpTag (VecNegOp FloatVec 8 W32) = 932 +primOpTag (VecNegOp FloatVec 4 W64) = 933 +primOpTag (VecNegOp FloatVec 16 W32) = 934 +primOpTag (VecNegOp FloatVec 8 W64) = 935 +primOpTag (VecIndexByteArrayOp IntVec 16 W8) = 936 +primOpTag (VecIndexByteArrayOp IntVec 8 W16) = 937 +primOpTag (VecIndexByteArrayOp IntVec 4 W32) = 938 +primOpTag (VecIndexByteArrayOp IntVec 2 W64) = 939 +primOpTag (VecIndexByteArrayOp IntVec 32 W8) = 940 +primOpTag (VecIndexByteArrayOp IntVec 16 W16) = 941 +primOpTag (VecIndexByteArrayOp IntVec 8 W32) = 942 +primOpTag (VecIndexByteArrayOp IntVec 4 W64) = 943 +primOpTag (VecIndexByteArrayOp IntVec 64 W8) = 944 +primOpTag (VecIndexByteArrayOp IntVec 32 W16) = 945 +primOpTag (VecIndexByteArrayOp IntVec 16 W32) = 946 +primOpTag (VecIndexByteArrayOp IntVec 8 W64) = 947 +primOpTag (VecIndexByteArrayOp WordVec 16 W8) = 948 +primOpTag (VecIndexByteArrayOp WordVec 8 W16) = 949 +primOpTag (VecIndexByteArrayOp WordVec 4 W32) = 950 +primOpTag (VecIndexByteArrayOp WordVec 2 W64) = 951 +primOpTag (VecIndexByteArrayOp WordVec 32 W8) = 952 +primOpTag (VecIndexByteArrayOp WordVec 16 W16) = 953 +primOpTag (VecIndexByteArrayOp WordVec 8 W32) = 954 +primOpTag (VecIndexByteArrayOp WordVec 4 W64) = 955 +primOpTag (VecIndexByteArrayOp WordVec 64 W8) = 956 +primOpTag (VecIndexByteArrayOp WordVec 32 W16) = 957 +primOpTag (VecIndexByteArrayOp WordVec 16 W32) = 958 +primOpTag (VecIndexByteArrayOp WordVec 8 W64) = 959 +primOpTag (VecIndexByteArrayOp FloatVec 4 W32) = 960 +primOpTag (VecIndexByteArrayOp FloatVec 2 W64) = 961 +primOpTag (VecIndexByteArrayOp FloatVec 8 W32) = 962 +primOpTag (VecIndexByteArrayOp FloatVec 4 W64) = 963 +primOpTag (VecIndexByteArrayOp FloatVec 16 W32) = 964 +primOpTag (VecIndexByteArrayOp FloatVec 8 W64) = 965 +primOpTag (VecReadByteArrayOp IntVec 16 W8) = 966 +primOpTag (VecReadByteArrayOp IntVec 8 W16) = 967 +primOpTag (VecReadByteArrayOp IntVec 4 W32) = 968 +primOpTag (VecReadByteArrayOp IntVec 2 W64) = 969 +primOpTag (VecReadByteArrayOp IntVec 32 W8) = 970 +primOpTag (VecReadByteArrayOp IntVec 16 W16) = 971 +primOpTag (VecReadByteArrayOp IntVec 8 W32) = 972 +primOpTag (VecReadByteArrayOp IntVec 4 W64) = 973 +primOpTag (VecReadByteArrayOp IntVec 64 W8) = 974 +primOpTag (VecReadByteArrayOp IntVec 32 W16) = 975 +primOpTag (VecReadByteArrayOp IntVec 16 W32) = 976 +primOpTag (VecReadByteArrayOp IntVec 8 W64) = 977 +primOpTag (VecReadByteArrayOp WordVec 16 W8) = 978 +primOpTag (VecReadByteArrayOp WordVec 8 W16) = 979 +primOpTag (VecReadByteArrayOp WordVec 4 W32) = 980 +primOpTag (VecReadByteArrayOp WordVec 2 W64) = 981 +primOpTag (VecReadByteArrayOp WordVec 32 W8) = 982 +primOpTag (VecReadByteArrayOp WordVec 16 W16) = 983 +primOpTag (VecReadByteArrayOp WordVec 8 W32) = 984 +primOpTag (VecReadByteArrayOp WordVec 4 W64) = 985 +primOpTag (VecReadByteArrayOp WordVec 64 W8) = 986 +primOpTag (VecReadByteArrayOp WordVec 32 W16) = 987 +primOpTag (VecReadByteArrayOp WordVec 16 W32) = 988 +primOpTag (VecReadByteArrayOp WordVec 8 W64) = 989 +primOpTag (VecReadByteArrayOp FloatVec 4 W32) = 990 +primOpTag (VecReadByteArrayOp FloatVec 2 W64) = 991 +primOpTag (VecReadByteArrayOp FloatVec 8 W32) = 992 +primOpTag (VecReadByteArrayOp FloatVec 4 W64) = 993 +primOpTag (VecReadByteArrayOp FloatVec 16 W32) = 994 +primOpTag (VecReadByteArrayOp FloatVec 8 W64) = 995 +primOpTag (VecWriteByteArrayOp IntVec 16 W8) = 996 +primOpTag (VecWriteByteArrayOp IntVec 8 W16) = 997 +primOpTag (VecWriteByteArrayOp IntVec 4 W32) = 998 +primOpTag (VecWriteByteArrayOp IntVec 2 W64) = 999 +primOpTag (VecWriteByteArrayOp IntVec 32 W8) = 1000 +primOpTag (VecWriteByteArrayOp IntVec 16 W16) = 1001 +primOpTag (VecWriteByteArrayOp IntVec 8 W32) = 1002 +primOpTag (VecWriteByteArrayOp IntVec 4 W64) = 1003 +primOpTag (VecWriteByteArrayOp IntVec 64 W8) = 1004 +primOpTag (VecWriteByteArrayOp IntVec 32 W16) = 1005 +primOpTag (VecWriteByteArrayOp IntVec 16 W32) = 1006 +primOpTag (VecWriteByteArrayOp IntVec 8 W64) = 1007 +primOpTag (VecWriteByteArrayOp WordVec 16 W8) = 1008 +primOpTag (VecWriteByteArrayOp WordVec 8 W16) = 1009 +primOpTag (VecWriteByteArrayOp WordVec 4 W32) = 1010 +primOpTag (VecWriteByteArrayOp WordVec 2 W64) = 1011 +primOpTag (VecWriteByteArrayOp WordVec 32 W8) = 1012 +primOpTag (VecWriteByteArrayOp WordVec 16 W16) = 1013 +primOpTag (VecWriteByteArrayOp WordVec 8 W32) = 1014 +primOpTag (VecWriteByteArrayOp WordVec 4 W64) = 1015 +primOpTag (VecWriteByteArrayOp WordVec 64 W8) = 1016 +primOpTag (VecWriteByteArrayOp WordVec 32 W16) = 1017 +primOpTag (VecWriteByteArrayOp WordVec 16 W32) = 1018 +primOpTag (VecWriteByteArrayOp WordVec 8 W64) = 1019 +primOpTag (VecWriteByteArrayOp FloatVec 4 W32) = 1020 +primOpTag (VecWriteByteArrayOp FloatVec 2 W64) = 1021 +primOpTag (VecWriteByteArrayOp FloatVec 8 W32) = 1022 +primOpTag (VecWriteByteArrayOp FloatVec 4 W64) = 1023 +primOpTag (VecWriteByteArrayOp FloatVec 16 W32) = 1024 +primOpTag (VecWriteByteArrayOp FloatVec 8 W64) = 1025 +primOpTag (VecIndexOffAddrOp IntVec 16 W8) = 1026 +primOpTag (VecIndexOffAddrOp IntVec 8 W16) = 1027 +primOpTag (VecIndexOffAddrOp IntVec 4 W32) = 1028 +primOpTag (VecIndexOffAddrOp IntVec 2 W64) = 1029 +primOpTag (VecIndexOffAddrOp IntVec 32 W8) = 1030 +primOpTag (VecIndexOffAddrOp IntVec 16 W16) = 1031 +primOpTag (VecIndexOffAddrOp IntVec 8 W32) = 1032 +primOpTag (VecIndexOffAddrOp IntVec 4 W64) = 1033 +primOpTag (VecIndexOffAddrOp IntVec 64 W8) = 1034 +primOpTag (VecIndexOffAddrOp IntVec 32 W16) = 1035 +primOpTag (VecIndexOffAddrOp IntVec 16 W32) = 1036 +primOpTag (VecIndexOffAddrOp IntVec 8 W64) = 1037 +primOpTag (VecIndexOffAddrOp WordVec 16 W8) = 1038 +primOpTag (VecIndexOffAddrOp WordVec 8 W16) = 1039 +primOpTag (VecIndexOffAddrOp WordVec 4 W32) = 1040 +primOpTag (VecIndexOffAddrOp WordVec 2 W64) = 1041 +primOpTag (VecIndexOffAddrOp WordVec 32 W8) = 1042 +primOpTag (VecIndexOffAddrOp WordVec 16 W16) = 1043 +primOpTag (VecIndexOffAddrOp WordVec 8 W32) = 1044 +primOpTag (VecIndexOffAddrOp WordVec 4 W64) = 1045 +primOpTag (VecIndexOffAddrOp WordVec 64 W8) = 1046 +primOpTag (VecIndexOffAddrOp WordVec 32 W16) = 1047 +primOpTag (VecIndexOffAddrOp WordVec 16 W32) = 1048 +primOpTag (VecIndexOffAddrOp WordVec 8 W64) = 1049 +primOpTag (VecIndexOffAddrOp FloatVec 4 W32) = 1050 +primOpTag (VecIndexOffAddrOp FloatVec 2 W64) = 1051 +primOpTag (VecIndexOffAddrOp FloatVec 8 W32) = 1052 +primOpTag (VecIndexOffAddrOp FloatVec 4 W64) = 1053 +primOpTag (VecIndexOffAddrOp FloatVec 16 W32) = 1054 +primOpTag (VecIndexOffAddrOp FloatVec 8 W64) = 1055 +primOpTag (VecReadOffAddrOp IntVec 16 W8) = 1056 +primOpTag (VecReadOffAddrOp IntVec 8 W16) = 1057 +primOpTag (VecReadOffAddrOp IntVec 4 W32) = 1058 +primOpTag (VecReadOffAddrOp IntVec 2 W64) = 1059 +primOpTag (VecReadOffAddrOp IntVec 32 W8) = 1060 +primOpTag (VecReadOffAddrOp IntVec 16 W16) = 1061 +primOpTag (VecReadOffAddrOp IntVec 8 W32) = 1062 +primOpTag (VecReadOffAddrOp IntVec 4 W64) = 1063 +primOpTag (VecReadOffAddrOp IntVec 64 W8) = 1064 +primOpTag (VecReadOffAddrOp IntVec 32 W16) = 1065 +primOpTag (VecReadOffAddrOp IntVec 16 W32) = 1066 +primOpTag (VecReadOffAddrOp IntVec 8 W64) = 1067 +primOpTag (VecReadOffAddrOp WordVec 16 W8) = 1068 +primOpTag (VecReadOffAddrOp WordVec 8 W16) = 1069 +primOpTag (VecReadOffAddrOp WordVec 4 W32) = 1070 +primOpTag (VecReadOffAddrOp WordVec 2 W64) = 1071 +primOpTag (VecReadOffAddrOp WordVec 32 W8) = 1072 +primOpTag (VecReadOffAddrOp WordVec 16 W16) = 1073 +primOpTag (VecReadOffAddrOp WordVec 8 W32) = 1074 +primOpTag (VecReadOffAddrOp WordVec 4 W64) = 1075 +primOpTag (VecReadOffAddrOp WordVec 64 W8) = 1076 +primOpTag (VecReadOffAddrOp WordVec 32 W16) = 1077 +primOpTag (VecReadOffAddrOp WordVec 16 W32) = 1078 +primOpTag (VecReadOffAddrOp WordVec 8 W64) = 1079 +primOpTag (VecReadOffAddrOp FloatVec 4 W32) = 1080 +primOpTag (VecReadOffAddrOp FloatVec 2 W64) = 1081 +primOpTag (VecReadOffAddrOp FloatVec 8 W32) = 1082 +primOpTag (VecReadOffAddrOp FloatVec 4 W64) = 1083 +primOpTag (VecReadOffAddrOp FloatVec 16 W32) = 1084 +primOpTag (VecReadOffAddrOp FloatVec 8 W64) = 1085 +primOpTag (VecWriteOffAddrOp IntVec 16 W8) = 1086 +primOpTag (VecWriteOffAddrOp IntVec 8 W16) = 1087 +primOpTag (VecWriteOffAddrOp IntVec 4 W32) = 1088 +primOpTag (VecWriteOffAddrOp IntVec 2 W64) = 1089 +primOpTag (VecWriteOffAddrOp IntVec 32 W8) = 1090 +primOpTag (VecWriteOffAddrOp IntVec 16 W16) = 1091 +primOpTag (VecWriteOffAddrOp IntVec 8 W32) = 1092 +primOpTag (VecWriteOffAddrOp IntVec 4 W64) = 1093 +primOpTag (VecWriteOffAddrOp IntVec 64 W8) = 1094 +primOpTag (VecWriteOffAddrOp IntVec 32 W16) = 1095 +primOpTag (VecWriteOffAddrOp IntVec 16 W32) = 1096 +primOpTag (VecWriteOffAddrOp IntVec 8 W64) = 1097 +primOpTag (VecWriteOffAddrOp WordVec 16 W8) = 1098 +primOpTag (VecWriteOffAddrOp WordVec 8 W16) = 1099 +primOpTag (VecWriteOffAddrOp WordVec 4 W32) = 1100 +primOpTag (VecWriteOffAddrOp WordVec 2 W64) = 1101 +primOpTag (VecWriteOffAddrOp WordVec 32 W8) = 1102 +primOpTag (VecWriteOffAddrOp WordVec 16 W16) = 1103 +primOpTag (VecWriteOffAddrOp WordVec 8 W32) = 1104 +primOpTag (VecWriteOffAddrOp WordVec 4 W64) = 1105 +primOpTag (VecWriteOffAddrOp WordVec 64 W8) = 1106 +primOpTag (VecWriteOffAddrOp WordVec 32 W16) = 1107 +primOpTag (VecWriteOffAddrOp WordVec 16 W32) = 1108 +primOpTag (VecWriteOffAddrOp WordVec 8 W64) = 1109 +primOpTag (VecWriteOffAddrOp FloatVec 4 W32) = 1110 +primOpTag (VecWriteOffAddrOp FloatVec 2 W64) = 1111 +primOpTag (VecWriteOffAddrOp FloatVec 8 W32) = 1112 +primOpTag (VecWriteOffAddrOp FloatVec 4 W64) = 1113 +primOpTag (VecWriteOffAddrOp FloatVec 16 W32) = 1114 +primOpTag (VecWriteOffAddrOp FloatVec 8 W64) = 1115 +primOpTag (VecIndexScalarByteArrayOp IntVec 16 W8) = 1116 +primOpTag (VecIndexScalarByteArrayOp IntVec 8 W16) = 1117 +primOpTag (VecIndexScalarByteArrayOp IntVec 4 W32) = 1118 +primOpTag (VecIndexScalarByteArrayOp IntVec 2 W64) = 1119 +primOpTag (VecIndexScalarByteArrayOp IntVec 32 W8) = 1120 +primOpTag (VecIndexScalarByteArrayOp IntVec 16 W16) = 1121 +primOpTag (VecIndexScalarByteArrayOp IntVec 8 W32) = 1122 +primOpTag (VecIndexScalarByteArrayOp IntVec 4 W64) = 1123 +primOpTag (VecIndexScalarByteArrayOp IntVec 64 W8) = 1124 +primOpTag (VecIndexScalarByteArrayOp IntVec 32 W16) = 1125 +primOpTag (VecIndexScalarByteArrayOp IntVec 16 W32) = 1126 +primOpTag (VecIndexScalarByteArrayOp IntVec 8 W64) = 1127 +primOpTag (VecIndexScalarByteArrayOp WordVec 16 W8) = 1128 +primOpTag (VecIndexScalarByteArrayOp WordVec 8 W16) = 1129 +primOpTag (VecIndexScalarByteArrayOp WordVec 4 W32) = 1130 +primOpTag (VecIndexScalarByteArrayOp WordVec 2 W64) = 1131 +primOpTag (VecIndexScalarByteArrayOp WordVec 32 W8) = 1132 +primOpTag (VecIndexScalarByteArrayOp WordVec 16 W16) = 1133 +primOpTag (VecIndexScalarByteArrayOp WordVec 8 W32) = 1134 +primOpTag (VecIndexScalarByteArrayOp WordVec 4 W64) = 1135 +primOpTag (VecIndexScalarByteArrayOp WordVec 64 W8) = 1136 +primOpTag (VecIndexScalarByteArrayOp WordVec 32 W16) = 1137 +primOpTag (VecIndexScalarByteArrayOp WordVec 16 W32) = 1138 +primOpTag (VecIndexScalarByteArrayOp WordVec 8 W64) = 1139 +primOpTag (VecIndexScalarByteArrayOp FloatVec 4 W32) = 1140 +primOpTag (VecIndexScalarByteArrayOp FloatVec 2 W64) = 1141 +primOpTag (VecIndexScalarByteArrayOp FloatVec 8 W32) = 1142 +primOpTag (VecIndexScalarByteArrayOp FloatVec 4 W64) = 1143 +primOpTag (VecIndexScalarByteArrayOp FloatVec 16 W32) = 1144 +primOpTag (VecIndexScalarByteArrayOp FloatVec 8 W64) = 1145 +primOpTag (VecReadScalarByteArrayOp IntVec 16 W8) = 1146 +primOpTag (VecReadScalarByteArrayOp IntVec 8 W16) = 1147 +primOpTag (VecReadScalarByteArrayOp IntVec 4 W32) = 1148 +primOpTag (VecReadScalarByteArrayOp IntVec 2 W64) = 1149 +primOpTag (VecReadScalarByteArrayOp IntVec 32 W8) = 1150 +primOpTag (VecReadScalarByteArrayOp IntVec 16 W16) = 1151 +primOpTag (VecReadScalarByteArrayOp IntVec 8 W32) = 1152 +primOpTag (VecReadScalarByteArrayOp IntVec 4 W64) = 1153 +primOpTag (VecReadScalarByteArrayOp IntVec 64 W8) = 1154 +primOpTag (VecReadScalarByteArrayOp IntVec 32 W16) = 1155 +primOpTag (VecReadScalarByteArrayOp IntVec 16 W32) = 1156 +primOpTag (VecReadScalarByteArrayOp IntVec 8 W64) = 1157 +primOpTag (VecReadScalarByteArrayOp WordVec 16 W8) = 1158 +primOpTag (VecReadScalarByteArrayOp WordVec 8 W16) = 1159 +primOpTag (VecReadScalarByteArrayOp WordVec 4 W32) = 1160 +primOpTag (VecReadScalarByteArrayOp WordVec 2 W64) = 1161 +primOpTag (VecReadScalarByteArrayOp WordVec 32 W8) = 1162 +primOpTag (VecReadScalarByteArrayOp WordVec 16 W16) = 1163 +primOpTag (VecReadScalarByteArrayOp WordVec 8 W32) = 1164 +primOpTag (VecReadScalarByteArrayOp WordVec 4 W64) = 1165 +primOpTag (VecReadScalarByteArrayOp WordVec 64 W8) = 1166 +primOpTag (VecReadScalarByteArrayOp WordVec 32 W16) = 1167 +primOpTag (VecReadScalarByteArrayOp WordVec 16 W32) = 1168 +primOpTag (VecReadScalarByteArrayOp WordVec 8 W64) = 1169 +primOpTag (VecReadScalarByteArrayOp FloatVec 4 W32) = 1170 +primOpTag (VecReadScalarByteArrayOp FloatVec 2 W64) = 1171 +primOpTag (VecReadScalarByteArrayOp FloatVec 8 W32) = 1172 +primOpTag (VecReadScalarByteArrayOp FloatVec 4 W64) = 1173 +primOpTag (VecReadScalarByteArrayOp FloatVec 16 W32) = 1174 +primOpTag (VecReadScalarByteArrayOp FloatVec 8 W64) = 1175 +primOpTag (VecWriteScalarByteArrayOp IntVec 16 W8) = 1176 +primOpTag (VecWriteScalarByteArrayOp IntVec 8 W16) = 1177 +primOpTag (VecWriteScalarByteArrayOp IntVec 4 W32) = 1178 +primOpTag (VecWriteScalarByteArrayOp IntVec 2 W64) = 1179 +primOpTag (VecWriteScalarByteArrayOp IntVec 32 W8) = 1180 +primOpTag (VecWriteScalarByteArrayOp IntVec 16 W16) = 1181 +primOpTag (VecWriteScalarByteArrayOp IntVec 8 W32) = 1182 +primOpTag (VecWriteScalarByteArrayOp IntVec 4 W64) = 1183 +primOpTag (VecWriteScalarByteArrayOp IntVec 64 W8) = 1184 +primOpTag (VecWriteScalarByteArrayOp IntVec 32 W16) = 1185 +primOpTag (VecWriteScalarByteArrayOp IntVec 16 W32) = 1186 +primOpTag (VecWriteScalarByteArrayOp IntVec 8 W64) = 1187 +primOpTag (VecWriteScalarByteArrayOp WordVec 16 W8) = 1188 +primOpTag (VecWriteScalarByteArrayOp WordVec 8 W16) = 1189 +primOpTag (VecWriteScalarByteArrayOp WordVec 4 W32) = 1190 +primOpTag (VecWriteScalarByteArrayOp WordVec 2 W64) = 1191 +primOpTag (VecWriteScalarByteArrayOp WordVec 32 W8) = 1192 +primOpTag (VecWriteScalarByteArrayOp WordVec 16 W16) = 1193 +primOpTag (VecWriteScalarByteArrayOp WordVec 8 W32) = 1194 +primOpTag (VecWriteScalarByteArrayOp WordVec 4 W64) = 1195 +primOpTag (VecWriteScalarByteArrayOp WordVec 64 W8) = 1196 +primOpTag (VecWriteScalarByteArrayOp WordVec 32 W16) = 1197 +primOpTag (VecWriteScalarByteArrayOp WordVec 16 W32) = 1198 +primOpTag (VecWriteScalarByteArrayOp WordVec 8 W64) = 1199 +primOpTag (VecWriteScalarByteArrayOp FloatVec 4 W32) = 1200 +primOpTag (VecWriteScalarByteArrayOp FloatVec 2 W64) = 1201 +primOpTag (VecWriteScalarByteArrayOp FloatVec 8 W32) = 1202 +primOpTag (VecWriteScalarByteArrayOp FloatVec 4 W64) = 1203 +primOpTag (VecWriteScalarByteArrayOp FloatVec 16 W32) = 1204 +primOpTag (VecWriteScalarByteArrayOp FloatVec 8 W64) = 1205 +primOpTag (VecIndexScalarOffAddrOp IntVec 16 W8) = 1206 +primOpTag (VecIndexScalarOffAddrOp IntVec 8 W16) = 1207 +primOpTag (VecIndexScalarOffAddrOp IntVec 4 W32) = 1208 +primOpTag (VecIndexScalarOffAddrOp IntVec 2 W64) = 1209 +primOpTag (VecIndexScalarOffAddrOp IntVec 32 W8) = 1210 +primOpTag (VecIndexScalarOffAddrOp IntVec 16 W16) = 1211 +primOpTag (VecIndexScalarOffAddrOp IntVec 8 W32) = 1212 +primOpTag (VecIndexScalarOffAddrOp IntVec 4 W64) = 1213 +primOpTag (VecIndexScalarOffAddrOp IntVec 64 W8) = 1214 +primOpTag (VecIndexScalarOffAddrOp IntVec 32 W16) = 1215 +primOpTag (VecIndexScalarOffAddrOp IntVec 16 W32) = 1216 +primOpTag (VecIndexScalarOffAddrOp IntVec 8 W64) = 1217 +primOpTag (VecIndexScalarOffAddrOp WordVec 16 W8) = 1218 +primOpTag (VecIndexScalarOffAddrOp WordVec 8 W16) = 1219 +primOpTag (VecIndexScalarOffAddrOp WordVec 4 W32) = 1220 +primOpTag (VecIndexScalarOffAddrOp WordVec 2 W64) = 1221 +primOpTag (VecIndexScalarOffAddrOp WordVec 32 W8) = 1222 +primOpTag (VecIndexScalarOffAddrOp WordVec 16 W16) = 1223 +primOpTag (VecIndexScalarOffAddrOp WordVec 8 W32) = 1224 +primOpTag (VecIndexScalarOffAddrOp WordVec 4 W64) = 1225 +primOpTag (VecIndexScalarOffAddrOp WordVec 64 W8) = 1226 +primOpTag (VecIndexScalarOffAddrOp WordVec 32 W16) = 1227 +primOpTag (VecIndexScalarOffAddrOp WordVec 16 W32) = 1228 +primOpTag (VecIndexScalarOffAddrOp WordVec 8 W64) = 1229 +primOpTag (VecIndexScalarOffAddrOp FloatVec 4 W32) = 1230 +primOpTag (VecIndexScalarOffAddrOp FloatVec 2 W64) = 1231 +primOpTag (VecIndexScalarOffAddrOp FloatVec 8 W32) = 1232 +primOpTag (VecIndexScalarOffAddrOp FloatVec 4 W64) = 1233 +primOpTag (VecIndexScalarOffAddrOp FloatVec 16 W32) = 1234 +primOpTag (VecIndexScalarOffAddrOp FloatVec 8 W64) = 1235 +primOpTag (VecReadScalarOffAddrOp IntVec 16 W8) = 1236 +primOpTag (VecReadScalarOffAddrOp IntVec 8 W16) = 1237 +primOpTag (VecReadScalarOffAddrOp IntVec 4 W32) = 1238 +primOpTag (VecReadScalarOffAddrOp IntVec 2 W64) = 1239 +primOpTag (VecReadScalarOffAddrOp IntVec 32 W8) = 1240 +primOpTag (VecReadScalarOffAddrOp IntVec 16 W16) = 1241 +primOpTag (VecReadScalarOffAddrOp IntVec 8 W32) = 1242 +primOpTag (VecReadScalarOffAddrOp IntVec 4 W64) = 1243 +primOpTag (VecReadScalarOffAddrOp IntVec 64 W8) = 1244 +primOpTag (VecReadScalarOffAddrOp IntVec 32 W16) = 1245 +primOpTag (VecReadScalarOffAddrOp IntVec 16 W32) = 1246 +primOpTag (VecReadScalarOffAddrOp IntVec 8 W64) = 1247 +primOpTag (VecReadScalarOffAddrOp WordVec 16 W8) = 1248 +primOpTag (VecReadScalarOffAddrOp WordVec 8 W16) = 1249 +primOpTag (VecReadScalarOffAddrOp WordVec 4 W32) = 1250 +primOpTag (VecReadScalarOffAddrOp WordVec 2 W64) = 1251 +primOpTag (VecReadScalarOffAddrOp WordVec 32 W8) = 1252 +primOpTag (VecReadScalarOffAddrOp WordVec 16 W16) = 1253 +primOpTag (VecReadScalarOffAddrOp WordVec 8 W32) = 1254 +primOpTag (VecReadScalarOffAddrOp WordVec 4 W64) = 1255 +primOpTag (VecReadScalarOffAddrOp WordVec 64 W8) = 1256 +primOpTag (VecReadScalarOffAddrOp WordVec 32 W16) = 1257 +primOpTag (VecReadScalarOffAddrOp WordVec 16 W32) = 1258 +primOpTag (VecReadScalarOffAddrOp WordVec 8 W64) = 1259 +primOpTag (VecReadScalarOffAddrOp FloatVec 4 W32) = 1260 +primOpTag (VecReadScalarOffAddrOp FloatVec 2 W64) = 1261 +primOpTag (VecReadScalarOffAddrOp FloatVec 8 W32) = 1262 +primOpTag (VecReadScalarOffAddrOp FloatVec 4 W64) = 1263 +primOpTag (VecReadScalarOffAddrOp FloatVec 16 W32) = 1264 +primOpTag (VecReadScalarOffAddrOp FloatVec 8 W64) = 1265 +primOpTag (VecWriteScalarOffAddrOp IntVec 16 W8) = 1266 +primOpTag (VecWriteScalarOffAddrOp IntVec 8 W16) = 1267 +primOpTag (VecWriteScalarOffAddrOp IntVec 4 W32) = 1268 +primOpTag (VecWriteScalarOffAddrOp IntVec 2 W64) = 1269 +primOpTag (VecWriteScalarOffAddrOp IntVec 32 W8) = 1270 +primOpTag (VecWriteScalarOffAddrOp IntVec 16 W16) = 1271 +primOpTag (VecWriteScalarOffAddrOp IntVec 8 W32) = 1272 +primOpTag (VecWriteScalarOffAddrOp IntVec 4 W64) = 1273 +primOpTag (VecWriteScalarOffAddrOp IntVec 64 W8) = 1274 +primOpTag (VecWriteScalarOffAddrOp IntVec 32 W16) = 1275 +primOpTag (VecWriteScalarOffAddrOp IntVec 16 W32) = 1276 +primOpTag (VecWriteScalarOffAddrOp IntVec 8 W64) = 1277 +primOpTag (VecWriteScalarOffAddrOp WordVec 16 W8) = 1278 +primOpTag (VecWriteScalarOffAddrOp WordVec 8 W16) = 1279 +primOpTag (VecWriteScalarOffAddrOp WordVec 4 W32) = 1280 +primOpTag (VecWriteScalarOffAddrOp WordVec 2 W64) = 1281 +primOpTag (VecWriteScalarOffAddrOp WordVec 32 W8) = 1282 +primOpTag (VecWriteScalarOffAddrOp WordVec 16 W16) = 1283 +primOpTag (VecWriteScalarOffAddrOp WordVec 8 W32) = 1284 +primOpTag (VecWriteScalarOffAddrOp WordVec 4 W64) = 1285 +primOpTag (VecWriteScalarOffAddrOp WordVec 64 W8) = 1286 +primOpTag (VecWriteScalarOffAddrOp WordVec 32 W16) = 1287 +primOpTag (VecWriteScalarOffAddrOp WordVec 16 W32) = 1288 +primOpTag (VecWriteScalarOffAddrOp WordVec 8 W64) = 1289 +primOpTag (VecWriteScalarOffAddrOp FloatVec 4 W32) = 1290 +primOpTag (VecWriteScalarOffAddrOp FloatVec 2 W64) = 1291 +primOpTag (VecWriteScalarOffAddrOp FloatVec 8 W32) = 1292 +primOpTag (VecWriteScalarOffAddrOp FloatVec 4 W64) = 1293 +primOpTag (VecWriteScalarOffAddrOp FloatVec 16 W32) = 1294 +primOpTag (VecWriteScalarOffAddrOp FloatVec 8 W64) = 1295 +primOpTag PrefetchByteArrayOp3 = 1296 +primOpTag PrefetchMutableByteArrayOp3 = 1297 +primOpTag PrefetchAddrOp3 = 1298 +primOpTag PrefetchValueOp3 = 1299 +primOpTag PrefetchByteArrayOp2 = 1300 +primOpTag PrefetchMutableByteArrayOp2 = 1301 +primOpTag PrefetchAddrOp2 = 1302 +primOpTag PrefetchValueOp2 = 1303 +primOpTag PrefetchByteArrayOp1 = 1304 +primOpTag PrefetchMutableByteArrayOp1 = 1305 +primOpTag PrefetchAddrOp1 = 1306 +primOpTag PrefetchValueOp1 = 1307 +primOpTag PrefetchByteArrayOp0 = 1308 +primOpTag PrefetchMutableByteArrayOp0 = 1309 +primOpTag PrefetchAddrOp0 = 1310 +primOpTag PrefetchValueOp0 = 1311 diff --git a/ghc-lib/stage0/lib/llvm-targets b/ghc-lib/stage0/lib/llvm-targets --- a/ghc-lib/stage0/lib/llvm-targets +++ b/ghc-lib/stage0/lib/llvm-targets @@ -21,6 +21,9 @@ ,("aarch64-unknown-linux-gnu", ("e-m:e-i8:8:32-i16:16:32-i64:64-i128:128-n32:64-S128", "generic", "+neon")) ,("aarch64-unknown-linux-musl", ("e-m:e-i8:8:32-i16:16:32-i64:64-i128:128-n32:64-S128", "generic", "+neon")) ,("aarch64-unknown-linux", ("e-m:e-i8:8:32-i16:16:32-i64:64-i128:128-n32:64-S128", "generic", "+neon")) +,("aarch64_be-unknown-linux-gnu", ("E-m:e-i8:8:32-i16:16:32-i64:64-i128:128-n32:64-S128", "generic", "+neon")) +,("aarch64_be-unknown-linux-musl", ("E-m:e-i8:8:32-i16:16:32-i64:64-i128:128-n32:64-S128", "generic", "+neon")) +,("aarch64_be-unknown-linux", ("E-m:e-i8:8:32-i16:16:32-i64:64-i128:128-n32:64-S128", "generic", "+neon")) ,("i386-unknown-linux-gnu", ("e-m:e-p:32:32-p270:32:32-p271:32:32-p272:64:64-f64:32:64-f80:32-n8:16:32-S128", "pentium4", "")) ,("i386-unknown-linux-musl", ("e-m:e-p:32:32-p270:32:32-p271:32:32-p272:64:64-f64:32:64-f80:32-n8:16:32-S128", "pentium4", "")) ,("i386-unknown-linux", ("e-m:e-p:32:32-p270:32:32-p271:32:32-p272:64:64-f64:32:64-f80:32-n8:16:32-S128", "pentium4", "")) 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 = "2209665273135644f1b52470ea2cb53169f2ef91" +cProjectGitCommitId = "4521f6498d09f48a775a028efdd763c874da3451" cProjectVersion :: String -cProjectVersion = "9.5.20221001" +cProjectVersion = "9.5.20221101" cProjectVersionInt :: String cProjectVersionInt = "905" cProjectPatchLevel :: String -cProjectPatchLevel = "20221001" +cProjectPatchLevel = "20221101" cProjectPatchLevel1 :: String -cProjectPatchLevel1 = "20221001" +cProjectPatchLevel1 = "20221101" cProjectPatchLevel2 :: String cProjectPatchLevel2 = "0" diff --git a/ghc-lib/stage0/rts/build/include/ghcautoconf.h b/ghc-lib/stage0/rts/build/include/ghcautoconf.h --- a/ghc-lib/stage0/rts/build/include/ghcautoconf.h +++ b/ghc-lib/stage0/rts/build/include/ghcautoconf.h @@ -85,6 +85,9 @@ significant byte first */ /* #undef FLOAT_WORDS_BIGENDIAN */ +/* Has musttail */ +#define HAS_MUSTTAIL 1 + /* Has visibility hidden */ #define HAS_VISIBILITY_HIDDEN 1 @@ -345,9 +348,6 @@ /* Define to 1 if you have the `times' function. */ #define HAVE_TIMES 1 -/* Define to 1 if you have the header file. */ -#define HAVE_TIME_H 1 - /* Define to 1 if you have the header file. */ #define HAVE_UNISTD_H 1 @@ -490,10 +490,6 @@ /* Define to 1 if info tables are laid out next to code */ #define TABLES_NEXT_TO_CODE 1 - -/* Define to 1 if you can safely include both and . This - macro is obsolete. */ -#define TIME_WITH_SYS_TIME 1 /* Compile-in ASSERTs in all ways. */ /* #undef USE_ASSERTS_ALL_WAYS */ 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 @@ -465,7 +465,7 @@ #define MIN_VERSION_ghc_heap(major1,major2,minor) (\ (major1) < 9 || \ (major1) == 9 && (major2) < 5 || \ - (major1) == 9 && (major2) == 5 && (minor) <= 20221001) + (major1) == 9 && (major2) == 5 && (minor) <= 20221101) #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/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 @@ -2617,24 +2617,36 @@ -- be tuples of other constraints. type Pred = Type +-- | 'SourceUnpackedness' corresponds to unpack annotations found in the source code. +-- +-- This may not agree with the annotations returned by 'reifyConStrictness'. +-- See 'reifyConStrictness' for more information. data SourceUnpackedness = NoSourceUnpackedness -- ^ @C a@ | SourceNoUnpack -- ^ @C { {\-\# NOUNPACK \#-\} } a@ | SourceUnpack -- ^ @C { {\-\# UNPACK \#-\} } a@ deriving (Show, Eq, Ord, Data, Generic) +-- | 'SourceStrictness' corresponds to strictness annotations found in the source code. +-- +-- This may not agree with the annotations returned by 'reifyConStrictness'. +-- See 'reifyConStrictness' for more information. data SourceStrictness = NoSourceStrictness -- ^ @C a@ | SourceLazy -- ^ @C {~}a@ | SourceStrict -- ^ @C {!}a@ deriving (Show, Eq, Ord, Data, Generic) -- | Unlike 'SourceStrictness' and 'SourceUnpackedness', 'DecidedStrictness' --- refers to the strictness that the compiler chooses for a data constructor --- field, which may be different from what is written in source code. See --- 'reifyConStrictness' for more information. -data DecidedStrictness = DecidedLazy - | DecidedStrict - | DecidedUnpack +-- refers to the strictness annotations that the compiler chooses for a data constructor +-- field, which may be different from what is written in source code. +-- +-- Note that non-unpacked strict fields are assigned 'DecidedLazy' when a bang would be inappropriate, +-- such as the field of a newtype constructor and fields that have an unlifted type. +-- +-- See 'reifyConStrictness' for more information. +data DecidedStrictness = DecidedLazy -- ^ Field inferred to not have a bang. + | DecidedStrict -- ^ Field inferred to have a bang. + | DecidedUnpack -- ^ Field inferred to be unpacked. deriving (Show, Eq, Ord, Data, Generic) -- | A single data constructor.