GenStgAlt 3-tuple synonym --> Record type

This commit alters GenStgAlt from a type synonym to a Record with field
accessors. In pursuit of #21078, this is not a required change but cleans
up several areas for nicer code in the upcoming js-backend, and in GHC
itself.

GenStgAlt: 3-tuple -> record

Stg.Utils: GenStgAlt 3-tuple -> record

Stg.Stats: StgAlt 3-tuple --> record

Stg.InferTags.Rewrite: StgAlt 3-tuple -> record

Stg.FVs: GenStgAlt 3-tuple -> record

Stg.CSE: GenStgAlt 3-tuple -> record

Stg.InferTags: GenStgAlt 3-tuple --> record

Stg.Debug: GenStgAlt 3-tuple --> record

Stg.Lift.Analysis: GenStgAlt 3-tuple --> record

Stg.Lift: GenStgAlt 3-tuple --> record

ByteCode.Instr: GenStgAlt 3-tuple --> record

Stg.Syntax: add GenStgAlt helper functions

Stg.Unarise: GenStgAlt 3-tuple --> record

Stg.BcPrep: GenStgAlt 3-tuple --> record

CoreToStg: GenStgAlt 3-tuple --> record

StgToCmm.Expr: GenStgAlt 3-tuple --> record

StgToCmm.Bind: GenStgAlt 3-tuple --> record

StgToByteCode: GenStgAlt 3-tuple --> record

Stg.Lint: GenStgAlt 3-tuple --> record

Stg.Syntax: strictify GenStgAlt

GenStgAlt: add haddock, some cleanup

fixup: remove calls to pure, single ViewPattern

StgToByteCode: use case over viewpatterns

1 files changed, 38 insertions, 25 deletions

diff --git a/compiler/GHC/Stg/Unarise.hs b/compiler/GHC/Stg/Unarise.hs
index 25b9c5e582..d46719298e 100644
--- a/compiler/GHC/Stg/Unarise.hs
+++ b/compiler/GHC/Stg/Unarise.hs
@@ -447,7 +447,9 @@ elimCase :: UnariseEnv
          -> [OutStgArg] -- non-void args
          -> InId -> AltType -> [InStgAlt] -> UniqSM OutStgExpr
 
-elimCase rho args bndr (MultiValAlt _) [(_, bndrs, rhs)]
+elimCase rho args bndr (MultiValAlt _) [GenStgAlt{ alt_con   = _
+                                                 , alt_bndrs = bndrs
+                                                 , alt_rhs   = rhs}]
   = do let rho1 = extendRho rho bndr (MultiVal args)
            rho2
              | isUnboxedTupleBndr bndr
@@ -479,47 +481,55 @@ elimCase _ args bndr alt_ty alts
 --------------------------------------------------------------------------------
 
 unariseAlts :: UnariseEnv -> AltType -> InId -> [StgAlt] -> UniqSM [StgAlt]
