Core: introduce Alt/AnnAlt/IfaceAlt datatypes

Alt, AnnAlt and IfaceAlt were using triples. This patch makes them use
dedicated types so that we can try to make some fields strict (for
example) in the future.

6 files changed, 24 insertions, 25 deletions

diff --git a/compiler/GHC/HsToCore/Arrows.hs b/compiler/GHC/HsToCore/Arrows.hs
index 6ebbcc9fd1..b667466810 100644
--- a/compiler/GHC/HsToCore/Arrows.hs
+++ b/compiler/GHC/HsToCore/Arrows.hs
@@ -204,7 +204,7 @@ coreCaseTuple uniqs scrut_var vars body
 coreCasePair :: Id -> Id -> Id -> CoreExpr -> CoreExpr
 coreCasePair scrut_var var1 var2 body
   = Case (Var scrut_var) scrut_var (exprType body)
-         [(DataAlt (tupleDataCon Boxed 2), [var1, var2], body)]
+         [Alt (DataAlt (tupleDataCon Boxed 2)) [var1, var2] body]
 
 mkCorePairTy :: Type -> Type -> Type
 mkCorePairTy t1 t2 = mkBoxedTupleTy [t1, t2]
diff --git a/compiler/GHC/HsToCore/Binds.hs b/compiler/GHC/HsToCore/Binds.hs
index e828202a61..664ce3edb4 100644
--- a/compiler/GHC/HsToCore/Binds.hs
+++ b/compiler/GHC/HsToCore/Binds.hs
@@ -929,7 +929,7 @@ decomposeRuleLhs dflags orig_bndrs orig_lhs
      where (bs, body') = split_lets body
 
     -- handle "unlifted lets" too, needed for "map/coerce"
-   split_lets (Case r d _ [(DEFAULT, _, body)])
+   split_lets (Case r d _ [Alt DEFAULT _ body])
      | isCoVar d
      = ((d,r):bs, body')
      where (bs, body') = split_lets body
diff --git a/compiler/GHC/HsToCore/Foreign/Call.hs b/compiler/GHC/HsToCore/Foreign/Call.hs
index 1644a6ddf6..5cf906e376 100644
--- a/compiler/GHC/HsToCore/Foreign/Call.hs
+++ b/compiler/GHC/HsToCore/Foreign/Call.hs
@@ -37,7 +37,6 @@ import GHC.HsToCore.Utils
 import GHC.Tc.Utils.TcType
 import GHC.Core.Type
 import GHC.Core.Multiplicity
-import GHC.Types.Id   ( Id )
 import GHC.Core.Coercion
 import GHC.Builtin.Types.Prim
 import GHC.Core.TyCon
@@ -159,7 +158,7 @@ unboxArg arg
               \ body -> Case (mkIfThenElse arg (mkIntLit platform 1) (mkIntLit platform 0))
                              prim_arg
                              (exprType body)
-                             [(DEFAULT,[],body)])
+                             [Alt DEFAULT [] body])
 
   -- Data types with a single constructor, which has a single, primitive-typed arg
   -- This deals with Int, Float etc; also Ptr, ForeignPtr
@@ -169,7 +168,7 @@ unboxArg arg
     do case_bndr <- newSysLocalDs Many arg_ty
        prim_arg <- newSysLocalDs Many data_con_arg_ty1
        return (Var prim_arg,
-               \ body -> Case arg case_bndr (exprType body) [(DataAlt data_con,[prim_arg],body)]
+               \ body -> Case arg case_bndr (exprType body) [Alt (DataAlt data_con) [prim_arg] body]
               )
 
   -- Byte-arrays, both mutable and otherwise; hack warning
@@ -184,7 +183,7 @@ unboxArg arg
   = do case_bndr <- newSysLocalDs Many arg_ty
        vars@[_l_var, _r_var, arr_cts_var] <- newSysLocalsDs (map unrestricted data_con_arg_tys)
        return (Var arr_cts_var,
-               \ body -> Case arg case_bndr (exprType body) [(DataAlt data_con,vars,body)]
+               \ body -> Case arg case_bndr (exprType body) [Alt (DataAlt data_con) vars body]
               )
 
   | otherwise
@@ -275,7 +274,7 @@ boxResult result_ty
 
 mk_alt :: (Expr Var -> [Expr Var] -> Expr Var)
        -> (Maybe Type, Expr Var -> Expr Var)
-       -> DsM (Type, (AltCon, [Id], Expr Var))
+       -> DsM (Type, CoreAlt)
 mk_alt return_result (Nothing, wrap_result)
   = do -- The ccall returns ()
        state_id <- newSysLocalDs Many realWorldStatePrimTy
@@ -284,7 +283,7 @@ mk_alt return_result (Nothing, wrap_result)
                                      [wrap_result (panic "boxResult")]
 
              ccall_res_ty = mkTupleTy Unboxed [realWorldStatePrimTy]
-             the_alt      = (DataAlt (tupleDataCon Unboxed 1), [state_id], the_rhs)
+             the_alt      = Alt (DataAlt (tupleDataCon Unboxed 1)) [state_id] the_rhs
 
        return (ccall_res_ty, the_alt)
 
@@ -297,7 +296,7 @@ mk_alt return_result (Just prim_res_ty, wrap_result)
        ; let the_rhs = return_result (Var state_id)
                                 [wrap_result (Var result_id)]
              ccall_res_ty = mkTupleTy Unboxed [realWorldStatePrimTy, prim_res_ty]
-             the_alt      = (DataAlt (tupleDataCon Unboxed 2), [state_id, result_id], the_rhs)
+             the_alt      = Alt (DataAlt (tupleDataCon Unboxed 2)) [state_id, result_id] the_rhs
        ; return (ccall_res_ty, the_alt) }
 
 
