summaryrefslogtreecommitdiff
path: root/compiler/GHC/Iface
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/GHC/Iface')
-rw-r--r--compiler/GHC/Iface/Rename.hs4
-rw-r--r--compiler/GHC/Iface/Syntax.hs37
-rw-r--r--compiler/GHC/Iface/Tidy.hs4
-rw-r--r--compiler/GHC/Iface/UpdateIdInfos.hs2
4 files changed, 30 insertions, 17 deletions
diff --git a/compiler/GHC/Iface/Rename.hs b/compiler/GHC/Iface/Rename.hs
index 930d58ddc5..a5bf8b6253 100644
--- a/compiler/GHC/Iface/Rename.hs
+++ b/compiler/GHC/Iface/Rename.hs
@@ -662,8 +662,8 @@ rnIfaceTyConBinder :: Rename IfaceTyConBinder
rnIfaceTyConBinder (Bndr tv vis) = Bndr <$> rnIfaceBndr tv <*> pure vis
rnIfaceAlt :: Rename IfaceAlt
-rnIfaceAlt (conalt, names, rhs)
- = (,,) <$> rnIfaceConAlt conalt <*> pure names <*> rnIfaceExpr rhs
+rnIfaceAlt (IfaceAlt conalt names rhs)
+ = IfaceAlt <$> rnIfaceConAlt conalt <*> pure names <*> rnIfaceExpr rhs
rnIfaceConAlt :: Rename IfaceConAlt
rnIfaceConAlt (IfaceDataAlt data_occ) = IfaceDataAlt <$> rnIfaceGlobal data_occ
diff --git a/compiler/GHC/Iface/Syntax.hs b/compiler/GHC/Iface/Syntax.hs
index b90c049c02..73e8525589 100644
--- a/compiler/GHC/Iface/Syntax.hs
+++ b/compiler/GHC/Iface/Syntax.hs
@@ -11,7 +11,7 @@ module GHC.Iface.Syntax (
IfaceDecl(..), IfaceFamTyConFlav(..), IfaceClassOp(..), IfaceAT(..),
IfaceConDecl(..), IfaceConDecls(..), IfaceEqSpec,
- IfaceExpr(..), IfaceAlt, IfaceLetBndr(..), IfaceJoinInfo(..),
+ IfaceExpr(..), IfaceAlt(..), IfaceLetBndr(..), IfaceJoinInfo(..),
IfaceBinding(..), IfaceConAlt(..),
IfaceIdInfo, IfaceIdDetails(..), IfaceUnfolding(..),
IfaceInfoItem(..), IfaceRule(..), IfaceAnnotation(..), IfaceAnnTarget,
@@ -569,7 +569,7 @@ data IfaceTickish
| IfaceSource RealSrcSpan String -- from SourceNote
-- no breakpoints: we never export these into interface files
-type IfaceAlt = (IfaceConAlt, [IfLclName], IfaceExpr)
+data IfaceAlt = IfaceAlt IfaceConAlt [IfLclName] IfaceExpr
-- Note: IfLclName, not IfaceBndr (and same with the case binder)
-- We reconstruct the kind/type of the thing from the context
-- thus saving bulk in interface files
@@ -1385,7 +1385,7 @@ pprIfaceExpr add_par (IfaceECase scrut ty)
, text "ret_ty" <+> pprParendIfaceType ty
, text "of {}" ])
-pprIfaceExpr add_par (IfaceCase scrut bndr [(con, bs, rhs)])
+pprIfaceExpr add_par (IfaceCase scrut bndr [IfaceAlt con bs rhs])
= add_par (sep [text "case"
<+> pprIfaceExpr noParens scrut <+> text "of"
<+> ppr bndr <+> char '{' <+> ppr_con_bs con bs <+> arrow,
@@ -1395,7 +1395,7 @@ pprIfaceExpr add_par (IfaceCase scrut bndr alts)
= add_par (sep [text "case"
<+> pprIfaceExpr noParens scrut <+> text "of"
<+> ppr bndr <+> char '{',
- nest 2 (sep (map ppr_alt alts)) <+> char '}'])
+ nest 2 (sep (map pprIfaceAlt alts)) <+> char '}'])
pprIfaceExpr _ (IfaceCast expr co)
= sep [pprParendIfaceExpr expr,
@@ -1417,9 +1417,9 @@ pprIfaceExpr add_par (IfaceLet (IfaceRec pairs) body)
pprIfaceExpr add_par (IfaceTick tickish e)
= add_par (pprIfaceTickish tickish <+> pprIfaceExpr noParens e)
-ppr_alt :: (IfaceConAlt, [IfLclName], IfaceExpr) -> SDoc
-ppr_alt (con, bs, rhs) = sep [ppr_con_bs con bs,
- arrow <+> pprIfaceExpr noParens rhs]
+pprIfaceAlt :: IfaceAlt -> SDoc
+pprIfaceAlt (IfaceAlt con bs rhs)
+ = sep [ppr_con_bs con bs, arrow <+> pprIfaceExpr noParens rhs]
ppr_con_bs :: IfaceConAlt -> [IfLclName] -> SDoc
ppr_con_bs con bs = ppr con <+> hsep (map ppr bs)
@@ -1748,14 +1748,14 @@ freeNamesIfExpr (IfaceECase e ty) = freeNamesIfExpr e &&& freeNamesIfType ty
freeNamesIfExpr (IfaceCase s _ alts)
= freeNamesIfExpr s &&& fnList fn_alt alts &&& fn_cons alts
where
- fn_alt (_con,_bs,r) = freeNamesIfExpr r
+ fn_alt (IfaceAlt _con _bs r) = freeNamesIfExpr r
-- Depend on the data constructors. Just one will do!
-- Note [Tracking data constructors]
- fn_cons [] = emptyNameSet
- fn_cons ((IfaceDefault ,_,_) : xs) = fn_cons xs
- fn_cons ((IfaceDataAlt con,_,_) : _ ) = unitNameSet con
- fn_cons (_ : _ ) = emptyNameSet
+ fn_cons [] = emptyNameSet
+ fn_cons (IfaceAlt IfaceDefault _ _ : xs) = fn_cons xs
+ fn_cons (IfaceAlt (IfaceDataAlt con) _ _ : _ ) = unitNameSet con
+ fn_cons (_ : _ ) = emptyNameSet
freeNamesIfExpr (IfaceLet (IfaceNonRec bndr rhs) body)
= freeNamesIfLetBndr bndr &&& freeNamesIfExpr rhs &&& freeNamesIfExpr body
@@ -2283,6 +2283,16 @@ instance Binary IfaceUnfolding where
_ -> do e <- get bh
return (IfCompulsory e)
+instance Binary IfaceAlt where
+ put_ bh (IfaceAlt a b c) = do
+ put_ bh a
+ put_ bh b
+ put_ bh c
+ get bh = do
+ a <- get bh
+ b <- get bh
+ c <- get bh
+ return (IfaceAlt a b c)
instance Binary IfaceExpr where
put_ bh (IfaceLcl aa) = do
@@ -2607,6 +2617,9 @@ instance NFData IfaceExpr where
IfaceFCall fc ty -> fc `seq` rnf ty
IfaceTick tick e -> rnf tick `seq` rnf e
+instance NFData IfaceAlt where
+ rnf (IfaceAlt con bndrs rhs) = rnf con `seq` rnf bndrs `seq` rnf rhs
+
instance NFData IfaceBinding where
rnf = \case
IfaceNonRec bndr e -> rnf bndr `seq` rnf e
diff --git a/compiler/GHC/Iface/Tidy.hs b/compiler/GHC/Iface/Tidy.hs
index 7283f78666..bd9edbe01c 100644
--- a/compiler/GHC/Iface/Tidy.hs
+++ b/compiler/GHC/Iface/Tidy.hs
@@ -836,8 +836,8 @@ dffvExpr (Let (Rec prs) e) = extendScopeList (map fst prs) $
dffvExpr (Case e b _ as) = dffvExpr e >> extendScope b (mapM_ dffvAlt as)
dffvExpr _other = return ()
-dffvAlt :: (t, [Var], CoreExpr) -> DFFV ()
-dffvAlt (_,xs,r) = extendScopeList xs (dffvExpr r)
+dffvAlt :: CoreAlt -> DFFV ()
+dffvAlt (Alt _ xs r) = extendScopeList xs (dffvExpr r)
dffvBind :: (Id, CoreExpr) -> DFFV ()
dffvBind(x,r)
diff --git a/compiler/GHC/Iface/UpdateIdInfos.hs b/compiler/GHC/Iface/UpdateIdInfos.hs
index 9c013cc320..9b8b058745 100644
--- a/compiler/GHC/Iface/UpdateIdInfos.hs
+++ b/compiler/GHC/Iface/UpdateIdInfos.hs
@@ -140,7 +140,7 @@ updateGlobalIds env e = go env e
go env (Case e b ty alts) =
assertNotInNameEnv env [b] (Case (go env e) b ty (map go_alt alts))
where
- go_alt (k,bs,e) = assertNotInNameEnv env bs (k, bs, go env e)
+ go_alt (Alt k bs e) = assertNotInNameEnv env bs (Alt k bs (go env e))
go env (Cast e c) = Cast (go env e) c
go env (Tick t e) = Tick t (go env e)
go _ e@Type{} = e
View Lorry Controller Status