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

18 files changed, 154 insertions, 112 deletions

diff --git a/compiler/GHC/ByteCode/Instr.hs b/compiler/GHC/ByteCode/Instr.hs
index 1950289f79..ebbce3ef50 100644
--- a/compiler/GHC/ByteCode/Instr.hs
+++ b/compiler/GHC/ByteCode/Instr.hs
@@ -223,7 +223,7 @@ pprStgBindShort (StgRec bs) =
   char '{' <+> ppr (fst (head bs)) <+> text "= ...; ... }"
 
 pprStgAltShort :: OutputablePass pass => StgPprOpts -> GenStgAlt pass -> SDoc
-pprStgAltShort opts (con, args, expr) =
+pprStgAltShort opts GenStgAlt{alt_con=con, alt_bndrs=args, alt_rhs=expr} =
   ppr con <+> sep (map ppr args) <+> text "->" <+> pprStgExprShort opts expr
 
 pprStgRhsShort :: OutputablePass pass => StgPprOpts -> GenStgRhs pass -> SDoc
diff --git a/compiler/GHC/CoreToStg.hs b/compiler/GHC/CoreToStg.hs
index 6e0e4600dd..79be8e6e11 100644
--- a/compiler/GHC/CoreToStg.hs
+++ b/compiler/GHC/CoreToStg.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds #-}
 
 {-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE TypeFamilies #-}
@@ -455,7 +456,7 @@ coreToStgExpr (Case scrut bndr _ alts)
        ; alts2 <- extendVarEnvCts [(bndr, LambdaBound)] (mapM vars_alt alts)
        ; return (StgCase scrut2 bndr (mkStgAltType bndr alts) alts2) }
   where
-    vars_alt :: CoreAlt -> CtsM (AltCon, [Var], StgExpr)
+    vars_alt :: CoreAlt -> CtsM StgAlt
     vars_alt (Alt con binders rhs)
       | DataAlt c <- con, c == unboxedUnitDataCon
       = -- This case is a bit smelly.
