summaryrefslogtreecommitdiff
path: root/compiler/iface
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/iface')
-rw-r--r--compiler/iface/BinIface.hs27
-rw-r--r--compiler/iface/BuildTyCl.lhs2
-rw-r--r--compiler/iface/IfaceEnv.lhs2
-rw-r--r--compiler/iface/IfaceSyn.lhs74
-rw-r--r--compiler/iface/IfaceType.lhs2
-rw-r--r--compiler/iface/MkIface.lhs45
-rw-r--r--compiler/iface/TcIface.lhs44
-rw-r--r--compiler/iface/TcIface.lhs-boot4
8 files changed, 126 insertions, 74 deletions
diff --git a/compiler/iface/BinIface.hs b/compiler/iface/BinIface.hs
index 9390ee4377..ba1a7e28e2 100644
--- a/compiler/iface/BinIface.hs
+++ b/compiler/iface/BinIface.hs
@@ -1307,27 +1307,30 @@ instance Binary IfaceDecl where
return (IfaceAxiom occ a2 a3)
instance Binary IfaceAxBranch where
- put_ bh (IfaceAxBranch a1 a2 a3) = do
+ put_ bh (IfaceAxBranch a1 a2 a3 a4) = do
put_ bh a1
put_ bh a2
put_ bh a3
+ put_ bh a4
get bh = do
a1 <- get bh
a2 <- get bh
a3 <- get bh
- return (IfaceAxBranch a1 a2 a3)
+ a4 <- get bh
+ return (IfaceAxBranch a1 a2 a3 a4)
-instance Binary ty => Binary (SynTyConRhs ty) where
- put_ bh (SynFamilyTyCon a b) = putByte bh 0 >> put_ bh a >> put_ bh b
- put_ bh (SynonymTyCon ty) = putByte bh 1 >> put_ bh ty
+instance Binary IfaceSynTyConRhs where
+ put_ bh IfaceOpenSynFamilyTyCon = putByte bh 0
+ put_ bh (IfaceClosedSynFamilyTyCon ax) = putByte bh 1 >> put_ bh ax
+ put_ bh (IfaceSynonymTyCon ty) = putByte bh 2 >> put_ bh ty
get bh = do { h <- getByte bh
; case h of
- 0 -> do { a <- get bh
- ; b <- get bh
- ; return (SynFamilyTyCon a b) }
+ 0 -> do { return IfaceOpenSynFamilyTyCon }
+ 1 -> do { ax <- get bh
+ ; return (IfaceClosedSynFamilyTyCon ax) }
_ -> do { ty <- get bh
- ; return (SynonymTyCon ty) } }
+ ; return (IfaceSynonymTyCon ty) } }
instance Binary IfaceClsInst where
put_ bh (IfaceClsInst cls tys dfun flag orph) = do
@@ -1345,19 +1348,17 @@ instance Binary IfaceClsInst where
return (IfaceClsInst cls tys dfun flag orph)
instance Binary IfaceFamInst where
- put_ bh (IfaceFamInst fam group tys name orph) = do
+ put_ bh (IfaceFamInst fam tys name orph) = do
put_ bh fam
- put_ bh group
put_ bh tys
put_ bh name
put_ bh orph
get bh = do
fam <- get bh
- group <- get bh
tys <- get bh
name <- get bh
orph <- get bh
- return (IfaceFamInst fam group tys name orph)
+ return (IfaceFamInst fam tys name orph)
instance Binary OverlapFlag where
put_ bh (NoOverlap b) = putByte bh 0 >> put_ bh b
diff --git a/compiler/iface/BuildTyCl.lhs b/compiler/iface/BuildTyCl.lhs
index d5e4a4a62e..a541e32b7b 100644
--- a/compiler/iface/BuildTyCl.lhs
+++ b/compiler/iface/BuildTyCl.lhs
@@ -47,7 +47,7 @@ import Outputable
\begin{code}
------------------------------------------------------
buildSynTyCon :: Name -> [TyVar]
- -> SynTyConRhs Type
+ -> SynTyConRhs
-> Kind -- ^ Kind of the RHS
-> TyConParent
-> TcRnIf m n TyCon
diff --git a/compiler/iface/IfaceEnv.lhs b/compiler/iface/IfaceEnv.lhs
index 81f1b33e96..0441fdbf41 100644
--- a/compiler/iface/IfaceEnv.lhs
+++ b/compiler/iface/IfaceEnv.lhs
@@ -57,7 +57,7 @@ import Data.IORef ( atomicModifyIORef, readIORef )
Note [The Name Cache]
~~~~~~~~~~~~~~~~~~~~~
-The Name Cache makes sure that, during any invocation of GHC, each
+The Name Cache makes sure that, during any invovcation of GHC, each
External Name "M.x" has one, and only one globally-agreed Unique.
* The first time we come across M.x we make up a Unique and record that
diff --git a/compiler/iface/IfaceSyn.lhs b/compiler/iface/IfaceSyn.lhs
index 7632b38d81..ad327d6428 100644
--- a/compiler/iface/IfaceSyn.lhs
+++ b/compiler/iface/IfaceSyn.lhs
@@ -14,7 +14,7 @@
module IfaceSyn (
module IfaceType,
- IfaceDecl(..), IfaceClassOp(..), IfaceAT(..),
+ IfaceDecl(..), IfaceSynTyConRhs(..), IfaceClassOp(..), IfaceAT(..),
IfaceConDecl(..), IfaceConDecls(..),
IfaceExpr(..), IfaceAlt, IfaceLetBndr(..),
IfaceBinding(..), IfaceConAlt(..),
@@ -36,13 +36,13 @@ module IfaceSyn (
#include "HsVersions.h"
-import TyCon( SynTyConRhs(..) )
import IfaceType
import PprCore() -- Printing DFunArgs
import Demand
import Annotations
import Class
import NameSet
+import CoAxiom ( BranchIndex )
import Name
import CostCentre
import Literal
@@ -91,7 +91,7 @@ data IfaceDecl
| IfaceSyn { ifName :: OccName, -- Type constructor
ifTyVars :: [IfaceTvBndr], -- Type variables
ifSynKind :: IfaceKind, -- Kind of the *rhs* (not of the tycon)
- ifSynRhs :: SynTyConRhs IfaceType }
+ ifSynRhs :: IfaceSynTyConRhs }
| IfaceClass { ifCtxt :: IfaceContext, -- Context...
ifName :: OccName, -- Name of the class TyCon
@@ -112,6 +112,11 @@ data IfaceDecl
-- beyond .NET
ifExtName :: Maybe FastString }
+data IfaceSynTyConRhs
+ = IfaceOpenSynFamilyTyCon
+ | IfaceClosedSynFamilyTyCon IfExtName -- name of associated axiom
+ | IfaceSynonymTyCon IfaceType
+
data IfaceClassOp = IfaceClassOp OccName DefMethSpec IfaceType
-- Nothing => no default method
-- Just False => ordinary polymorphic default method
@@ -122,13 +127,35 @@ data IfaceAT = IfaceAT IfaceDecl [IfaceAxBranch]
-- Just ds => default associated type instance from these templates
instance Outputable IfaceAxBranch where
- ppr (IfaceAxBranch { ifaxbTyVars = tvs, ifaxbLHS = pat_tys, ifaxbRHS = ty })
- = ppr tvs <+> hsep (map ppr pat_tys) <+> char '=' <+> ppr ty
+ ppr = pprAxBranch Nothing
+
+pprAxBranch :: Maybe IfaceTyCon -> IfaceAxBranch -> SDoc
+pprAxBranch mtycon (IfaceAxBranch { ifaxbTyVars = tvs
+ , ifaxbLHS = pat_tys
+ , ifaxbRHS = ty
+ , ifaxbIncomps = incomps })
+ = ppr tvs <+> ppr_lhs <+> char '=' <+> ppr ty $+$
+ nest 4 maybe_incomps
+ where
+ ppr_lhs
+ | Just tycon <- mtycon
+ = ppr (IfaceTyConApp tycon pat_tys)
+ | otherwise
+ = hsep (map ppr pat_tys)
+
+ maybe_incomps
+ | [] <- incomps
+ = empty
+
+ | otherwise
+ = parens (ptext (sLit "incompatible indices:") <+> ppr incomps)
-- this is just like CoAxBranch
-data IfaceAxBranch = IfaceAxBranch { ifaxbTyVars :: [IfaceTvBndr]
- , ifaxbLHS :: [IfaceType]
- , ifaxbRHS :: IfaceType }
+data IfaceAxBranch = IfaceAxBranch { ifaxbTyVars :: [IfaceTvBndr]
+ , ifaxbLHS :: [IfaceType]
+ , ifaxbRHS :: IfaceType
+ , ifaxbIncomps :: [BranchIndex] }
+ -- See Note [Storing compatibility] in CoAxiom
data IfaceConDecls
= IfAbstractTyCon Bool -- c.f TyCon.AbstractTyCon
@@ -173,12 +200,10 @@ data IfaceClsInst
-- and if the head does not change it won't be used if it wasn't before
-- The ifFamInstTys field of IfaceFamInst contains a list of the rough
--- match types, one per branch... but each "rough match types" is itself
--- a list of Maybe IfaceTyCon. So, we get [[Maybe IfaceTyCon]].
+-- match types
data IfaceFamInst
= IfaceFamInst { ifFamInstFam :: IfExtName -- Family name
- , ifFamInstBranched :: Bool -- Is this branched?
- , ifFamInstTys :: [[Maybe IfaceTyCon]] -- See above
+ , ifFamInstTys :: [Maybe IfaceTyCon] -- See above
, ifFamInstAxiom :: IfExtName -- The axiom
, ifFamInstOrph :: Maybe OccName -- Just like IfaceClsInst
}
@@ -497,15 +522,20 @@ pprIfaceDecl (IfaceForeign {ifName = tycon})
pprIfaceDecl (IfaceSyn {ifName = tycon,
ifTyVars = tyvars,
- ifSynRhs = SynonymTyCon mono_ty})
+ ifSynRhs = IfaceSynonymTyCon mono_ty})
= hang (ptext (sLit "type") <+> pprIfaceDeclHead [] tycon tyvars)
4 (vcat [equals <+> ppr mono_ty])
pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars,
- ifSynRhs = SynFamilyTyCon {}, ifSynKind = kind })
+ ifSynRhs = IfaceOpenSynFamilyTyCon, ifSynKind = kind })
= hang (ptext (sLit "type family") <+> pprIfaceDeclHead [] tycon tyvars)
4 (dcolon <+> ppr kind)
+pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars,
+ ifSynRhs = IfaceClosedSynFamilyTyCon {}, ifSynKind = kind })
+ = hang (ptext (sLit "closed type family") <+> pprIfaceDeclHead [] tycon tyvars)
+ 4 (dcolon <+> ppr kind)
+
pprIfaceDecl (IfaceData {ifName = tycon, ifCType = cType,
ifCtxt = context,
ifTyVars = tyvars, ifCons = condecls,
@@ -535,10 +565,7 @@ pprIfaceDecl (IfaceClass {ifCtxt = context, ifName = clas, ifTyVars = tyvars,
pprIfaceDecl (IfaceAxiom {ifName = name, ifTyCon = tycon, ifAxBranches = branches })
= hang (ptext (sLit "axiom") <+> ppr name <> colon)
- 2 (vcat $ map ppr_branch branches)
- where
- ppr_branch (IfaceAxBranch { ifaxbTyVars = tyvars, ifaxbLHS = lhs, ifaxbRHS = rhs })
- = pprIfaceTvBndrs tyvars <> dot <+> ppr (IfaceTyConApp tycon lhs) <+> text "~#" <+> ppr rhs
+ 2 (vcat $ map (pprAxBranch $ Just tycon) branches)
pprCType :: Maybe CType -> SDoc
pprCType Nothing = ptext (sLit "No C type associated")
@@ -623,10 +650,10 @@ instance Outputable IfaceClsInst where
2 (equals <+> ppr dfun_id)
instance Outputable IfaceFamInst where
- ppr (IfaceFamInst {ifFamInstFam = fam, ifFamInstTys = mb_tcss,
+ ppr (IfaceFamInst {ifFamInstFam = fam, ifFamInstTys = mb_tcs,
ifFamInstAxiom = tycon_ax})
= hang (ptext (sLit "family instance") <+>
- ppr fam <+> pprWithCommas (brackets . pprWithCommas ppr_rough) mb_tcss)
+ ppr fam <+> pprWithCommas (brackets . ppr_rough) mb_tcs)
2 (equals <+> ppr tycon_ax)
ppr_rough :: Maybe IfaceTyCon -> SDoc
@@ -820,9 +847,10 @@ freeNamesIfIdDetails (IfRecSelId tc _) = freeNamesIfTc tc
freeNamesIfIdDetails _ = emptyNameSet
-- All other changes are handled via the version info on the tycon
-freeNamesIfSynRhs :: SynTyConRhs IfaceType -> NameSet
-freeNamesIfSynRhs (SynonymTyCon ty) = freeNamesIfType ty
-freeNamesIfSynRhs _ = emptyNameSet
+freeNamesIfSynRhs :: IfaceSynTyConRhs -> NameSet
+freeNamesIfSynRhs (IfaceSynonymTyCon ty) = freeNamesIfType ty
+freeNamesIfSynRhs IfaceOpenSynFamilyTyCon = emptyNameSet
+freeNamesIfSynRhs (IfaceClosedSynFamilyTyCon ax) = unitNameSet ax
freeNamesIfContext :: IfaceContext -> NameSet
freeNamesIfContext = fnList freeNamesIfType
diff --git a/compiler/iface/IfaceType.lhs b/compiler/iface/IfaceType.lhs
index 103d336dbb..480eb7e0ba 100644
--- a/compiler/iface/IfaceType.lhs
+++ b/compiler/iface/IfaceType.lhs
@@ -90,7 +90,7 @@ newtype IfaceTyCon = IfaceTc { ifaceTyConName :: IfExtName }
-- Coercion constructors
data IfaceCoCon
- = IfaceCoAx IfExtName Int -- Int is 0-indexed branch number
+ = IfaceCoAx IfExtName BranchIndex -- BranchIndex is 0-indexed branch number
| IfaceReflCo | IfaceUnsafeCo | IfaceSymCo
| IfaceTransCo | IfaceInstCo
| IfaceNthCo Int | IfaceLRCo LeftOrRight
diff --git a/compiler/iface/MkIface.lhs b/compiler/iface/MkIface.lhs
index 13b64cdb25..d9bd6fc941 100644
--- a/compiler/iface/MkIface.lhs
+++ b/compiler/iface/MkIface.lhs
@@ -311,7 +311,6 @@ mkIface_ hsc_env maybe_old_fingerprint
mi_warn_fn = mkIfaceWarnCache warns,
mi_fix_fn = mkIfaceFixCache fixities }
}
-
; (new_iface, no_change_at_all)
<- {-# SCC "versioninfo" #-}
addFingerprints hsc_env maybe_old_fingerprint
@@ -1445,16 +1444,33 @@ coAxiomToIfaceDecl :: CoAxiom br -> IfaceDecl
coAxiomToIfaceDecl ax@(CoAxiom { co_ax_tc = tycon, co_ax_branches = branches })
= IfaceAxiom { ifName = name
, ifTyCon = toIfaceTyCon tycon
- , ifAxBranches = brListMap (coAxBranchToIfaceBranch emptyTidyEnv) branches }
+ , ifAxBranches = brListMap (coAxBranchToIfaceBranch
+ emptyTidyEnv
+ (brListMap coAxBranchLHS branches)) branches }
where
name = getOccName ax
-
-coAxBranchToIfaceBranch :: TidyEnv -> CoAxBranch -> IfaceAxBranch
-coAxBranchToIfaceBranch env0 (CoAxBranch { cab_tvs = tvs, cab_lhs = lhs, cab_rhs = rhs })
+-- 2nd parameter is the list of branch LHSs, for conversion from incompatible branches
+-- to incompatible indices
+-- See [Storing compatibility] in CoAxiom
+coAxBranchToIfaceBranch :: TidyEnv -> [[Type]] -> CoAxBranch -> IfaceAxBranch
+coAxBranchToIfaceBranch env0 lhs_s
+ branch@(CoAxBranch { cab_incomps = incomps })
+ = (coAxBranchToIfaceBranch' env0 branch) { ifaxbIncomps = iface_incomps }
+ where
+ iface_incomps = map (expectJust "iface_incomps"
+ . (flip findIndex lhs_s
+ . eqTypes)
+ . coAxBranchLHS) incomps
+
+-- use this one for standalone branches without incompatibles
+coAxBranchToIfaceBranch' :: TidyEnv -> CoAxBranch -> IfaceAxBranch
+coAxBranchToIfaceBranch' env0
+ (CoAxBranch { cab_tvs = tvs, cab_lhs = lhs, cab_rhs = rhs })
= IfaceAxBranch { ifaxbTyVars = toIfaceTvBndrs tv_bndrs
, ifaxbLHS = map (tidyToIfaceType env1) lhs
- , ifaxbRHS = tidyToIfaceType env1 rhs }
+ , ifaxbRHS = tidyToIfaceType env1 rhs
+ , ifaxbIncomps = [] }
where
(env1, tv_bndrs) = tidyTyVarBndrs env0 tvs
@@ -1491,8 +1507,9 @@ tyConToIfaceDecl env tycon
where
(env1, tyvars) = tidyTyClTyVarBndrs env (tyConTyVars tycon)
- to_ifsyn_rhs (SynFamilyTyCon a b) = SynFamilyTyCon a b
- to_ifsyn_rhs (SynonymTyCon ty) = SynonymTyCon (tidyToIfaceType env1 ty)
+ to_ifsyn_rhs OpenSynFamilyTyCon = IfaceOpenSynFamilyTyCon
+ to_ifsyn_rhs (ClosedSynFamilyTyCon ax) = IfaceClosedSynFamilyTyCon (coAxiomName ax)
+ to_ifsyn_rhs (SynonymTyCon ty) = IfaceSynonymTyCon (tidyToIfaceType env1 ty)
ifaceConDecls (NewTyCon { data_con = con }) = IfNewTyCon (ifaceConDecl con)
ifaceConDecls (DataTyCon { data_cons = cons }) = IfDataTyCon (map ifaceConDecl cons)
@@ -1550,7 +1567,7 @@ classToIfaceDecl env clas
toIfaceAT :: ClassATItem -> IfaceAT
toIfaceAT (tc, defs)
- = IfaceAT (tyConToIfaceDecl env1 tc) (map (coAxBranchToIfaceBranch env1) defs)
+ = IfaceAT (tyConToIfaceDecl env1 tc) (map (coAxBranchToIfaceBranch' env1) defs)
toIfaceClassOp (sel_id, def_meth)
= ASSERT(sel_tyvars == clas_tyvars)
@@ -1638,19 +1655,15 @@ instanceToIfaceInst (ClsInst { is_dfun = dfun_id, is_flag = oflag
(n : _) -> Just (nameOccName n)
--------------------------
-famInstToIfaceFamInst :: FamInst br -> IfaceFamInst
+famInstToIfaceFamInst :: FamInst -> IfaceFamInst
famInstToIfaceFamInst (FamInst { fi_axiom = axiom,
- fi_branched = branched,
fi_fam = fam,
- fi_branches = branches })
+ fi_tcs = roughs })
= IfaceFamInst { ifFamInstAxiom = coAxiomName axiom
, ifFamInstFam = fam
- , ifFamInstBranched = branched
- , ifFamInstTys = map (map do_rough) roughs
+ , ifFamInstTys = map do_rough roughs
, ifFamInstOrph = orph }
where
- roughs = brListMap famInstBranchRoughMatch branches
-
do_rough Nothing = Nothing
do_rough (Just n) = Just (toIfaceTyCon_name n)
diff --git a/compiler/iface/TcIface.lhs b/compiler/iface/TcIface.lhs
index 4c7435a554..af9d8f609c 100644
--- a/compiler/iface/TcIface.lhs
+++ b/compiler/iface/TcIface.lhs
@@ -490,9 +490,12 @@ tc_iface_decl parent _ (IfaceSyn {ifName = occ_name, ifTyVars = tv_bndrs,
; return (ATyCon tycon) }
where
mk_doc n = ptext (sLit "Type syonym") <+> ppr n
- tc_syn_rhs (SynFamilyTyCon a b) = return (SynFamilyTyCon a b)
- tc_syn_rhs (SynonymTyCon ty) = do { rhs_ty <- tcIfaceType ty
- ; return (SynonymTyCon rhs_ty) }
+ tc_syn_rhs IfaceOpenSynFamilyTyCon = return OpenSynFamilyTyCon
+ tc_syn_rhs (IfaceClosedSynFamilyTyCon ax_name)
+ = do { ax <- tcIfaceCoAxiom ax_name
+ ; return (ClosedSynFamilyTyCon ax) }
+ tc_syn_rhs (IfaceSynonymTyCon ty) = do { rhs_ty <- tcIfaceType ty
+ ; return (SynonymTyCon rhs_ty) }
tc_iface_decl _parent ignore_prags
(IfaceClass {ifCtxt = rdr_ctxt, ifName = tc_occ,
@@ -535,7 +538,7 @@ tc_iface_decl _parent ignore_prags
tc_at cls (IfaceAT tc_decl defs_decls)
= do ATyCon tc <- tc_iface_decl (AssocFamilyTyCon cls) ignore_prags tc_decl
- defs <- mapM tc_ax_branch defs_decls
+ defs <- foldlM tc_ax_branches [] defs_decls
return (tc, defs)
mk_op_doc op_name op_ty = ptext (sLit "Class op") <+> sep [ppr op_name, ppr op_ty]
@@ -552,23 +555,28 @@ tc_iface_decl _ _ (IfaceForeign {ifName = rdr_name, ifExtName = ext_name})
tc_iface_decl _ _ (IfaceAxiom {ifName = ax_occ, ifTyCon = tc, ifAxBranches = branches})
= do { tc_name <- lookupIfaceTop ax_occ
; tc_tycon <- tcIfaceTyCon tc
- ; tc_branches <- mapM tc_ax_branch branches
- ; let axiom = CoAxiom { co_ax_unique = nameUnique tc_name
+ ; tc_branches <- foldlM tc_ax_branches [] branches
+ ; let axiom = computeAxiomIncomps $
+ CoAxiom { co_ax_unique = nameUnique tc_name
, co_ax_name = tc_name
, co_ax_tc = tc_tycon
, co_ax_branches = toBranchList tc_branches
, co_ax_implicit = False }
; return (ACoAxiom axiom) }
-tc_ax_branch :: IfaceAxBranch -> IfL CoAxBranch
-tc_ax_branch (IfaceAxBranch { ifaxbTyVars = tv_bndrs, ifaxbLHS = lhs, ifaxbRHS = rhs })
+tc_ax_branches :: [CoAxBranch] -> IfaceAxBranch -> IfL [CoAxBranch]
+tc_ax_branches prev_branches
+ (IfaceAxBranch { ifaxbTyVars = tv_bndrs, ifaxbLHS = lhs, ifaxbRHS = rhs
+ , ifaxbIncomps = incomps })
= bindIfaceTyVars tv_bndrs $ \ tvs -> do -- Variables will all be fresh
{ tc_lhs <- mapM tcIfaceType lhs
; tc_rhs <- tcIfaceType rhs
- ; return (CoAxBranch { cab_loc = noSrcSpan
- , cab_tvs = tvs
- , cab_lhs = tc_lhs
- , cab_rhs = tc_rhs } ) }
+ ; let br = CoAxBranch { cab_loc = noSrcSpan
+ , cab_tvs = tvs
+ , cab_lhs = tc_lhs
+ , cab_rhs = tc_rhs
+ , cab_incomps = map (prev_branches !!) incomps }
+ ; return (prev_branches ++ [br]) }
tcIfaceDataCons :: Name -> TyCon -> [TyVar] -> IfaceConDecls -> IfL AlgTyConRhs
tcIfaceDataCons tycon_name tycon _ if_cons
@@ -664,13 +672,15 @@ tcIfaceInst (IfaceClsInst { ifDFun = dfun_occ, ifOFlag = oflag
; let mb_tcs' = map (fmap ifaceTyConName) mb_tcs
; return (mkImportedInstance cls mb_tcs' dfun oflag) }
-tcIfaceFamInst :: IfaceFamInst -> IfL (FamInst Branched)
-tcIfaceFamInst (IfaceFamInst { ifFamInstFam = fam, ifFamInstTys = mb_tcss
- , ifFamInstBranched = branched, ifFamInstAxiom = axiom_name } )
+tcIfaceFamInst :: IfaceFamInst -> IfL FamInst
+tcIfaceFamInst (IfaceFamInst { ifFamInstFam = fam, ifFamInstTys = mb_tcs
+ , ifFamInstAxiom = axiom_name } )
= do { axiom' <- forkM (ptext (sLit "Axiom") <+> ppr axiom_name) $
tcIfaceCoAxiom axiom_name
- ; let mb_tcss' = map (map (fmap ifaceTyConName)) mb_tcss
- ; return (mkImportedFamInst fam branched mb_tcss' axiom') }
+ -- will panic if branched, but that's OK
+ ; let axiom'' = toUnbranchedAxiom axiom'
+ mb_tcs' = map (fmap ifaceTyConName) mb_tcs
+ ; return (mkImportedFamInst fam mb_tcs' axiom'') }
\end{code}
diff --git a/compiler/iface/TcIface.lhs-boot b/compiler/iface/TcIface.lhs-boot
index 58df07cdc4..591419a251 100644
--- a/compiler/iface/TcIface.lhs-boot
+++ b/compiler/iface/TcIface.lhs-boot
@@ -5,7 +5,7 @@ import IfaceSyn ( IfaceDecl, IfaceClsInst, IfaceFamInst, IfaceRule, IfaceAnno
import TypeRep ( TyThing )
import TcRnTypes ( IfL )
import InstEnv ( ClsInst )
-import FamInstEnv ( FamInst, Branched )
+import FamInstEnv ( FamInst )
import CoreSyn ( CoreRule )
import HscTypes ( TypeEnv, VectInfo, IfaceVectInfo )
import Module ( Module )
@@ -15,7 +15,7 @@ tcIfaceDecl :: Bool -> IfaceDecl -> IfL TyThing
tcIfaceRules :: Bool -> [IfaceRule] -> IfL [CoreRule]
tcIfaceVectInfo :: Module -> TypeEnv -> IfaceVectInfo -> IfL VectInfo
tcIfaceInst :: IfaceClsInst -> IfL ClsInst
-tcIfaceFamInst :: IfaceFamInst -> IfL (FamInst Branched)
+tcIfaceFamInst :: IfaceFamInst -> IfL FamInst
tcIfaceAnnotations :: [IfaceAnnotation] -> IfL [Annotation]
\end{code}
View Lorry Controller Status