Jaro Reinders pushed to branch wip/reduce-type-in-stg at Glasgow Haskell Compiler / GHC Commits: 74459809 by Jaro Reinders at 2026-04-21T14:20:35+02:00 Remove kind from StgOpApp - - - - - 19 changed files: - compiler/GHC/CoreToStg.hs - compiler/GHC/Stg/CSE.hs - compiler/GHC/Stg/Debug.hs - compiler/GHC/Stg/EnforceEpt.hs - compiler/GHC/Stg/EnforceEpt/Rewrite.hs - compiler/GHC/Stg/FVs.hs - compiler/GHC/Stg/Lift.hs - compiler/GHC/Stg/Lift/Analysis.hs - compiler/GHC/Stg/Lint.hs - compiler/GHC/Stg/Stats.hs - compiler/GHC/Stg/Syntax.hs - compiler/GHC/Stg/Unarise.hs - compiler/GHC/StgToByteCode.hs - compiler/GHC/StgToCmm/Expr.hs - compiler/GHC/StgToCmm/Prim.hs - compiler/GHC/StgToJS/Expr.hs - compiler/GHC/StgToJS/Sinker/Collect.hs - compiler/GHC/StgToJS/Sinker/StringsUnfloat.hs - compiler/GHC/StgToJS/Utils.hs Changes: ===================================== compiler/GHC/CoreToStg.hs ===================================== @@ -552,24 +552,24 @@ mkStgApp f how_bound core_args stg_args res_ty -- stores the type constructor information. See Note [tagToEnum# in STG] -- in GHC.Stg.Syntax. PrimOpId TagToEnumOp _ -> - StgOpApp (StgTagToEnumOp (tcTyConAppTyCon res_ty)) stg_args res_kind + StgOpApp (StgTagToEnumOp (tcTyConAppTyCon res_ty)) stg_args -- Some primitive operator that might be implemented as a library call. -- As noted by Note [Eta expanding primops] in GHC.Builtin.PrimOps -- we require that primop applications be saturated. PrimOpId op _ -> -- assertPpr saturated (ppr f <+> ppr stg_args) $ - StgOpApp (StgPrimOp op) stg_args res_kind + StgOpApp (StgPrimOp op) stg_args -- A call to some primitive Cmm function. FCallId (CCall (CCallSpec (StaticTarget ext lbl ForeignFunction) PrimCallConv _)) | TargetIsInThat unit <- staticTargetUnit ext -> assert exactly_saturated $ - StgOpApp (StgPrimCallOp (PrimCall lbl unit)) stg_args res_kind + StgOpApp (StgPrimCallOp (PrimCall lbl unit) res_kind) stg_args -- A regular foreign call. FCallId call -> assert exactly_saturated $ - StgOpApp (StgFCallOp call (collectStgFArgTypes (idType f))) stg_args res_kind + StgOpApp (StgFCallOp call (collectStgFArgTypes (idType f)) res_kind) stg_args TickBoxOpId {} -> pprPanic "coreToStg TickBox" $ ppr (f,stg_args) ===================================== compiler/GHC/Stg/CSE.hs ===================================== @@ -349,8 +349,8 @@ stgCseExpr env (StgApp fun args) args' = substArgs env args stgCseExpr _ (StgLit lit) = StgLit lit -stgCseExpr env (StgOpApp op args tys) - = StgOpApp op args' tys +stgCseExpr env (StgOpApp op args) + = StgOpApp op args' where args' = substArgs env args stgCseExpr env (StgTick tick body) = let body' = stgCseExpr env body ===================================== compiler/GHC/Stg/Debug.hs ===================================== @@ -103,7 +103,7 @@ collectExpr = go go (StgConApp dc _mn as tys) = do n' <- numberDataCon dc [] return (StgConApp dc n' as tys) - go (StgOpApp op as ty) = return (StgOpApp op as ty) + go (StgOpApp op as) = return (StgOpApp op as) go (StgCase scrut bndr ty alts) = StgCase <$> collectExpr scrut <*> pure bndr <*> pure ty <*> mapM collectAlt alts go (StgLet ext bind body) = do ===================================== compiler/GHC/Stg/EnforceEpt.hs ===================================== @@ -419,11 +419,11 @@ inferTagExpr env (StgTick tick body) where (info, body') = inferTagExpr env body -inferTagExpr _ (StgOpApp op args ty) +inferTagExpr _ (StgOpApp op args) -- Which primops guarantee to return a properly tagged value? -- Probably none, and that is the conservative assumption anyway. -- (And foreign calls definitely need not make promises.) - = (TagDunno, StgOpApp op args ty) + = (TagDunno, StgOpApp op args) inferTagExpr env (StgLet ext bind body) = (info, StgLet ext bind' body') ===================================== compiler/GHC/Stg/EnforceEpt/Rewrite.hs ===================================== @@ -396,7 +396,7 @@ rewriteExpr (StgTick t e) = StgTick t <$!> rewriteExpr e rewriteExpr e@(StgConApp {}) = rewriteConApp e rewriteExpr e@(StgApp {}) = rewriteApp e rewriteExpr (StgLit lit) = return $! (StgLit lit) -rewriteExpr (StgOpApp op args res_ty) = (StgOpApp op) <$!> rewriteArgs args <*> pure res_ty +rewriteExpr (StgOpApp op args) = StgOpApp op <$!> rewriteArgs args rewriteCase :: InferStgExpr -> RM TgStgExpr @@ -496,12 +496,12 @@ So for these we should call `rewriteArgs`. -} rewriteOpApp :: InferStgExpr -> RM TgStgExpr -rewriteOpApp (StgOpApp op args res_ty) = case op of +rewriteOpApp (StgOpApp op args) = case op of op@(StgPrimOp primOp) | primOp == DataToTagSmallOp || primOp == DataToTagLargeOp -- see Note [Rewriting primop arguments] - -> (StgOpApp op) <$!> rewriteArgs args <*> pure res_ty - _ -> pure $! StgOpApp op args res_ty + -> StgOpApp op <$!> rewriteArgs args + _ -> pure $! StgOpApp op args rewriteOpApp _ = panic "Impossible" -- `mkSeq` x x' e generates `case x of x' -> e` ===================================== compiler/GHC/Stg/FVs.hs ===================================== @@ -234,9 +234,9 @@ exprFVs env = go | (imp_fvs, top_fvs, lcl_fvs) <- argsFVs env as = (StgConApp dc n as tys, imp_fvs, top_fvs, lcl_fvs) - go (StgOpApp op as ty) + go (StgOpApp op as) | (imp_fvs, top_fvs, lcl_fvs) <- argsFVs env as - = (StgOpApp op as ty, imp_fvs, top_fvs, lcl_fvs) + = (StgOpApp op as, imp_fvs, top_fvs, lcl_fvs) go (StgCase scrut bndr ty alts) | (scrut',scrut_imp_fvs,scrut_top_fvs,scrut_lcl_fvs) <- exprFVs env scrut ===================================== compiler/GHC/Stg/Lift.hs ===================================== @@ -229,7 +229,7 @@ liftExpr (StgApp f args) = do let top_lvl_args = map StgVarArg fvs' ++ args' pure (StgApp f' top_lvl_args) liftExpr (StgConApp con mn args tys) = StgConApp con mn <$> traverse liftArgs args <*> pure tys -liftExpr (StgOpApp op args ty) = StgOpApp op <$> traverse liftArgs args <*> pure ty +liftExpr (StgOpApp op args) = StgOpApp op <$> traverse liftArgs args liftExpr (StgCase scrut info ty alts) = do scrut' <- liftExpr scrut withSubstBndr (binderInfoBndr info) $ \bndr' -> do ===================================== compiler/GHC/Stg/Lift/Analysis.hs ===================================== @@ -138,8 +138,8 @@ tagSkeletonExpr (StgLit lit) = (NilSk, emptyVarSet, StgLit lit) tagSkeletonExpr (StgConApp con mn args tys) = (NilSk, mkArgOccs args, StgConApp con mn args tys) -tagSkeletonExpr (StgOpApp op args ty) - = (NilSk, mkArgOccs args, StgOpApp op args ty) +tagSkeletonExpr (StgOpApp op args) + = (NilSk, mkArgOccs args, StgOpApp op args) tagSkeletonExpr (StgApp f args) = (NilSk, arg_occs, StgApp f args) where ===================================== compiler/GHC/Stg/Lint.hs ===================================== @@ -295,7 +295,7 @@ lintStgExpr app@(StgConApp con _n args _arg_tys) = do opts <- getStgPprOpts lintConApp con args (pprStgExpr opts app) -lintStgExpr (StgOpApp _ args _) = +lintStgExpr (StgOpApp _ args) = mapM_ lintStgFunArg args lintStgExpr (StgLet _ binds body) = do ===================================== compiler/GHC/Stg/Stats.hs ===================================== @@ -150,7 +150,7 @@ statExpr :: StgExpr -> StatEnv statExpr (StgApp _ _) = countOne Applications statExpr (StgLit _) = countOne Literals statExpr (StgConApp {}) = countOne ConstructorApps -statExpr (StgOpApp _ _ _) = countOne PrimitiveApps +statExpr (StgOpApp _ _) = countOne PrimitiveApps statExpr (StgTick _ e) = statExpr e statExpr (StgLetNoEscape _ binds body) ===================================== compiler/GHC/Stg/Syntax.hs ===================================== @@ -282,9 +282,6 @@ for the details of this transformation. | StgOpApp StgOp -- Primitive op or foreign call [StgArg] -- Saturated. - StgKind -- Result kind - -- We need to know this so that we can - -- assign result registers {- ************************************************************************ @@ -795,9 +792,9 @@ last moment that we still have access to the type information. data StgOp = StgPrimOp PrimOp - | StgPrimCallOp PrimCall + | StgPrimCallOp PrimCall StgKind - | StgFCallOp ForeignCall [StgFArgType] + | StgFCallOp ForeignCall [StgFArgType] StgKind -- The foreign argument types, which are obtained from the foreign -- import declaration itself, areneeded by the stg-to-cmm pass to -- determine the offset to apply to unlifted boxed arguments in @@ -907,7 +904,7 @@ pprStgExpr opts e = case e of -> ppr func <> ppr sig | otherwise -> hang (ppr func) 4 (interppSP args) -- TODO: Print taggedness StgConApp con n args _ -> hsep [ ppr con, ppr n, brackets (interppSP args) ] - StgOpApp op args _ -> hsep [ pprStgOp op, brackets (interppSP args)] + StgOpApp op args -> hsep [ pprStgOp op, brackets (interppSP args)] -- special case: let v = <very specific thing> -- in @@ -994,8 +991,8 @@ pprStgAlt opts indent GenStgAlt{alt_con, alt_bndrs, alt_rhs} pprStgOp :: StgOp -> SDoc pprStgOp (StgPrimOp op) = ppr op -pprStgOp (StgPrimCallOp op)= ppr op -pprStgOp (StgFCallOp op _) = ppr op +pprStgOp (StgPrimCallOp op _)= ppr op +pprStgOp (StgFCallOp op _ _) = ppr op -- TODO: how do we want to pretty print this? pprStgOp (StgTagToEnumOp tyc) = text "TagToEnumOp" <+> ppr tyc ===================================== compiler/GHC/Stg/Unarise.hs ===================================== @@ -574,8 +574,8 @@ unariseExpr rho (StgConApp dc n args ty_args) let args' = unariseConArgs rho args in return $ (StgConApp dc n args' []) -unariseExpr rho (StgOpApp op args ty) - = return (StgOpApp op (unariseFunArgs rho args) ty) +unariseExpr rho (StgOpApp op args) + = return (StgOpApp op (unariseFunArgs rho args)) unariseExpr rho (StgCase scrut bndr alt_ty alts) -- tuple/sum binders in the scrutinee can always be eliminated @@ -902,7 +902,7 @@ stgKindPrimRep1 (MkStgKind k) = case kindPrimRep_maybe k of mkCast :: StgArg -> PrimOp -> OutId -> StgKind -> StgExpr -> StgExpr mkCast arg_in cast_op out_id out_kind in_rhs = - let scrut = StgOpApp (StgPrimOp cast_op) [arg_in] out_kind + let scrut = StgOpApp (StgPrimOp cast_op) [arg_in] alt = GenStgAlt { alt_con = DEFAULT, alt_bndrs = [], alt_rhs = in_rhs} alt_ty = PrimAlt (stgKindPrimRep1 out_kind) in (StgCase scrut out_id alt_ty [alt]) ===================================== compiler/GHC/StgToByteCode.hs ===================================== @@ -659,12 +659,12 @@ schemeT d s p app = implement_tagToId d s p arg constr_names -- Case 1 -schemeT d s p (StgOpApp (StgFCallOp (CCall ccall_spec) _ty) args kind) +schemeT d s p (StgOpApp (StgFCallOp (CCall ccall_spec) _argtys kind) args) = if isSupportedCConv ccall_spec then generateCCall d s p ccall_spec kind args else unsupportedCConvException -schemeT d s p (StgOpApp (StgPrimOp op) args _ty) = do +schemeT d s p (StgOpApp (StgPrimOp op) args) = do profile <- getProfile let platform = profilePlatform profile case doPrimOp platform op d s p args of @@ -673,7 +673,7 @@ schemeT d s p (StgOpApp (StgPrimOp op) args _ty) = do -- Otherwise we have to do a call to the primop wrapper instead :( _ -> doTailCall d s p (primOpId op) (reverse args) -schemeT d s p (StgOpApp (StgPrimCallOp (PrimCall label _)) args _reps) +schemeT d s p (StgOpApp (StgPrimCallOp (PrimCall label _) _) args) = generatePrimCall d s p label args schemeT d s p (StgConApp con _cn args _tys) @@ -2170,7 +2170,7 @@ mkDummyLiteral platform pr maybe_is_tagToEnum_call :: CgStgExpr -> Maybe (StgArg, [Name]) -- Detect and extract relevant info for the tagToEnum kludge. -maybe_is_tagToEnum_call (StgOpApp (StgTagToEnumOp tyc) args _) +maybe_is_tagToEnum_call (StgOpApp (StgTagToEnumOp tyc) args) | [v] <- args = Just (v, extract_constr_Names tyc) | otherwise ===================================== compiler/GHC/StgToCmm/Expr.hs ===================================== @@ -69,7 +69,7 @@ cgExpr (StgApp fun args) = cgIdApp fun args -- dataToTagSmall# :: a_levpoly -> Int# -- See Note [DataToTag overview] in GHC.Tc.Instance.Class, -- particularly wrinkles H3 and DTW4 -cgExpr (StgOpApp (StgPrimOp DataToTagSmallOp) [StgVarArg a] _res_ty) = do +cgExpr (StgOpApp (StgPrimOp DataToTagSmallOp) [StgVarArg a]) = do platform <- getPlatform emitComment (mkFastString "dataToTagSmall#") @@ -84,7 +84,7 @@ cgExpr (StgOpApp (StgPrimOp DataToTagSmallOp) [StgVarArg a] _res_ty) = do -- dataToTagLarge# :: a_levpoly -> Int# -- See Note [DataToTag overview] in GHC.Tc.Instance.Class, -- particularly wrinkles H3 and DTW4 -cgExpr (StgOpApp (StgPrimOp DataToTagLargeOp) [StgVarArg a] _res_ty) = do +cgExpr (StgOpApp (StgPrimOp DataToTagLargeOp) [StgVarArg a]) = do platform <- getPlatform emitComment (mkFastString "dataToTagLarge#") @@ -114,7 +114,7 @@ cgExpr (StgOpApp (StgPrimOp DataToTagLargeOp) [StgVarArg a] _res_ty) = do emitReturn [CmmReg $ CmmLocal result_reg] -cgExpr (StgOpApp op args kind) = cgOpApp op args kind +cgExpr (StgOpApp op args) = cgOpApp op args cgExpr (StgConApp con mn args _) = cgConApp con mn args cgExpr (StgTick t e) = cgTick t >> cgExpr e cgExpr (StgLit lit) = do cmm_expr <- cgLit lit @@ -621,7 +621,7 @@ cgCase scrut bndr alt_type alts ; cgAlts (gc_plan,ret_kind) (NonVoid bndr) alt_type alts } where - is_cmp_op (StgOpApp (StgPrimOp op) _ _) = isComparisonPrimOp op + is_cmp_op (StgOpApp (StgPrimOp op) _) = isComparisonPrimOp op is_cmp_op _ = False @@ -663,7 +663,7 @@ isSimpleScrut :: CgStgExpr -> AltType -> FCode Bool -- heap usage from alternatives into the stuff before the case -- NB: if you get this wrong, and claim that the expression doesn't allocate -- when it does, you'll deeply mess up allocation -isSimpleScrut (StgOpApp op args _) _ = isSimpleOp op args +isSimpleScrut (StgOpApp op args) _ = isSimpleOp op args isSimpleScrut (StgLit _) _ = return True -- case 1# of { 0# -> ..; ... } isSimpleScrut (StgApp _ []) (PrimAlt _) = return True -- case x# of { 0# -> ..; ... } isSimpleScrut (StgApp f []) _ @@ -677,7 +677,7 @@ isSimpleScrut _ _ = return False isSimpleOp :: StgOp -> [StgArg] -> FCode Bool -- True iff the op cannot block or allocate -isSimpleOp (StgFCallOp (CCall (CCallSpec _ _ safe)) _) _ = return $! not (playSafe safe) +isSimpleOp (StgFCallOp (CCall (CCallSpec _ _ safe)) _ _) _ = return $! not (playSafe safe) -- dataToTagSmall#/dataToTagLarge# evaluate an argument; -- see Note [DataToTag overview] in GHC.Tc.Instance.Class isSimpleOp (StgPrimOp DataToTagSmallOp) _ = return False @@ -687,7 +687,7 @@ isSimpleOp (StgPrimOp op) stg_args = do cfg <- getStgToCmmConfig -- See Note [Inlining out-of-line primops and heap checks] return $! shouldInlinePrimOp cfg op arg_exprs -isSimpleOp (StgPrimCallOp _) _ = return False +isSimpleOp (StgPrimCallOp _ _) _ = return False isSimpleOp (StgTagToEnumOp _) _ = return True ----------------- ===================================== compiler/GHC/StgToCmm/Prim.hs ===================================== @@ -68,27 +68,26 @@ might be a Haskell closure pointer, we don't want to evaluate it. -} ---------------------------------- cgOpApp :: StgOp -- The op -> [StgArg] -- Arguments - -> StgKind -- Kind (always unboxed tuple) -> FCode ReturnKind -- Foreign calls -cgOpApp (StgFCallOp fcall ty) stg_args res_kind +cgOpApp (StgFCallOp fcall ty res_kind) stg_args = cgForeignCall fcall ty stg_args res_kind -- See Note [Foreign call results] -cgOpApp (StgPrimOp primop) args kind = do +cgOpApp (StgPrimOp primop) args = do cfg <- getStgToCmmConfig cmm_args <- getNonVoidArgAmodes args - cmmPrimOpApp cfg primop cmm_args (Just kind) + cmmPrimOpApp cfg primop cmm_args -cgOpApp (StgPrimCallOp primcall) args _res_ty +cgOpApp (StgPrimCallOp primcall _) args = do { cmm_args <- getNonVoidArgAmodes args ; let fun = CmmLit (CmmLabel (mkPrimCallLabel primcall)) ; emitCall (NativeNodeCall, NativeReturn) fun cmm_args } -- tagToEnum# is special: we need to pull the constructor -- out of the table, and perform an appropriate return. -cgOpApp (StgTagToEnumOp tyc) args _ = do +cgOpApp (StgTagToEnumOp tyc) args = do amodes <- getNonVoidArgAmodes args case amodes of [amode] -> do @@ -102,14 +101,12 @@ cgOpApp (StgTagToEnumOp tyc) args _ = do emitReturn [tagToClosure platform tyc amode] _ -> pprPanic "cgOpApp: tagToEnum# should be applied to exactly one argument" (ppr args) -cmmPrimOpApp :: StgToCmmConfig -> PrimOp -> [CmmExpr] -> Maybe StgKind -> FCode ReturnKind -cmmPrimOpApp cfg primop cmm_args mres_ty = +cmmPrimOpApp :: StgToCmmConfig -> PrimOp -> [CmmExpr] -> FCode ReturnKind +cmmPrimOpApp cfg primop cmm_args = case emitPrimOp cfg primop cmm_args of PrimopCmmEmit_Internal f -> let - -- if the result kind isn't explicitly given, we directly use the - -- result kind of the primop. - res_ty = fromMaybe (MkStgKind (typeKind (primOpResultType primop))) mres_ty + res_ty = MkStgKind (typeKind (primOpResultType primop)) in emitReturn =<< f res_ty PrimopCmmEmit_External -> do let fun = CmmLit (CmmLabel (mkRtsPrimOpLabel primop)) @@ -2322,7 +2319,7 @@ genericIntMul2Op [res_c, res_h, res_l] both_args@[arg_x, arg_y] p <- newTemp t -- 1) compute the multiplication as if numbers were unsigned _ <- withSequel (AssignTo [p, res_l] False) $ - cmmPrimOpApp cfg WordMul2Op both_args Nothing + cmmPrimOpApp cfg WordMul2Op both_args -- 2) correct the high bits of the unsigned result let carryFill x = CmmMachOp (MO_S_Shr ww) [x, wwm1] sub x y = CmmMachOp (MO_Sub ww) [x, y] @@ -3676,7 +3673,7 @@ emitRangeBoundsCheck idx len arrSizeExpr = do rangeTooLargeReg <- newTemp (bWord platform) lastSafeIndexReg <- newTemp (bWord platform) _ <- withSequel (AssignTo [lastSafeIndexReg, rangeTooLargeReg] False) $ - cmmPrimOpApp config WordSubCOp [arrSize, len] Nothing + cmmPrimOpApp config WordSubCOp [arrSize, len] boundsCheckFailed <- getCode $ emitCCallNeverReturns [] (mkLblExpr mkOutOfBoundsAccessLabel) [] let ===================================== compiler/GHC/StgToJS/Expr.hs ===================================== @@ -107,14 +107,14 @@ genExpr ctx stg = case stg of as <- concatMapM genArg args c <- genCon ctx con as return (c, ExprInline) - StgOpApp (StgFCallOp f _) args k + StgOpApp (StgFCallOp f _ k) args -> genForeignCall ctx f k (concatMap typex_expr $ ctxTarget ctx) args - StgOpApp (StgPrimOp op) args _k + StgOpApp (StgPrimOp op) args -> genPrimOp ctx op args - StgOpApp (StgPrimCallOp c) args k + StgOpApp (StgPrimCallOp c k) args -> genPrimCall ctx c args k - StgOpApp (StgTagToEnumOp tyc) [arg] _k -> genTagToEnumOp ctx tyc arg - StgOpApp op@(StgTagToEnumOp _) args k -> pprPanic "genExpr: StgTagToEnumOp not applied to exactly one argument" (ppr op <+> ppr args <+> ppr (getStgKind k)) + StgOpApp (StgTagToEnumOp tyc) [arg] -> genTagToEnumOp ctx tyc arg + StgOpApp op@(StgTagToEnumOp _) args -> pprPanic "genExpr: StgTagToEnumOp not applied to exactly one argument" (ppr op <+> ppr args) StgCase e b at alts -> genCase ctx b e at alts (liveVars $ stgExprLive False stg) StgLet _ b e -> do ===================================== compiler/GHC/StgToJS/Sinker/Collect.hs ===================================== @@ -42,7 +42,7 @@ collectArgs = \case -> x : concatMap collectArgsA args StgConApp _con _mn args _ts -> concatMap collectArgsA args - StgOpApp _x args _t + StgOpApp _x args -> concatMap collectArgsA args StgCase e _b _a alts -> collectArgsE e ++ concatMap collectArgsAlt alts ===================================== compiler/GHC/StgToJS/Sinker/StringsUnfloat.hs ===================================== @@ -103,7 +103,7 @@ unfloatStringLits' stringLits allBindings = (binderWithoutChanges ++ binderWithU -- No args processStgExpr (StgApp _ []) = Nothing processStgExpr (StgConApp _ _ [] _) = Nothing - processStgExpr (StgOpApp _ [] _) = Nothing + processStgExpr (StgOpApp _ []) = Nothing -- Main targets. Preserving the order of args is important processStgExpr (StgApp fn args@(_:_)) @@ -116,9 +116,9 @@ unfloatStringLits' stringLits allBindings = (binderWithoutChanges ++ binderWithU | otherwise = Just (StgConApp dc n unified tys, names) where (unified, names) = substituteArgWithNames args - processStgExpr (StgOpApp op args@(_:_) tys) + processStgExpr (StgOpApp op args@(_:_)) | isEmptyUniqSet names = Nothing - | otherwise = Just (StgOpApp op unified tys, names) + | otherwise = Just (StgOpApp op unified, names) where (unified, names) = substituteArgWithNames args ===================================== compiler/GHC/StgToJS/Utils.hs ===================================== @@ -312,7 +312,7 @@ exprRefs :: UniqFM Id CgStgExpr -> CgStgExpr -> Set Id exprRefs u = \case StgApp f args -> s f <> l (argRefs u) args StgConApp d _n args _ -> l s [ i | AnId i <- dataConImplicitTyThings d] <> l (argRefs u) args - StgOpApp _ args _ -> l (argRefs u) args + StgOpApp _ args -> l (argRefs u) args StgLit {} -> mempty StgCase expr _ _ alts -> exprRefs u expr <> mconcat (fmap (altRefs u) alts) StgLet _ bnd expr -> bindingRefs u bnd <> exprRefs u expr @@ -400,7 +400,7 @@ stgExprLive includeLHS = \case StgApp occ args -> unionDVarSets (unitDVarSet occ : map stgArgLive args) StgLit {} -> emptyDVarSet StgConApp _dc _n args _tys -> unionDVarSets (map stgArgLive args) - StgOpApp _op args _ty -> unionDVarSets (map stgArgLive args) + StgOpApp _op args -> unionDVarSets (map stgArgLive args) StgCase e b _at alts | includeLHS -> el `unionDVarSet` delDVarSet al b | otherwise -> delDVarSet al b @@ -445,11 +445,13 @@ isInlineExpr = \case -> True StgConApp{} -> True - StgOpApp (StgFCallOp f _) _ _ + StgOpApp (StgFCallOp f _ _) _ -> isInlineForeignCall f - StgOpApp (StgPrimOp op) _ _ + StgOpApp (StgPrimOp op) _ -> primOpIsReallyInline op - StgOpApp (StgPrimCallOp _c) _ _ + StgOpApp (StgPrimCallOp _c _) _ + -> True + StgOpApp (StgTagToEnumOp _) _c -> True StgCase e _ _ alts ->let ie = isInlineExpr e View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/74459809e757ea513bb4efcfe01d5d29... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/74459809e757ea513bb4efcfe01d5d29... You're receiving this email because of your account on gitlab.haskell.org.