Kill off sc_mult and as_mult fields

They are readily derivable from other fields, so this is more
efficient, and less error prone.

Fixes #18494

2 files changed, 42 insertions, 67 deletions

diff --git a/compiler/GHC/Core/Opt/Simplify.hs b/compiler/GHC/Core/Opt/Simplify.hs
index e7fc0fbced..aaf4e346b9 100644
--- a/compiler/GHC/Core/Opt/Simplify.hs
+++ b/compiler/GHC/Core/Opt/Simplify.hs
@@ -1004,7 +1004,7 @@ simplExprF1 env (App fun arg) cont
                                 , sc_hole_ty = hole'
                                 , sc_cont    = cont } }
       _       ->
-          -- crucially, these are /lazy/ bindings. They will
+          -- Crucially, sc_hole_ty is a /lazy/ binding.  It will
           -- be forced only if we need to run contHoleType.
           -- When these are forced, we might get quadratic behavior;
           -- this quadratic blowup could be avoided by drilling down
@@ -1012,17 +1012,10 @@ simplExprF1 env (App fun arg) cont
           -- (instead of one-at-a-time). But in practice, we have not
           -- observed the quadratic behavior, so this extra entanglement
           -- seems not worthwhile.
-          --
-          -- But the (exprType fun) is repeated, to push it into two
-          -- separate, rarely used, thunks; rather than always alloating
-          -- a shared thunk.  Makes a small efficiency difference
-        let fun_ty = exprType fun
-            (m, _, _) = splitFunTy fun_ty
-        in
         simplExprF env fun $
         ApplyToVal { sc_arg = arg, sc_env = env
                    , sc_hole_ty = substTy env (exprType fun)
-                   , sc_dup = NoDup, sc_cont = cont, sc_mult = m }
+                   , sc_dup = NoDup, sc_cont = cont }
 
 simplExprF1 env expr@(Lam {}) cont
   = {-#SCC "simplExprF1-Lam" #-}
@@ -1327,8 +1320,8 @@ rebuild env expr cont
       Select { sc_bndr = bndr, sc_alts = alts, sc_env = se, sc_cont = cont }
         -> rebuildCase (se `setInScopeFromE` env) expr bndr alts cont
 
-      StrictArg { sc_fun = fun, sc_cont = cont, sc_fun_ty = fun_ty, sc_mult = m }
-        -> rebuildCall env (addValArgTo fun (m, expr) fun_ty ) cont
+      StrictArg { sc_fun = fun, sc_cont = cont, sc_fun_ty = fun_ty }
+        -> rebuildCall env (addValArgTo fun expr fun_ty ) cont
       StrictBind { sc_bndr = b, sc_bndrs = bs, sc_body = body
                  , sc_env = se, sc_cont = cont }
         -> do { (floats1, env') <- simplNonRecX (se `setInScopeFromE` env) b expr
@@ -1420,7 +1413,7 @@ simplCast env body co0 cont0
         --         co1 :: t1 ~ s1
         --         co2 :: s2 ~ t2
         addCoerce co cont@(ApplyToVal { sc_arg = arg, sc_env = arg_se
-                                      , sc_dup = dup, sc_cont = tail, sc_mult = m })
+                                      , sc_dup = dup, sc_cont = tail })
           | Just (co1, m_co2) <- pushCoValArg co
           , let new_ty = coercionRKind co1
           , not (isTypeLevPoly new_ty)  -- Without this check, we get a lev-poly arg
@@ -1444,8 +1437,7 @@ simplCast env body co0 cont0
                                     , sc_env  = arg_se'
                                     , sc_dup  = dup'
                                     , sc_cont = tail'
-                                    , sc_hole_ty = coercionLKind co
-                                    , sc_mult = m }) } }
+                                    , sc_hole_ty = coercionLKind co }) } }
 
         addCoerce co cont
           | isReflexiveCo co = return cont  -- Having this at the end makes a huge
