diff --git a/compiler/GHC/CmmToAsm/AArch64/Instr.hs b/compiler/GHC/CmmToAsm/AArch64/Instr.hs --- a/compiler/GHC/CmmToAsm/AArch64/Instr.hs +++ b/compiler/GHC/CmmToAsm/AArch64/Instr.hs @@ -74,6 +74,7 @@ regUsageOfInstr platform instr = case instr of ANN _ i -> regUsageOfInstr platform i COMMENT{} -> usage ([], []) + MULTILINE_COMMENT{} -> usage ([], []) PUSH_STACK_FRAME -> usage ([], []) POP_STACK_FRAME -> usage ([], []) DELTA{} -> usage ([], []) @@ -208,11 +209,12 @@ patchRegsOfInstr :: Instr -> (Reg -> Reg) -> Instr patchRegsOfInstr instr env = case instr of -- 0. Meta Instructions - ANN d i -> ANN d (patchRegsOfInstr i env) - COMMENT{} -> instr - PUSH_STACK_FRAME -> instr - POP_STACK_FRAME -> instr - DELTA{} -> instr + ANN d i -> ANN d (patchRegsOfInstr i env) + COMMENT{} -> instr + MULTILINE_COMMENT{} -> instr + PUSH_STACK_FRAME -> instr + POP_STACK_FRAME -> instr + DELTA{} -> instr -- 1. Arithmetic Instructions ---------------------------------------------- ADD o1 o2 o3 -> ADD (patchOp o1) (patchOp o2) (patchOp o3) CMN o1 o2 -> CMN (patchOp o1) (patchOp o2) diff --git a/compiler/GHC/Core/Opt/Specialise.hs b/compiler/GHC/Core/Opt/Specialise.hs --- a/compiler/GHC/Core/Opt/Specialise.hs +++ b/compiler/GHC/Core/Opt/Specialise.hs @@ -29,6 +29,7 @@ import qualified GHC.Core.Subst as Core import GHC.Core.Unfold.Make import GHC.Core +import GHC.Core.Make ( mkLitRubbish ) import GHC.Core.Rules import GHC.Core.Utils ( exprIsTrivial, getIdFromTrivialExpr_maybe , mkCast, exprType ) @@ -2295,16 +2296,28 @@ let (env', bndr') = substBndr env (zapIdOccInfo bndr) ; (useful, env'', leftover_bndrs, rule_bs, rule_es, bs', dx, spec_args) <- specHeader env' bndrs args + + ; let bndr_ty = idType bndr' + + -- See Note [Drop dead args from specialisations] + -- C.f. GHC.Core.Opt.WorkWrap.Utils.mk_absent_let + (mb_spec_bndr, spec_arg) + | isDeadBinder bndr + , Just lit_expr <- mkLitRubbish bndr_ty + = (Nothing, lit_expr) + | otherwise + = (Just bndr', varToCoreExpr bndr') + ; pure ( useful , env'' , leftover_bndrs , bndr' : rule_bs , varToCoreExpr bndr' : rule_es - , if isDeadBinder bndr - then bs' -- see Note [Drop dead args from specialisations] - else bndr' : bs' + , case mb_spec_bndr of + Nothing -> bs' -- see Note [Drop dead args from specialisations] + Just b' -> b' : bs' , dx - , varToCoreExpr bndr' : spec_args + , spec_arg : spec_args ) } diff --git a/compiler/GHC/Core/Opt/WorkWrap/Utils.hs b/compiler/GHC/Core/Opt/WorkWrap/Utils.hs --- a/compiler/GHC/Core/Opt/WorkWrap/Utils.hs +++ b/compiler/GHC/Core/Opt/WorkWrap/Utils.hs @@ -30,13 +30,12 @@ , mkCoreApp, mkCoreLet ) import GHC.Types.Id.Make ( voidArgId, voidPrimId ) import GHC.Builtin.Types ( tupleDataCon ) -import GHC.Types.Literal ( mkLitRubbish ) +import GHC.Core.Make ( mkLitRubbish ) import GHC.Types.Var.Env ( mkInScopeSet ) import GHC.Types.Var.Set ( VarSet ) import GHC.Core.Type import GHC.Core.Multiplicity import GHC.Core.Predicate ( isClassPred ) -import GHC.Types.RepType ( isVoidTy, typeMonoPrimRep_maybe ) import GHC.Core.Coercion import GHC.Core.FamInstEnv import GHC.Types.Basic ( Boxity(..) ) @@ -54,6 +53,8 @@ import GHC.Data.FastString import GHC.Data.List.SetOps +import GHC.Types.RepType + {- ************************************************************************ * * @@ -423,7 +424,10 @@ mkWWargs subst fun_ty demands | null demands - = return ([], id, id, substTy subst fun_ty) + = return ([], id, id, substTyUnchecked subst fun_ty) + -- I got an ASSERT failure here with `substTy`, and I was + -- disinclined to pursue it since this code is about to be + -- deleted by Sebastian | (dmd:demands') <- demands , Just (mult, arg_ty, fun_ty') <- splitFunTy_maybe fun_ty @@ -934,7 +938,6 @@ ; return (True, worker_args, unbox_fn . wrap_fn, work_fn . rebox_fn) } -- Don't pass the arg, rebox instead ----------------------- nop_fn :: CoreExpr -> CoreExpr nop_fn body = body @@ -1305,7 +1308,7 @@ Simplifier (when they are in fact *unreachable code*). Yet, we have to come up with "filler" values that we bind the absent arg Ids to. -That is exactly what Note [Rubbish values] are for: A convenient way to +That is exactly what Note [Rubbish literals] are for: A convenient way to conjure filler values at any type (and any representation or levity!). Needless to say, there are some wrinkles: @@ -1313,7 +1316,7 @@ 1. In case we have a absent, /lazy/, and /lifted/ arg, we use an error-thunk instead. If absence analysis was wrong (e.g., #11126) and the binding in fact is used, then we get a nice panic message instead of undefined - runtime behavior (See Modes of failure from Note [Rubbish values]). + runtime behavior (See Modes of failure from Note [Rubbish literals]). Obviously, we can't use an error-thunk if the value is of unlifted rep (like 'Int#' or 'MutVar#'), because we'd immediately evaluate the panic. @@ -1377,23 +1380,22 @@ mk_absent_let dflags arg dmd -- The lifted case: Bind 'absentError' for a nice panic message if we are -- wrong (like we were in #11126). See (1) in Note [Absent fillers] - | Just [LiftedRep] <- mb_mono_prim_reps + | not (isUnliftedType arg_ty) , not (isStrictDmd dmd) -- See (2) in Note [Absent fillers] = Just (Let (NonRec arg panic_rhs)) - -- The default case for mono rep: Bind @RUBBISH[prim_reps] \@arg_ty@ + -- The default case for mono rep: Bind `RUBBISH[rr] \@arg_ty` -- See Note [Absent fillers], the main part - | Just prim_reps <- mb_mono_prim_reps - = Just (bindNonRec arg (mkTyApps (Lit (mkLitRubbish prim_reps)) [arg_ty])) + | Just lit_expr <- mkLitRubbish arg_ty + = Just (bindNonRec arg lit_expr) -- Catch all: Either @arg_ty@ wasn't of form @TYPE rep@ or @rep@ wasn't mono rep. -- See (3) in Note [Absent fillers] - | Nothing <- mb_mono_prim_reps + | otherwise = WARN( True, text "No absent value for" <+> ppr arg_ty ) Nothing where arg_ty = idType arg - mb_mono_prim_reps = typeMonoPrimRep_maybe arg_ty panic_rhs = mkAbsentErrorApp arg_ty msg diff --git a/compiler/GHC/CoreToStg.hs b/compiler/GHC/CoreToStg.hs --- a/compiler/GHC/CoreToStg.hs +++ b/compiler/GHC/CoreToStg.hs @@ -396,9 +396,11 @@ coreToStgExpr expr@(App _ _) = case app_head of - Var f -> coreToStgApp f args ticks -- Regular application - Lit l@LitRubbish{} -> return (StgLit l) -- LitRubbish - _ -> pprPanic "coreToStgExpr - Invalid app head:" (ppr expr) + Var f -> coreToStgApp f args ticks -- Regular application + Lit l | isLitRubbish l -- If there is LitRubbish at the head, + -> return (StgLit l) -- discard the arguments + + _ -> pprPanic "coreToStgExpr - Invalid app head:" (ppr expr) where (app_head, args, ticks) = myCollectArgs expr coreToStgExpr expr@(Lam _ _) diff --git a/compiler/GHC/Iface/Rename.hs b/compiler/GHC/Iface/Rename.hs --- a/compiler/GHC/Iface/Rename.hs +++ b/compiler/GHC/Iface/Rename.hs @@ -644,8 +644,9 @@ <*> rnIfaceExpr body rnIfaceExpr (IfaceCast expr co) = IfaceCast <$> rnIfaceExpr expr <*> rnIfaceCo co -rnIfaceExpr (IfaceLit lit) = pure (IfaceLit lit) -rnIfaceExpr (IfaceFCall cc ty) = IfaceFCall cc <$> rnIfaceType ty +rnIfaceExpr (IfaceLit lit) = pure (IfaceLit lit) +rnIfaceExpr (IfaceLitRubbish rep) = IfaceLitRubbish <$> rnIfaceType rep +rnIfaceExpr (IfaceFCall cc ty) = IfaceFCall cc <$> rnIfaceType ty rnIfaceExpr (IfaceTick tickish expr) = IfaceTick tickish <$> rnIfaceExpr expr rnIfaceBndrs :: Rename [IfaceBndr] diff --git a/compiler/GHC/IfaceToCore.hs b/compiler/GHC/IfaceToCore.hs --- a/compiler/GHC/IfaceToCore.hs +++ b/compiler/GHC/IfaceToCore.hs @@ -1447,6 +1447,10 @@ tcIfaceExpr (IfaceExt gbl) = Var <$> tcIfaceExtId gbl +tcIfaceExpr (IfaceLitRubbish rep) + = do rep' <- tcIfaceType rep + return (Lit (LitRubbish rep')) + tcIfaceExpr (IfaceLit lit) = do lit' <- tcIfaceLit lit return (Lit lit') diff --git a/compiler/GHC/Stg/Unarise.hs b/compiler/GHC/Stg/Unarise.hs --- a/compiler/GHC/Stg/Unarise.hs +++ b/compiler/GHC/Stg/Unarise.hs @@ -219,7 +219,7 @@ This means that it's safe to wrap `StgArg`s of DataCon applications with `GHC.StgToCmm.Env.NonVoid`, for example. - * Similar to unboxed tuples, Note [Rubbish values] of TupleRep may only + * Similar to unboxed tuples, Note [Rubbish literals] of TupleRep may only appear in return position. * Alt binders (binders in patterns) are always non-void. @@ -248,7 +248,7 @@ import GHC.Types.RepType import GHC.Stg.Syntax import GHC.Core.Type -import GHC.Builtin.Types.Prim (intPrimTy) +import GHC.Builtin.Types.Prim (intPrimTy, primRepToRuntimeRep) import GHC.Builtin.Types import GHC.Types.Unique.Supply import GHC.Utils.Misc @@ -389,7 +389,7 @@ , Just args' <- unariseMulti_maybe rho dc args ty_args = elimCase rho args' bndr alt_ty alts - -- See (3) of Note [Rubbish values] in GHC.Types.Literal + -- See (3) of Note [Rubbish literals] in GHC.Types.Literal | StgLit lit <- scrut , Just args' <- unariseRubbish_maybe lit = elimCase rho args' bndr alt_ty alts @@ -426,19 +426,18 @@ -- Doesn't return void args. unariseRubbish_maybe :: Literal -> Maybe [OutStgArg] -unariseRubbish_maybe lit - | LitRubbish preps <- lit - , [prep] <- preps +unariseRubbish_maybe (LitRubbish rep) + | [prep] <- preps , not (isVoidRep prep) - -- Single, non-void PrimRep. Nothing to do! - = Nothing + = Nothing -- Single, non-void PrimRep. Nothing to do! - | LitRubbish preps <- lit - -- Multiple reps, possibly with VoidRep. Eliminate! - = Just [ StgLitArg (LitRubbish [prep]) | prep <- preps, not (isVoidRep prep) ] + | otherwise -- Multiple reps, possibly with VoidRep. Eliminate via elimCase + = Just [ StgLitArg (LitRubbish (primRepToType prep)) + | prep <- preps, not (isVoidRep prep) ] + where + preps = runtimeRepPrimRep (text "unariseRubbish_maybe") rep - | otherwise - = Nothing +unariseRubbish_maybe _ = Nothing -------------------------------------------------------------------------------- @@ -658,7 +657,8 @@ ubxSumRubbishArg Word64Slot = StgLitArg (LitNumber LitNumWord64 0) ubxSumRubbishArg FloatSlot = StgLitArg (LitFloat 0) ubxSumRubbishArg DoubleSlot = StgLitArg (LitDouble 0) -ubxSumRubbishArg (VecSlot n e) = StgLitArg (LitRubbish [VecRep n e]) +ubxSumRubbishArg (VecSlot n e) = StgLitArg (LitRubbish vec_rep) + where vec_rep = primRepToRuntimeRep (VecRep n e) -------------------------------------------------------------------------------- diff --git a/compiler/GHC/StgToCmm/Lit.hs b/compiler/GHC/StgToCmm/Lit.hs --- a/compiler/GHC/StgToCmm/Lit.hs +++ b/compiler/GHC/StgToCmm/Lit.hs @@ -25,6 +25,7 @@ import GHC.Cmm.Utils import GHC.Types.Literal +import GHC.Types.RepType( runtimeRepPrimRep ) import GHC.Builtin.Types ( unitDataConId ) import GHC.Core.TyCon import GHC.Utils.Misc @@ -51,8 +52,8 @@ cgLit (LitString s) = CmmLit <$> newByteStringCLit s -- not unpackFS; we want the UTF-8 byte stream. -cgLit (LitRubbish preps) = - case expectOnly "cgLit:Rubbish" preps of -- Note [Post-unarisation invariants] +cgLit (LitRubbish rep) = + case expectOnly "cgLit" prim_reps of -- Note [Post-unarisation invariants] VoidRep -> panic "cgLit:VoidRep" -- dito LiftedRep -> idInfoToAmode <$> getCgIdInfo unitDataConId UnliftedRep -> idInfoToAmode <$> getCgIdInfo unitDataConId @@ -62,7 +63,9 @@ let elem_lit = mkSimpleLit platform (num_rep_lit (primElemRepToPrimRep elem)) pure (CmmLit (CmmVec (replicate n elem_lit))) prep -> cgLit (num_rep_lit prep) - where + where + prim_reps = runtimeRepPrimRep (text "cgLit") rep + num_rep_lit IntRep = mkLitIntUnchecked 0 num_rep_lit Int8Rep = mkLitInt8Unchecked 0 num_rep_lit Int16Rep = mkLitInt16Unchecked 0 @@ -76,6 +79,7 @@ num_rep_lit FloatRep = LitFloat 0 num_rep_lit DoubleRep = LitDouble 0 num_rep_lit other = pprPanic "num_rep_lit: Not a num lit" (ppr other) + cgLit other_lit = do platform <- getPlatform pure (CmmLit (mkSimpleLit platform other_lit)) diff --git a/ghc-lib.cabal b/ghc-lib.cabal --- a/ghc-lib.cabal +++ b/ghc-lib.cabal @@ -1,7 +1,7 @@ cabal-version: 2.0 build-type: Simple name: ghc-lib -version: 9.2.6.20230211 +version: 9.2.7.20230228 license: BSD3 license-file: LICENSE category: Development @@ -46,9 +46,9 @@ type: git location: git@github.com:digital-asset/ghc-lib.git flag threaded-rts - default: True - manual: True - description: Pass -DTHREADED_RTS to the C toolchain + default: True + manual: True + description: Pass -DTHREADED_RTS to the C toolchain library default-language: Haskell2010 exposed: False @@ -86,7 +86,7 @@ process >= 1 && < 1.7, rts, hpc == 0.6.*, - ghc-lib-parser == 9.2.6.20230211 + ghc-lib-parser == 9.2.7.20230228 build-tool-depends: alex:alex >= 3.1, happy:happy >= 1.19.4 other-extensions: BangPatterns