@@ -332,8 +331,8 @@ resultWrapper result_ty
        ; let platform = targetPlatform dflags
        ; let marshal_bool e
                = mkWildCase e (unrestricted intPrimTy) boolTy
-                   [ (DEFAULT                     ,[],Var trueDataConId )
-                   , (LitAlt (mkLitInt platform 0),[],Var falseDataConId)]
+                   [ Alt DEFAULT                        [] (Var trueDataConId )
+                   , Alt (LitAlt (mkLitInt platform 0)) [] (Var falseDataConId)]
        ; return (Just intPrimTy, marshal_bool) }
 
   -- Newtypes
diff --git a/compiler/GHC/HsToCore/ListComp.hs b/compiler/GHC/HsToCore/ListComp.hs
index 1c7cee081e..ea10cdaf39 100644
--- a/compiler/GHC/HsToCore/ListComp.hs
+++ b/compiler/GHC/HsToCore/ListComp.hs
@@ -295,8 +295,8 @@ deBindComp pat core_list1 quals core_list2 = do
     let
         rhs = Lam u1 $
               Case (Var u1) u1 res_ty
-                   [(DataAlt nilDataCon,  [],       core_list2),
-                    (DataAlt consDataCon, [u2, u3], core_match)]
+                   [Alt (DataAlt nilDataCon)  []       core_list2
+                   ,Alt (DataAlt consDataCon) [u2, u3] core_match]
                         -- Increasing order of tag
 
     return (Let (Rec [(h, rhs)]) letrec_body)
@@ -423,8 +423,8 @@ mkZipBind elt_tys = do
 
     mk_case (as, a', as') rest
           = Case (Var as) as elt_tuple_list_ty
-                  [(DataAlt nilDataCon,  [],        mkNilExpr elt_tuple_ty),
-                   (DataAlt consDataCon, [a', as'], rest)]
+                  [ Alt (DataAlt nilDataCon)  []        (mkNilExpr elt_tuple_ty)
+                  , Alt (DataAlt consDataCon) [a', as'] rest]
                         -- Increasing order of tag
 
 
diff --git a/compiler/GHC/HsToCore/Match.hs b/compiler/GHC/HsToCore/Match.hs
index 8007f36f02..86095b8e3f 100644
--- a/compiler/GHC/HsToCore/Match.hs
+++ b/compiler/GHC/HsToCore/Match.hs
@@ -259,7 +259,7 @@ matchEmpty var res_ty
   = return [MR_Fallible mk_seq]
   where
     mk_seq fail = return $ mkWildCase (Var var) (idScaledType var) res_ty
-                                      [(DEFAULT, [], fail)]
+                                      [Alt DEFAULT [] fail]
 
 matchVariables :: NonEmpty MatchId -> Type -> NonEmpty EquationInfo -> DsM (MatchResult CoreExpr)
 -- Real true variables, just like in matchVar, SLPJ p 94