@@ -1981,17 +1973,18 @@ rebuildCall env info (ApplyToTy { sc_arg_ty = arg_ty, sc_hole_ty = hole_ty, sc_c
 -- runRW# :: forall (r :: RuntimeRep) (o :: TYPE r). (State# RealWorld -> o) -> o
 -- K[ runRW# rr ty body ]  -->  runRW rr' ty' (\s. K[ body s ])
 rebuildCall env (ArgInfo { ai_fun = fun_id, ai_args = rev_args })
-            (ApplyToVal { sc_arg = arg, sc_env = arg_se, sc_cont = cont, sc_mult = m })
+            (ApplyToVal { sc_arg = arg, sc_env = arg_se
+                        , sc_cont = cont, sc_hole_ty = fun_ty })
   | fun_id `hasKey` runRWKey
   , not (contIsStop cont)  -- Don't fiddle around if the continuation is boring
   , [ TyArg {}, TyArg {} ] <- rev_args
   = do { s <- newId (fsLit "s") Many realWorldStatePrimTy
-       ; let env'  = (arg_se `setInScopeFromE` env) `addNewInScopeIds` [s]
+       ; let (m,_,_) = splitFunTy fun_ty
+             env'  = (arg_se `setInScopeFromE` env) `addNewInScopeIds` [s]
              ty'   = contResultType cont
              cont' = ApplyToVal { sc_dup = Simplified, sc_arg = Var s
                                 , sc_env = env', sc_cont = cont
-                                , sc_hole_ty = mkVisFunTy m realWorldStatePrimTy ty'
-                                , sc_mult = m }
+                                , sc_hole_ty = mkVisFunTy m realWorldStatePrimTy ty' }
                      -- cont' applies to s, then K
        ; body' <- simplExprC env' arg cont'
        ; let arg'  = Lam s body'
@@ -2002,10 +1995,10 @@ rebuildCall env (ArgInfo { ai_fun = fun_id, ai_args = rev_args })
 rebuildCall env fun_info
             (ApplyToVal { sc_arg = arg, sc_env = arg_se
                         , sc_dup = dup_flag, sc_hole_ty = fun_ty
-                        , sc_cont = cont, sc_mult = m })
+                        , sc_cont = cont })
   -- Argument is already simplified
   | isSimplified dup_flag     -- See Note [Avoid redundant simplification]
-  = rebuildCall env (addValArgTo fun_info (m, arg) fun_ty) cont
+  = rebuildCall env (addValArgTo fun_info arg fun_ty) cont
 
   -- Strict arguments
   | isStrictArgInfo fun_info
@@ -2014,7 +2007,7 @@ rebuildCall env fun_info
     simplExprF (arg_se `setInScopeFromE` env) arg
                (StrictArg { sc_fun = fun_info, sc_fun_ty = fun_ty
                           , sc_dup = Simplified
-                          , sc_cont = cont, sc_mult = m })
+                          , sc_cont = cont })
                 -- Note [Shadowing]
 
   -- Lazy arguments
@@ -2025,7 +2018,7 @@ rebuildCall env fun_info
         -- floating a demanded let.
   = do  { arg' <- simplExprC (arg_se `setInScopeFromE` env) arg
                              (mkLazyArgStop arg_ty (lazyArgContext fun_info))
-        ; rebuildCall env (addValArgTo fun_info (m, arg') fun_ty) cont }
+        ; rebuildCall env (addValArgTo fun_info  arg' fun_ty) cont }
   where
     arg_ty = funArgTy fun_ty
 
@@ -2233,24 +2226,10 @@ trySeqRules in_env scrut rhs cont
                         , as_hole_ty = res2_ty }
                 , ValArg { as_arg = no_cast_scrut
                          , as_dmd = seqDmd
-                         , as_hole_ty = res3_ty
-                         , as_mult = Many } ]
-                -- The multiplicity of the scrutiny above is Many because the type
-                -- of seq requires that its first argument is unrestricted. The
-                -- typing rule of case also guarantees it though. In a more
-                -- general world, where the first argument of seq would have
-                -- affine multiplicity, then we could use the multiplicity of
-                -- the case (held in the case binder) instead.
+                         , as_hole_ty = res3_ty } ]
     rule_cont = ApplyToVal { sc_dup = NoDup, sc_arg = rhs
                            , sc_env = in_env, sc_cont = cont
-                           , sc_hole_ty = res4_ty, sc_mult = Many }
-                           -- The multiplicity in sc_mult above is the
-                           -- multiplicity of the second argument of seq. Since
-                           -- seq's type, as it stands, imposes that its second
-                           -- argument be unrestricted, so is
-                           -- sc_mult. However, a more precise typing rule,
-                           -- for seq, would be to have it be linear. In which
-                           -- case, sc_mult should be 1.
+                           , sc_hole_ty = res4_ty }
 
     -- Lazily evaluated, so we don't do most of this
 
