diff options
Diffstat (limited to 'compiler/GHC/CoreToStg.hs')
| -rw-r--r-- | compiler/GHC/CoreToStg.hs | 11 |
1 files changed, 8 insertions, 3 deletions
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) |