-unariseAlts rho (MultiValAlt n) bndr [(DEFAULT, [], e)]
+unariseAlts rho (MultiValAlt n) bndr [GenStgAlt{ alt_con   = DEFAULT
+                                               , alt_bndrs = []
+                                               , alt_rhs   = e}]
   | isUnboxedTupleBndr bndr
   = do (rho', ys) <- unariseConArgBinder rho bndr
-       e' <- unariseExpr rho' e
-       return [(DataAlt (tupleDataCon Unboxed n), ys, e')]
+       !e' <- unariseExpr rho' e
+       return [GenStgAlt (DataAlt (tupleDataCon Unboxed n)) ys e']
 
-unariseAlts rho (MultiValAlt n) bndr [(DataAlt _, ys, e)]
+unariseAlts rho (MultiValAlt n) bndr [GenStgAlt{ alt_con   = DataAlt _
+                                               , alt_bndrs = ys
+                                               , alt_rhs   = e}]
   | isUnboxedTupleBndr bndr
   = do (rho', ys1) <- unariseConArgBinders rho ys
        massert (ys1 `lengthIs` n)
        let rho'' = extendRho rho' bndr (MultiVal (map StgVarArg ys1))
-       e' <- unariseExpr rho'' e
-       return [(DataAlt (tupleDataCon Unboxed n), ys1, e')]
+       !e' <- unariseExpr rho'' e
+       return [GenStgAlt (DataAlt (tupleDataCon Unboxed n)) ys1 e']
 
 unariseAlts _ (MultiValAlt _) bndr alts
   | isUnboxedTupleBndr bndr
   = pprPanic "unariseExpr: strange multi val alts" (pprPanicAlts alts)
 
 -- In this case we don't need to scrutinize the tag bit
-unariseAlts rho (MultiValAlt _) bndr [(DEFAULT, _, rhs)]
+unariseAlts rho (MultiValAlt _) bndr [GenStgAlt{ alt_con    = DEFAULT
+                                               , alt_bndrs = []
+                                               , alt_rhs   = rhs}]
   | isUnboxedSumBndr bndr
   = do (rho_sum_bndrs, sum_bndrs) <- unariseConArgBinder rho bndr
        rhs' <- unariseExpr rho_sum_bndrs rhs
-       return [(DataAlt (tupleDataCon Unboxed (length sum_bndrs)), sum_bndrs, rhs')]
+       return [GenStgAlt (DataAlt (tupleDataCon Unboxed (length sum_bndrs))) sum_bndrs rhs']
 
 unariseAlts rho (MultiValAlt _) bndr alts
   | isUnboxedSumBndr bndr
   = do (rho_sum_bndrs, scrt_bndrs@(tag_bndr : real_bndrs)) <- unariseConArgBinder rho bndr
        alts' <- unariseSumAlts rho_sum_bndrs (map StgVarArg real_bndrs) alts
        let inner_case = StgCase (StgApp tag_bndr []) tag_bndr tagAltTy alts'
-       return [ (DataAlt (tupleDataCon Unboxed (length scrt_bndrs)),
-                 scrt_bndrs,
-                 inner_case) ]
+       return [GenStgAlt{ alt_con   = DataAlt (tupleDataCon Unboxed (length scrt_bndrs))
+                        , alt_bndrs = scrt_bndrs
+                        , alt_rhs   = inner_case
+                        }]
 
 unariseAlts rho _ _ alts
   = mapM (\alt -> unariseAlt rho alt) alts
 
 unariseAlt :: UnariseEnv -> StgAlt -> UniqSM StgAlt
-unariseAlt rho (con, xs, e)
+unariseAlt rho alt@GenStgAlt{alt_con=_,alt_bndrs=xs,alt_rhs=e}
   = do (rho', xs') <- unariseConArgBinders rho xs
-       (con, xs',) <$> unariseExpr rho' e
+       !e' <- unariseExpr rho' e
+       return $! alt {alt_bndrs = xs', alt_rhs = e'}
 
 --------------------------------------------------------------------------------
 
@@ -537,13 +547,16 @@ unariseSumAlt :: UnariseEnv
               -> [StgArg] -- sum components _excluding_ the tag bit.
               -> StgAlt   -- original alternative with sum LHS
               -> UniqSM StgAlt
-unariseSumAlt rho _ (DEFAULT, _, e)
-  = ( DEFAULT, [], ) <$> unariseExpr rho e
+unariseSumAlt rho _ GenStgAlt{alt_con=DEFAULT,alt_bndrs=_,alt_rhs=e}
+  = GenStgAlt DEFAULT mempty <$> unariseExpr rho e
 
-unariseSumAlt rho args (DataAlt sumCon, bs, e)
-  = do let rho' = mapSumIdBinders bs args rho
-       e' <- unariseExpr rho' e
-       return ( LitAlt (LitNumber LitNumInt (fromIntegral (dataConTag sumCon))), [], e' )
+unariseSumAlt rho args GenStgAlt{ alt_con   = DataAlt sumCon
+                                , alt_bndrs = bs
+                                , alt_rhs   = e
+                                }
+  = do let rho'     = mapSumIdBinders bs args rho
+           lit_case = LitAlt (LitNumber LitNumInt (fromIntegral (dataConTag sumCon)))
+       GenStgAlt lit_case mempty <$> unariseExpr rho' e
 
 unariseSumAlt _ scrt alt
   = pprPanic "unariseSumAlt" (ppr scrt $$ pprPanicAlt alt)
@@ -840,12 +853,12 @@ mkDefaultLitAlt :: [StgAlt] -> [StgAlt]
 -- Since they are exhaustive, we can replace one with DEFAULT, to avoid
 -- generating a final test. Remember, the DEFAULT comes first if it exists.
 mkDefaultLitAlt [] = pprPanic "elimUbxSumExpr.mkDefaultAlt" (text "Empty alts")
-mkDefaultLitAlt alts@((DEFAULT, _, _) : _) = alts
-mkDefaultLitAlt ((LitAlt{}, [], rhs) : alts) = (DEFAULT, [], rhs) : alts
+mkDefaultLitAlt alts@(GenStgAlt{alt_con=DEFAULT,alt_bndrs=_,alt_rhs=_} : _)   = alts
+mkDefaultLitAlt (alt@GenStgAlt{alt_con=LitAlt{}, alt_bndrs=[]} : alts) = alt {alt_con = DEFAULT} : alts
 mkDefaultLitAlt alts = pprPanic "mkDefaultLitAlt" (text "Not a lit alt:" <+> pprPanicAlts alts)
 
-pprPanicAlts :: (Outputable a, Outputable b, OutputablePass pass) => [(a,b,GenStgExpr pass)] -> SDoc
+pprPanicAlts :: OutputablePass pass => [GenStgAlt pass] -> SDoc
 pprPanicAlts alts = ppr (map pprPanicAlt alts)
 
-pprPanicAlt :: (Outputable a, Outputable b, OutputablePass pass) => (a,b,GenStgExpr pass) -> SDoc
-pprPanicAlt (c,b,e) = ppr (c,b,pprStgExpr panicStgPprOpts e)
+pprPanicAlt :: OutputablePass pass => GenStgAlt pass -> SDoc
+pprPanicAlt GenStgAlt{alt_con=c,alt_bndrs=b,alt_rhs=e} = ppr (c,b,pprStgExpr panicStgPprOpts e)