@@ -3304,7 +3283,7 @@ mkDupableContWithDmds env _
 
 mkDupableContWithDmds env _
     (StrictArg { sc_fun = fun, sc_cont = cont
-               , sc_fun_ty = fun_ty, sc_mult = m })
+               , sc_fun_ty = fun_ty })
   -- NB: sc_dup /= OkToDup; that is caught earlier by contIsDupable
   | thumbsUpPlanA cont
   = -- Use Plan A of Note [Duplicating StrictArg]
@@ -3318,18 +3297,17 @@ mkDupableContWithDmds env _
                 , StrictArg { sc_fun = fun { ai_args = args' }
                             , sc_cont = cont'
                             , sc_fun_ty = fun_ty
-                            , sc_mult = m
                             , sc_dup = OkToDup} ) }
 
   | otherwise
   = -- Use Plan B of Note [Duplicating StrictArg]
     --   K[ f a b <> ]   -->   join j x = K[ f a b x ]
     --                         j <>
-    do { let arg_ty = funArgTy fun_ty
-             rhs_ty = contResultType cont
-       ; arg_bndr <- newId (fsLit "arg") m arg_ty   -- ToDo: check this linearity argument
+    do { let rhs_ty       = contResultType cont
+             (m,arg_ty,_) = splitFunTy fun_ty
+       ; arg_bndr <- newId (fsLit "arg") m arg_ty
        ; let env' = env `addNewInScopeIds` [arg_bndr]
-       ; (floats, join_rhs) <- rebuildCall env' (addValArgTo fun (m, Var arg_bndr) fun_ty) cont
+       ; (floats, join_rhs) <- rebuildCall env' (addValArgTo fun (Var arg_bndr) fun_ty) cont
        ; mkDupableStrictBind env' arg_bndr (wrapFloats floats join_rhs) rhs_ty }
   where
     thumbsUpPlanA (StrictArg {})               = False
@@ -3349,7 +3327,7 @@ mkDupableContWithDmds env dmds
 
 mkDupableContWithDmds env dmds
     (ApplyToVal { sc_arg = arg, sc_dup = dup, sc_env = se
-                , sc_cont = cont, sc_hole_ty = hole_ty, sc_mult = mult })
+                , sc_cont = cont, sc_hole_ty = hole_ty })
   =     -- e.g.         [...hole...] (...arg...)
         --      ==>
         --              let a = ...arg...
@@ -3369,7 +3347,7 @@ mkDupableContWithDmds env dmds
                                          -- has turned arg'' into a fresh variable
                                          -- See Note [StaticEnv invariant] in GHC.Core.Opt.Simplify.Utils
                               , sc_dup = OkToDup, sc_cont = cont'
-                              , sc_hole_ty = hole_ty, sc_mult = mult }) }
+                              , sc_hole_ty = hole_ty }) }
 
 mkDupableContWithDmds env _
     (Select { sc_bndr = case_bndr, sc_alts = alts, sc_env = se, sc_cont = cont })
@@ -3439,7 +3417,6 @@ mkDupableStrictBind env arg_bndr join_rhs res_ty
                             , sc_fun    = arg_info
                             , sc_fun_ty = idType join_bndr
                             , sc_cont   = mkBoringStop res_ty
-                            , sc_mult   = Many   -- ToDo: check this!
                             } ) }
 
 mkDupableAlt :: Platform -> OutId
diff --git a/compiler/GHC/Core/Opt/Simplify/Utils.hs b/compiler/GHC/Core/Opt/Simplify/Utils.hs
index 0d3a577938..210fd73701 100644
--- a/compiler/GHC/Core/Opt/Simplify/Utils.hs
+++ b/compiler/GHC/Core/Opt/Simplify/Utils.hs
@@ -125,8 +125,7 @@ data SimplCont
                                 -- See Note [The hole type in ApplyToTy/Val]
       , sc_arg  :: InExpr       -- The argument,
       , sc_env  :: StaticEnv    -- see Note [StaticEnv invariant]
-      , sc_cont :: SimplCont
-      , sc_mult :: Mult }
+      , sc_cont :: SimplCont }
 
   | ApplyToTy          -- (ApplyToTy ty K)[e] = K[ e ty ]
       { sc_arg_ty  :: OutType     -- Argument type
@@ -160,8 +159,7 @@ data SimplCont
       , sc_fun_ty :: OutType   -- Type of the function (f e1 .. en),
                                -- presumably (arg_ty -> res_ty)
                                -- where res_ty is expected by sc_cont
-      , sc_cont :: SimplCont
-      , sc_mult :: Mult }
+      , sc_cont :: SimplCont }
 
   | TickIt              -- (TickIt t K)[e] = K[ tick t e ]
         (Tickish Id)    -- Tick tickish <hole>