@@ -463,14 +464,18 @@ coreToStgExpr (Case scrut bndr _ alts)
         -- where a nullary tuple is mapped to (State# World#)
         assert (null binders) $
         do { rhs2 <- coreToStgExpr rhs
-           ; return (DEFAULT, [], rhs2)  }
+           ; return GenStgAlt{alt_con=DEFAULT,alt_bndrs=mempty,alt_rhs=rhs2}
+           }
       | otherwise
       = let     -- Remove type variables
             binders' = filterStgBinders binders
         in
         extendVarEnvCts [(b, LambdaBound) | b <- binders'] $ do
         rhs2 <- coreToStgExpr rhs
-        return (con, binders', rhs2)
+        return $! GenStgAlt{ alt_con   = con
+                           , alt_bndrs = binders'
+                           , alt_rhs   = rhs2
+                           }
 
 coreToStgExpr (Let bind body) = coreToStgLet bind body
 coreToStgExpr e               = pprPanic "coreToStgExpr" (ppr e)
diff --git a/compiler/GHC/Stg/BcPrep.hs b/compiler/GHC/Stg/BcPrep.hs
index 1b5f2b37b6..c1fd67d484 100644
--- a/compiler/GHC/Stg/BcPrep.hs
+++ b/compiler/GHC/Stg/BcPrep.hs
@@ -96,7 +96,7 @@ bcPrepExpr app@StgConApp{} = pure app
 bcPrepExpr app@StgOpApp{} = pure app
 
 bcPrepAlt :: StgAlt -> BcPrepM StgAlt
-bcPrepAlt (ac, bndrs, expr) = (,,) ac bndrs <$> bcPrepExpr expr
+bcPrepAlt (GenStgAlt con bndrs rhs) = GenStgAlt con bndrs <$> bcPrepExpr rhs
 
 bcPrepBind :: StgBinding -> BcPrepM StgBinding
 -- explicitly match all constructors so we get a warning if we miss any
diff --git a/compiler/GHC/Stg/CSE.hs b/compiler/GHC/Stg/CSE.hs
index 8062337192..a4d92ad500 100644
--- a/compiler/GHC/Stg/CSE.hs
+++ b/compiler/GHC/Stg/CSE.hs
@@ -374,7 +374,7 @@ stgCseExpr env (StgLetNoEscape ext binds body)
 -- Case alternatives
 -- Extend the CSE environment
 stgCseAlt :: CseEnv -> AltType -> OutId -> InStgAlt -> OutStgAlt
-stgCseAlt env ty case_bndr (DataAlt dataCon, args, rhs)
+stgCseAlt env ty case_bndr GenStgAlt{alt_con=DataAlt dataCon, alt_bndrs=args, alt_rhs=rhs}
     = let (env1, args') = substBndrs env args
           env2
             -- To avoid dealing with unboxed sums StgCse runs after unarise and
@@ -389,11 +389,11 @@ stgCseAlt env ty case_bndr (DataAlt dataCon, args, rhs)
             = env1
             -- see Note [Case 2: CSEing case binders]
           rhs' = stgCseExpr env2 rhs
-      in (DataAlt dataCon, args', rhs')
-stgCseAlt env _ _ (altCon, args, rhs)
+      in GenStgAlt (DataAlt dataCon) args' rhs'
+stgCseAlt env _ _ g@GenStgAlt{alt_con=_, alt_bndrs=args, alt_rhs=rhs}
     = let (env1, args') = substBndrs env args
           rhs' = stgCseExpr env1 rhs
-      in (altCon, args', rhs')
+      in g {alt_bndrs=args', alt_rhs=rhs'}
 
 -- Bindings
 stgCseBind :: CseEnv -> InStgBinding -> (Maybe OutStgBinding, CseEnv)
@@ -445,8 +445,8 @@ mkStgCase scrut bndr ty alts | all isBndr alts = scrut
 
   where
     -- see Note [All alternatives are the binder]
-    isBndr (_, _, StgApp f []) = f == bndr
-    isBndr _                   = False
+    isBndr GenStgAlt{alt_con=_,alt_bndrs=_,alt_rhs=StgApp f []} = f == bndr
+    isBndr _                                                    = False
 
 
 {- Note [Care with loop breakers]
diff --git a/compiler/GHC/Stg/Debug.hs b/compiler/GHC/Stg/Debug.hs
index 7eb4155068..678f95e50e 100644
--- a/compiler/GHC/Stg/Debug.hs
+++ b/compiler/GHC/Stg/Debug.hs
@@ -124,7 +124,8 @@ collectExpr = go
        return (StgTick tick e')
 
 collectAlt :: StgAlt -> M StgAlt
-collectAlt (ac, bs, e) = (ac, bs, ) <$> collectExpr e
+collectAlt alt = do e' <- collectExpr $ alt_rhs alt
+                    return $! alt { alt_rhs = e' }
 
 -- | Try to find the best source position surrounding a 'StgExpr'. The
 -- heuristic strips ticks from the current expression until it finds one which
diff --git a/compiler/GHC/Stg/FVs.hs b/compiler/GHC/Stg/FVs.hs
index 636ec5eb61..b954933a30 100644
--- a/compiler/GHC/Stg/FVs.hs
+++ b/compiler/GHC/Stg/FVs.hs
@@ -270,7 +270,8 @@ argsFVs env = foldl' f (emptyVarSet, emptyDVarSet)
     f (fvs,ids) (StgVarArg v) = varFVs env v (fvs, ids)
 
 altFVs :: Env -> StgAlt -> (CgStgAlt, TopFVs, LocalFVs)
-altFVs env (con,bndrs,e)
+altFVs env GenStgAlt{alt_con=con, alt_bndrs=bndrs, alt_rhs=e}
   | (e', top_fvs, lcl_fvs) <- exprFVs (addLocals bndrs env) e
   , let lcl_fvs' = delDVarSetList lcl_fvs bndrs
-  = ((con,bndrs, e'), top_fvs, lcl_fvs')
+  , let newAlt   = GenStgAlt{alt_con=con, alt_bndrs=bndrs, alt_rhs=e'}
+  = (newAlt, top_fvs, lcl_fvs')
diff --git a/compiler/GHC/Stg/InferTags.hs b/compiler/GHC/Stg/InferTags.hs
index 477650da3c..2a42b4c7de 100644
--- a/compiler/GHC/Stg/InferTags.hs
+++ b/compiler/GHC/Stg/InferTags.hs
@@ -333,7 +333,7 @@ inferTagExpr env (StgLetNoEscape ext bind body)
 
 inferTagExpr in_env (StgCase scrut bndr ty alts)
   -- Unboxed tuples get their info from the expression we scrutinise if any
-  | [(DataAlt con, bndrs, rhs)] <- alts
+  | [GenStgAlt{alt_con=DataAlt con, alt_bndrs=bndrs, alt_rhs=rhs}] <- alts
   , isUnboxedTupleDataCon con
   , Just infos <- scrut_infos bndrs
   , let bndrs' = zipWithEqual "inferTagExpr" mk_bndr bndrs infos
@@ -350,7 +350,9 @@ inferTagExpr in_env (StgCase scrut bndr ty alts)
     --   text "bndr:" <> ppr bndr $$
     --   text "infos" <> ppr infos $$
     --   text "out_bndrs" <> ppr bndrs') $
-    (info, StgCase scrut' (noSig in_env bndr) ty [(DataAlt con, bndrs', rhs')])
+    (info, StgCase scrut' (noSig in_env bndr) ty [GenStgAlt{ alt_con=DataAlt con
+                                                           , alt_bndrs=bndrs'
+                                                           , alt_rhs=rhs'}])
 
   | null alts -- Empty case, but I might just be paranoid.
   = -- pprTrace "inferCase2" empty $
@@ -362,11 +364,14 @@ inferTagExpr in_env (StgCase scrut bndr ty alts)
         case_env = extendSigEnv in_env [bndr']
 
         (infos, alts')
-          = unzip [ (info, (con, bndrs', rhs'))
-                  | (con, bndrs, rhs) <- alts
+          = unzip [ (info, g {alt_bndrs=bndrs', alt_rhs=rhs'})
+                  | g@GenStgAlt{ alt_con = con
+                               , alt_bndrs = bndrs
+                               , alt_rhs   = rhs
+                               } <- alts
                   , let (alt_env,bndrs') = addAltBndrInfo case_env con bndrs
                         (info, rhs') = inferTagExpr alt_env rhs
-                         ]
+                  ]
         alt_info = foldr combineAltInfo TagTagged infos
     in ( alt_info, StgCase scrut' bndr' ty alts')
   where
diff --git a/compiler/GHC/Stg/InferTags/Rewrite.hs b/compiler/GHC/Stg/InferTags/Rewrite.hs
index 099fbc54d5..87b519006c 100644
--- a/compiler/GHC/Stg/InferTags/Rewrite.hs
+++ b/compiler/GHC/Stg/InferTags/Rewrite.hs
@@ -2,18 +2,19 @@
 -- Copyright (c) 2019 Andreas Klebinger
 --
 
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE TupleSections #-}
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE BangPatterns               #-}
+{-# LANGUAGE CPP                        #-}
+{-# LANGUAGE DataKinds                  #-}
+{-# LANGUAGE FlexibleContexts           #-}
+{-# LANGUAGE FlexibleInstances          #-}
+{-# LANGUAGE GADTs                      #-}
 {-# LANGUAGE GeneralisedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses      #-}
+{-# LANGUAGE NamedFieldPuns             #-}
+{-# LANGUAGE RankNTypes                 #-}
+{-# LANGUAGE ScopedTypeVariables        #-}
+{-# LANGUAGE TupleSections              #-}
+{-# LANGUAGE TypeFamilies               #-}
 
 module GHC.Stg.InferTags.Rewrite (rewriteTopBinds)
 where
@@ -49,7 +50,6 @@ import GHC.Stg.InferTags.Types
 import Control.Monad
 import GHC.Types.Basic (CbvMark (NotMarkedCbv, MarkedCbv), isMarkedCbv, TopLevelFlag(..), isTopLevel)
 import GHC.Types.Var.Set
-
 -- import GHC.Utils.Trace
 -- import GHC.Driver.Ppr
 
@@ -371,10 +371,10 @@ rewriteCase (StgCase scrut bndr alt_type alts) =
 rewriteCase _ = panic "Impossible: nodeCase"
 
 rewriteAlt :: InferStgAlt -> RM TgStgAlt
-rewriteAlt (altCon, bndrs, rhs) = do
+rewriteAlt alt@GenStgAlt{alt_con=_, alt_bndrs=bndrs, alt_rhs=rhs} =
     withBinders NotTopLevel bndrs $ do
         !rhs' <- rewriteExpr False rhs
-        return $! (altCon, map fst bndrs, rhs')
+        return $! alt {alt_bndrs = map fst bndrs, alt_rhs = rhs'}
 
 rewriteLet :: InferStgExpr -> RM TgStgExpr
 rewriteLet (StgLet xt bind expr) = do
@@ -450,9 +450,9 @@ rewriteApp _ _ = panic "Impossible"
 mkSeq :: Id -> Id -> TgStgExpr -> TgStgExpr
 mkSeq id bndr !expr =
     -- pprTrace "mkSeq" (ppr (id,bndr)) $
-    let altTy = mkStgAltTypeFromStgAlts bndr [(DEFAULT, [], panic "Not used")]
-    in
-    StgCase (StgApp id []) bndr altTy [(DEFAULT, [], expr)]
+    let altTy = mkStgAltTypeFromStgAlts bndr alt
+        alt   = [GenStgAlt {alt_con = DEFAULT, alt_bndrs = [], alt_rhs = expr}]
+    in StgCase (StgApp id []) bndr altTy alt
 
 -- `mkSeqs args vs mkExpr` will force all vs, and construct
 -- an argument list args' where each v is replaced by it's evaluated
diff --git a/compiler/GHC/Stg/Lift.hs b/compiler/GHC/Stg/Lift.hs
index 8155cd734e..876b44fe3f 100644
--- a/compiler/GHC/Stg/Lift.hs
+++ b/compiler/GHC/Stg/Lift.hs
@@ -249,5 +249,7 @@ liftExpr (StgLetNoEscape scope bind body)
         Just bind' -> pure (StgLetNoEscape noExtFieldSilent bind' body')
 
 liftAlt :: LlStgAlt -> LiftM OutStgAlt
-liftAlt (con, infos, rhs) = withSubstBndrs (map binderInfoBndr infos) $ \bndrs' ->
-  (,,) con bndrs' <$> liftExpr rhs
+liftAlt alt@GenStgAlt{alt_con=_, alt_bndrs=infos, alt_rhs=rhs} =
+  withSubstBndrs (map binderInfoBndr infos) $ \bndrs' ->
+    do !rhs' <- liftExpr rhs
+       return $! alt {alt_bndrs = bndrs', alt_rhs = rhs'}
diff --git a/compiler/GHC/Stg/Lift/Analysis.hs b/compiler/GHC/Stg/Lift/Analysis.hs
index c2eb9dbb2d..6fc116c8bc 100644
--- a/compiler/GHC/Stg/Lift/Analysis.hs
+++ b/compiler/GHC/Stg/Lift/Analysis.hs
@@ -333,8 +333,8 @@ rhsCard bndr
     n :* cd = idDemandInfo bndr
 
 tagSkeletonAlt :: CgStgAlt -> (Skeleton, IdSet, LlStgAlt)
-tagSkeletonAlt (con, bndrs, rhs)
-  = (alt_skel, arg_occs, (con, map BoringBinder bndrs, rhs'))
+tagSkeletonAlt old@GenStgAlt{alt_con=_, alt_bndrs=bndrs, alt_rhs=rhs}
+  = (alt_skel, arg_occs, old {alt_bndrs=fmap BoringBinder bndrs, alt_rhs=rhs'})
   where
     (alt_skel, alt_arg_occs, rhs') = tagSkeletonExpr rhs
     arg_occs = alt_arg_occs `delVarSetList` bndrs
diff --git a/compiler/GHC/Stg/Lint.hs b/compiler/GHC/Stg/Lint.hs
index 405abdd1f4..0ec0650693 100644
--- a/compiler/GHC/Stg/Lint.hs
+++ b/compiler/GHC/Stg/Lint.hs
@@ -245,15 +245,20 @@ lintStgExpr (StgCase scrut bndr alts_type alts) = do
 
 lintAlt
     :: (OutputablePass a, BinderP a ~ Id)
-    => (AltCon, [Id], GenStgExpr a) -> LintM ()
+    => GenStgAlt a -> LintM ()
 
-lintAlt (DEFAULT, _, rhs) =
-    lintStgExpr rhs
+lintAlt GenStgAlt{ alt_con   = DEFAULT
+                 , alt_bndrs = _
+                 , alt_rhs   = rhs} = lintStgExpr rhs
 
-lintAlt (LitAlt _, _, rhs) =
-    lintStgExpr rhs
+lintAlt GenStgAlt{ alt_con   = LitAlt _
+                 , alt_bndrs = _
+                 , alt_rhs   = rhs} = lintStgExpr rhs
 
-lintAlt (DataAlt _, bndrs, rhs) = do
+lintAlt GenStgAlt{ alt_con   = DataAlt _
+                 , alt_bndrs = bndrs
+                 , alt_rhs   = rhs} =
+  do
     mapM_ checkPostUnariseBndr bndrs
     addInScopeVars bndrs (lintStgExpr rhs)
 
diff --git a/compiler/GHC/Stg/Stats.hs b/compiler/GHC/Stg/Stats.hs
index 7c7df34f27..4f35d1af92 100644
--- a/compiler/GHC/Stg/Stats.hs
+++ b/compiler/GHC/Stg/Stats.hs
@@ -164,5 +164,4 @@ statExpr (StgCase expr _ _ alts)
     stat_alts alts      `combineSE`
     countOne StgCases
   where
-    stat_alts alts
-        = combineSEs (map statExpr [ e | (_,_,e) <- alts ])
+    stat_alts = combineSEs . fmap (statExpr . alt_rhs)
diff --git a/compiler/GHC/Stg/Syntax.hs b/compiler/GHC/Stg/Syntax.hs
index 6726bbe526..779ddf8d56 100644
--- a/compiler/GHC/Stg/Syntax.hs
+++ b/compiler/GHC/Stg/Syntax.hs
@@ -1,10 +1,10 @@
-
 {-# LANGUAGE ConstraintKinds      #-}
 {-# LANGUAGE DataKinds            #-}
 {-# LANGUAGE DeriveDataTypeable   #-}
 {-# LANGUAGE FlexibleContexts     #-}
 {-# LANGUAGE LambdaCase           #-}
 {-# LANGUAGE TypeFamilies         #-}
+{-# LANGUAGE NamedFieldPuns       #-}
 {-# LANGUAGE UndecidableInstances #-}
 
 {-
@@ -23,7 +23,7 @@ module GHC.Stg.Syntax (
         StgArg(..),
 
         GenStgTopBinding(..), GenStgBinding(..), GenStgExpr(..), GenStgRhs(..),
-        GenStgAlt, AltType(..),
+        GenStgAlt(..), AltType(..),
 
         StgPass(..), BinderP, XRhsClosure, XLet, XLetNoEscape,
         NoExtFieldSilent, noExtFieldSilent,
@@ -457,10 +457,11 @@ the TyCon from the constructors or literals (which are guaranteed to have the
 Real McCoy) rather than from the scrutinee type.
 -}
 
-type GenStgAlt pass
-  = (AltCon,          -- alts: data constructor,
-     [BinderP pass],  -- constructor's parameters,
-     GenStgExpr pass) -- ...right-hand side.
+data GenStgAlt pass = GenStgAlt
+  { alt_con          :: !AltCon            -- alts: data constructor,
+  , alt_bndrs        :: ![BinderP pass]    -- constructor's parameters,
+  , alt_rhs          :: !(GenStgExpr pass) -- right-hand side.
+  }
 
 data AltType
   = PolyAlt             -- Polymorphic (a boxed type variable, lifted or unlifted)
@@ -836,11 +837,14 @@ pprStgExpr opts e = case e of
 
 
 pprStgAlt :: OutputablePass pass => StgPprOpts -> Bool -> GenStgAlt pass -> SDoc
-pprStgAlt opts indent (con, params, expr)
-  | indent    = hang altPattern 4 (pprStgExpr opts expr <> semi)
-  | otherwise = sep [altPattern, pprStgExpr opts expr <> semi]
+pprStgAlt opts indent GenStgAlt{alt_con, alt_bndrs, alt_rhs}
+  | indent    = hang altPattern 4 (pprStgExpr opts alt_rhs <> semi)
+  | otherwise = sep [altPattern, pprStgExpr opts alt_rhs <> semi]
     where
-      altPattern = (hsep [ppr con, sep (map (pprBndr CasePatBind) params), text "->"])
+      altPattern = hsep [ ppr alt_con
+                        , sep (map (pprBndr CasePatBind) alt_bndrs)
+                        , text "->"
+                        ]
 
 
 pprStgOp :: StgOp -> SDoc
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)
diff --git a/compiler/GHC/Stg/Utils.hs b/compiler/GHC/Stg/Utils.hs
index 62aa89f0ff..95f70a86ce 100644
--- a/compiler/GHC/Stg/Utils.hs
+++ b/compiler/GHC/Stg/Utils.hs
@@ -42,10 +42,13 @@ mkUnarisedId s t = mkSysLocalM s Many t
 
 -- | Extract the default case alternative
 -- findDefaultStg :: [Alt b] -> ([Alt b], Maybe (Expr b))
-findDefaultStg :: [GenStgAlt p] -> ([(AltCon, [BinderP p], GenStgExpr p)],
-                       Maybe (GenStgExpr p))
-findDefaultStg ((DEFAULT, args, rhs) : alts) = assert( null args ) (alts, Just rhs)
-findDefaultStg alts                        =                     (alts, Nothing)
+findDefaultStg
+  :: [GenStgAlt p]
+  -> ([GenStgAlt p], Maybe (GenStgExpr p))
+findDefaultStg (GenStgAlt{ alt_con    = DEFAULT
+                         , alt_bndrs  = args
+                         , alt_rhs    = rhs} : alts) = assert( null args ) (alts, Just rhs)
+findDefaultStg alts                                  = (alts, Nothing)
 
 mkStgAltTypeFromStgAlts :: forall p. Id -> [GenStgAlt p] -> AltType
 mkStgAltTypeFromStgAlts bndr alts
@@ -80,7 +83,7 @@ mkStgAltTypeFromStgAlts bndr alts
    -- grabbing the one from a constructor alternative
    -- if one exists.
    look_for_better_tycon
-        | (((DataAlt con) ,_, _) : _) <- data_alts =
+        | (DataAlt con : _) <- alt_con <$> data_alts =
                 AlgAlt (dataConTyCon con)
         | otherwise =
                 assert(null data_alts)
diff --git a/compiler/GHC/StgToByteCode.hs b/compiler/GHC/StgToByteCode.hs
index a5931c2dd6..0d6af799de 100644
--- a/compiler/GHC/StgToByteCode.hs
+++ b/compiler/GHC/StgToByteCode.hs
@@ -884,11 +884,11 @@ doCase d s p scrut bndr alts
 
         -- given an alt, return a discr and code for it.
         codeAlt :: CgStgAlt -> BcM (Discr, BCInstrList)
-        codeAlt (DEFAULT, _, rhs)
+        codeAlt GenStgAlt{alt_con=DEFAULT,alt_bndrs=_,alt_rhs=rhs}
            = do rhs_code <- schemeE d_alts s p_alts rhs
                 return (NoDiscr, rhs_code)
 
-        codeAlt alt@(_, bndrs, rhs)
+        codeAlt alt@GenStgAlt{alt_con=_, alt_bndrs=bndrs, alt_rhs=rhs}
            -- primitive or nullary constructor alt: no need to UNPACK
            | null real_bndrs = do
                 rhs_code <- schemeE d_alts s p_alts rhs
@@ -939,24 +939,25 @@ doCase d s p scrut bndr alts
            where
              real_bndrs = filterOut isTyVar bndrs
 
-        my_discr (DEFAULT, _, _) = NoDiscr {-shouldn't really happen-}
-        my_discr (DataAlt dc, _, _)
-           | isUnboxedTupleDataCon dc || isUnboxedSumDataCon dc
-           = NoDiscr
-           | otherwise
-           = DiscrP (fromIntegral (dataConTag dc - fIRST_TAG))
-        my_discr (LitAlt l, _, _)
-           = case l of LitNumber LitNumInt i  -> DiscrI (fromInteger i)
-                       LitNumber LitNumWord w -> DiscrW (fromInteger w)
-                       LitFloat r   -> DiscrF (fromRational r)
-                       LitDouble r  -> DiscrD (fromRational r)
-                       LitChar i    -> DiscrI (ord i)
-                       _ -> pprPanic "schemeE(StgCase).my_discr" (ppr l)
+        my_discr alt = case alt_con alt of
+            DEFAULT    -> NoDiscr {-shouldn't really happen-}
+            DataAlt dc
+              | isUnboxedTupleDataCon dc || isUnboxedSumDataCon dc
+              -> NoDiscr
+              | otherwise
+              -> DiscrP (fromIntegral (dataConTag dc - fIRST_TAG))
+            LitAlt l -> case l of
+              LitNumber LitNumInt i  -> DiscrI (fromInteger i)
+              LitNumber LitNumWord w -> DiscrW (fromInteger w)
+              LitFloat r             -> DiscrF (fromRational r)
+              LitDouble r            -> DiscrD (fromRational r)
+              LitChar i              -> DiscrI (ord i)
+              _ -> pprPanic "schemeE(StgCase).my_discr" (ppr l)
 
         maybe_ncons
            | not isAlgCase = Nothing
            | otherwise
-           = case [dc | (DataAlt dc, _, _) <- alts] of
+           = case [dc | DataAlt dc <- alt_con <$> alts] of
                 []     -> Nothing
                 (dc:_) -> Just (tyConFamilySize (dataConTyCon dc))
 
diff --git a/compiler/GHC/StgToCmm/Bind.hs b/compiler/GHC/StgToCmm/Bind.hs
index 5507173dc7..e8539d80f5 100644
--- a/compiler/GHC/StgToCmm/Bind.hs
+++ b/compiler/GHC/StgToCmm/Bind.hs
@@ -285,7 +285,9 @@ mkRhsClosure    profile _ _check_tags bndr _cc
   , StgCase (StgApp scrutinee [{-no args-}])
          _   -- ignore bndr
          (AlgAlt _)
-         [(DataAlt _, params, sel_expr)] <- strip expr
+         [GenStgAlt{ alt_con   = DataAlt _
+                   , alt_bndrs = params
+                   , alt_rhs   = sel_expr}] <- strip expr
   , StgApp selectee [{-no args-}] <- strip sel_expr
   , the_fv == scrutinee                -- Scrutinee is the only free variable
 
diff --git a/compiler/GHC/StgToCmm/Expr.hs b/compiler/GHC/StgToCmm/Expr.hs
index 55892b8789..7992e34417 100644
--- a/compiler/GHC/StgToCmm/Expr.hs
+++ b/compiler/GHC/StgToCmm/Expr.hs
@@ -459,7 +459,7 @@ job we deleted the hacks.
 
 cgCase (StgApp v []) _ (PrimAlt _) alts
   | isVoidRep (idPrimRep v)  -- See Note [Scrutinising VoidRep]
-  , [(DEFAULT, _, rhs)] <- alts
+  , [GenStgAlt{alt_con=DEFAULT, alt_bndrs=_, alt_rhs=rhs}] <- alts
   = cgExpr rhs
 
 {- Note [Dodgy unsafeCoerce 1]
@@ -652,9 +652,10 @@ chooseReturnBndrs :: Id -> AltType -> [CgStgAlt] -> [NonVoid Id]
 chooseReturnBndrs bndr (PrimAlt _) _alts
   = assertNonVoidIds [bndr]
 
-chooseReturnBndrs _bndr (MultiValAlt n) [(_, ids, _)]
+chooseReturnBndrs _bndr (MultiValAlt n) [alt]
   = assertPpr (ids `lengthIs` n) (ppr n $$ ppr ids $$ ppr _bndr) $
     assertNonVoidIds ids     -- 'bndr' is not assigned!
+    where ids = alt_bndrs alt
 
 chooseReturnBndrs bndr (AlgAlt _) _alts
   = assertNonVoidIds [bndr]  -- Only 'bndr' is assigned
@@ -669,11 +670,11 @@ chooseReturnBndrs _ _ _ = panic "chooseReturnBndrs"
 cgAlts :: (GcPlan,ReturnKind) -> NonVoid Id -> AltType -> [CgStgAlt]
        -> FCode ReturnKind
 -- At this point the result of the case are in the binders
-cgAlts gc_plan _bndr PolyAlt [(_, _, rhs)]
-  = maybeAltHeapCheck gc_plan (cgExpr rhs)
+cgAlts gc_plan _bndr PolyAlt [alt]
+  = maybeAltHeapCheck gc_plan (cgExpr $ alt_rhs alt)
 
-cgAlts gc_plan _bndr (MultiValAlt _) [(_, _, rhs)]
-  = maybeAltHeapCheck gc_plan (cgExpr rhs)
+cgAlts gc_plan _bndr (MultiValAlt _) [alt]
+  = maybeAltHeapCheck gc_plan (cgExpr $ alt_rhs alt)
         -- Here bndrs are *already* in scope, so don't rebind them
 
 cgAlts gc_plan bndr (PrimAlt _) alts
@@ -942,7 +943,7 @@ cgAltRhss gc_plan bndr alts = do
   let
     base_reg = idToReg platform bndr
     cg_alt :: CgStgAlt -> FCode (AltCon, CmmAGraphScoped)
-    cg_alt (con, bndrs, rhs)
+    cg_alt GenStgAlt{alt_con=con, alt_bndrs=bndrs, alt_rhs=rhs}
       = getCodeScoped             $
         maybeAltHeapCheck gc_plan $
         do { _ <- bindConArgs con base_reg (assertNonVoidIds bndrs)