diff --git a/compiler/GHC/HsToCore/Utils.hs b/compiler/GHC/HsToCore/Utils.hs
index 493324cf97..8623a628f3 100644
--- a/compiler/GHC/HsToCore/Utils.hs
+++ b/compiler/GHC/HsToCore/Utils.hs
@@ -261,7 +261,7 @@ mkViewMatchResult var' viewExpr = fmap $ mkCoreLet $ NonRec var' viewExpr
 
 mkEvalMatchResult :: Id -> Type -> MatchResult CoreExpr -> MatchResult CoreExpr
 mkEvalMatchResult var ty = fmap $ \e ->
-  Case (Var var) var ty [(DEFAULT, [], e)]
+  Case (Var var) var ty [Alt DEFAULT [] e]
 
 mkGuardedMatchResult :: CoreExpr -> MatchResult CoreExpr -> MatchResult CoreExpr
 mkGuardedMatchResult pred_expr mr = MR_Fallible $ \fail -> do
@@ -277,13 +277,13 @@ mkCoPrimCaseMatchResult var ty match_alts
   where
     mk_case fail = do
         alts <- mapM (mk_alt fail) sorted_alts
-        return (Case (Var var) var ty ((DEFAULT, [], fail) : alts))
+        return (Case (Var var) var ty (Alt DEFAULT [] fail : alts))
 
     sorted_alts = sortWith fst match_alts       -- Right order for a Case
     mk_alt fail (lit, mr)
        = ASSERT( not (litIsLifted lit) )
          do body <- runMatchResult fail mr
-            return (LitAlt lit, [], body)
+            return (Alt (LitAlt lit) [] body)
 
 data CaseAlt a = MkCaseAlt{ alt_pat :: a,
                             alt_bndrs :: [Var],
@@ -367,7 +367,7 @@ mkDataConCase var ty alts@(alt1 :| _)
                      , alt_result = match_result } =
       flip adjustMatchResultDs match_result $ \body -> do
         case dataConBoxer con of
-          Nothing -> return (DataAlt con, args, body)
+          Nothing -> return (Alt (DataAlt con) args body)
           Just (DCB boxer) -> do
             us <- newUniqueSupply
             let (rep_ids, binds) = initUs_ us (boxer ty_args args)
@@ -375,12 +375,12 @@ mkDataConCase var ty alts@(alt1 :| _)
               -- Upholds the invariant that the binders of a case expression
               -- must be scaled by the case multiplicity. See Note [Case
               -- expression invariants] in CoreSyn.
-            return (DataAlt con, rep_ids', mkLets binds body)
+            return (Alt (DataAlt con) rep_ids' (mkLets binds body))
 
     mk_default :: MatchResult (Maybe CoreAlt)
     mk_default
       | exhaustive_case = MR_Infallible $ return Nothing
-      | otherwise       = MR_Fallible $ \fail -> return $ Just (DEFAULT, [], fail)
+      | otherwise       = MR_Fallible $ \fail -> return $ Just (Alt DEFAULT [] fail)
 
     mentioned_constructors = mkUniqSet $ map alt_pat sorted_alts
     un_mentioned_constructors
@@ -487,7 +487,7 @@ There are a few subtleties in the desugaring of `seq`:
 mkCoreAppDs  :: SDoc -> CoreExpr -> CoreExpr -> CoreExpr
 mkCoreAppDs _ (Var f `App` Type _r `App` Type ty1 `App` Type ty2 `App` arg1) arg2
   | f `hasKey` seqIdKey            -- Note [Desugaring seq], points (1) and (2)
-  = Case arg1 case_bndr ty2 [(DEFAULT,[],arg2)]
+  = Case arg1 case_bndr ty2 [Alt DEFAULT [] arg2]
   where
     case_bndr = case arg1 of
                    Var v1 | isInternalName (idName v1)
@@ -952,8 +952,8 @@ mkBinaryTickBox ixT ixF e = do
            trueBox  = Tick (HpcTick this_mod ixT) (Var trueDataConId)
        --
        return $ Case e bndr1 boolTy
-                       [ (DataAlt falseDataCon, [], falseBox)
-                       , (DataAlt trueDataCon,  [], trueBox)
+                       [ Alt (DataAlt falseDataCon) [] falseBox
+                       , Alt (DataAlt trueDataCon)  [] trueBox
                        ]