@@ -282,8 +280,7 @@ data ArgInfo
     }
 
 data ArgSpec
-  = ValArg { as_mult :: Mult
-           , as_dmd  :: Demand        -- Demand placed on this argument
+  = ValArg { as_dmd  :: Demand        -- Demand placed on this argument
            , as_arg  :: OutExpr       -- Apply to this (coercion or value); c.f. ApplyToVal
            , as_hole_ty :: OutType }  -- Type of the function (presumably t1 -> t2)
 
@@ -300,16 +297,15 @@ instance Outputable ArgInfo where
               , text "args =" <+> ppr args ])
 
 instance Outputable ArgSpec where
-  ppr (ValArg { as_mult = mult, as_arg = arg })  = text "ValArg" <+> ppr mult <+> ppr arg
+  ppr (ValArg { as_arg = arg })  = text "ValArg" <+> ppr arg
   ppr (TyArg { as_arg_ty = ty }) = text "TyArg" <+> ppr ty
   ppr (CastBy c)                 = text "CastBy" <+> ppr c
 
-addValArgTo :: ArgInfo -> (Mult, OutExpr) -> OutType -> ArgInfo
-addValArgTo ai (w, arg) hole_ty
+addValArgTo :: ArgInfo ->  OutExpr -> OutType -> ArgInfo
+addValArgTo ai arg hole_ty
   | ArgInfo { ai_dmds = dmd:dmds, ai_discs = _:discs, ai_rules = rules } <- ai
       -- Pop the top demand and and discounts off
-  , let arg_spec = ValArg { as_arg = arg, as_hole_ty = hole_ty
-                          , as_mult = w, as_dmd = dmd }
+  , 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
@@ -345,9 +341,9 @@ 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, as_mult = w }
+      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, sc_mult = w }
+                           , sc_hole_ty = hole_ty, sc_cont = rest }
       CastBy c -> CastIt c rest
   where
     rest = pushSimplifiedArgs env args k
@@ -446,7 +442,7 @@ contHoleType (TickIt _ k)                     = contHoleType k
 contHoleType (CastIt co _)                    = coercionLKind co
 contHoleType (StrictBind { sc_bndr = b, sc_dup = dup, sc_env = se })
   = perhapsSubstTy dup se (idType b)
-contHoleType (StrictArg  { sc_fun_ty = ty, sc_mult = _m })  = funArgTy ty
+contHoleType (StrictArg  { sc_fun_ty = ty })  = funArgTy ty
 contHoleType (ApplyToTy  { sc_hole_ty = ty }) = ty  -- See Note [The hole type in ApplyToTy]
 contHoleType (ApplyToVal { sc_hole_ty = ty }) = ty  -- See Note [The hole type in ApplyToTy/Val]
 contHoleType (Select { sc_dup = d, sc_bndr =  b, sc_env = se })
@@ -464,12 +460,14 @@ contHoleType (Select { sc_dup = d, sc_bndr =  b, sc_env = se })
 contHoleScaling :: SimplCont -> Mult
 contHoleScaling (Stop _ _) = One
 contHoleScaling (CastIt _ k) = contHoleScaling k
-contHoleScaling (StrictBind { sc_bndr = id, sc_cont = k }) =
-  (idMult id) `mkMultMul` contHoleScaling k
-contHoleScaling (StrictArg { sc_mult = w, sc_cont = k }) =
-  w `mkMultMul` contHoleScaling k
-contHoleScaling (Select { sc_bndr = id, sc_cont = k }) =
-  (idMult id) `mkMultMul` contHoleScaling k
+contHoleScaling (StrictBind { sc_bndr = id, sc_cont = k })
+  = idMult id `mkMultMul` contHoleScaling k
+contHoleScaling (Select { sc_bndr = id, sc_cont = k })
+  = idMult id `mkMultMul` contHoleScaling k
+contHoleScaling (StrictArg { sc_fun_ty = fun_ty, sc_cont = k })
+  = w `mkMultMul` contHoleScaling k
+  where
+    (w, _, _) = splitFunTy fun_ty
 contHoleScaling (ApplyToTy { sc_cont = k }) = contHoleScaling k
 contHoleScaling (ApplyToVal { sc_cont = k }) = contHoleScaling k
 contHoleScaling (TickIt _ k) = contHoleScaling k