Commit 8e325220 authored by chak@cse.unsw.edu.au.'s avatar chak@cse.unsw.edu.au.
Browse files

Iface representation of synonym family instances

  ** This patch changes the interface file format.  All libraries etc **
  ** need to be compiled from scratch.                                **
parent 25ebbb76
......@@ -1062,12 +1062,13 @@ instance Binary IfaceDecl where
put_ bh a6
put_ bh a7
put_ bh a8
put_ bh (IfaceSyn aq ar as at) = do
put_ bh (IfaceSyn a1 a2 a3 a4 a5) = do
putByte bh 3
put_ bh (occNameFS aq)
put_ bh ar
put_ bh as
put_ bh at
put_ bh (occNameFS a1)
put_ bh a2
put_ bh a3
put_ bh a4
put_ bh a5
put_ bh (IfaceClass a1 a2 a3 a4 a5 a6 a7) = do
putByte bh 4
put_ bh a1
......@@ -1098,12 +1099,13 @@ instance Binary IfaceDecl where
occ <- return $! mkOccNameFS tcName a1
return (IfaceData occ a2 a3 a4 a5 a6 a7 a8)
3 -> do
aq <- get bh
ar <- get bh
as <- get bh
at <- get bh
occ <- return $! mkOccNameFS tcName aq
return (IfaceSyn occ ar as at)
a1 <- get bh
a2 <- get bh
a3 <- get bh
a4 <- get bh
a5 <- get bh
occ <- return $! mkOccNameFS tcName a1
return (IfaceSyn occ a2 a3 a4 a5)
_ -> do
a1 <- get bh
a2 <- get bh
......
......@@ -77,14 +77,21 @@ data IfaceDecl
-- current compilation unit
ifFamInst :: Maybe (IfaceTyCon, [IfaceType])
-- Just <=> instance of family
-- Invariant:
-- ifCons /= IfOpenDataTyCon
-- for family instances
}
| IfaceSyn { ifName :: OccName, -- Type constructor
ifTyVars :: [IfaceTvBndr], -- Type variables
ifOpenSyn :: Bool, -- Is an open family?
ifSynRhs :: IfaceType -- Type for an ordinary
ifSynRhs :: IfaceType, -- Type for an ordinary
-- synonym and kind for an
-- open family
ifFamInst :: Maybe (IfaceTyCon, [IfaceType])
-- Just <=> instance of family
-- Invariant: ifOpenSyn == False
-- for family instances
}
| IfaceClass { ifCtxt :: IfaceContext, -- Context...
......@@ -391,9 +398,10 @@ pprIfaceDecl (IfaceForeign {ifName = tycon})
= hsep [ptext SLIT("foreign import type dotnet"), ppr tycon]
pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars,
ifOpenSyn = False, ifSynRhs = mono_ty})
ifOpenSyn = False, ifSynRhs = mono_ty,
ifFamInst = mbFamInst})
= hang (ptext SLIT("type") <+> pprIfaceDeclHead [] tycon tyvars)
4 (equals <+> ppr mono_ty)
4 (vcat [equals <+> ppr mono_ty, pprFamily mbFamInst])
pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars,
ifOpenSyn = True, ifSynRhs = mono_ty})
......@@ -712,14 +720,10 @@ eqIfDecl d1@(IfaceData {}) d2@(IfaceData {})
-- The type variables of the data type do not scope
-- over the constructors (any more), but they do scope
-- over the stupid context in the IfaceConDecls
where
Nothing `eqIfTc_fam` Nothing = Equal
(Just (fam1, tys1)) `eqIfTc_fam` (Just (fam2, tys2)) =
fam1 `eqIfTc` fam2 &&& eqListBy eqIfType tys1 tys2
_ `eqIfTc_fam` _ = NotEqual
eqIfDecl d1@(IfaceSyn {}) d2@(IfaceSyn {})
= bool (ifName d1 == ifName d2) &&&
ifFamInst d1 `eqIfTc_fam` ifFamInst d2 &&&
eqWith (ifTyVars d1) (ifTyVars d2) (\ env ->
eq_ifType env (ifSynRhs d1) (ifSynRhs d2)
)
......@@ -740,6 +744,15 @@ eqIfDecl _ _ = NotEqual -- default case
eqWith :: [IfaceTvBndr] -> [IfaceTvBndr] -> (EqEnv -> IfaceEq) -> IfaceEq
eqWith = eq_ifTvBndrs emptyEqEnv
eqIfTc_fam :: Maybe (IfaceTyCon, [IfaceType])
-> Maybe (IfaceTyCon, [IfaceType])
-> IfaceEq
Nothing `eqIfTc_fam` Nothing = Equal
(Just (fam1, tys1)) `eqIfTc_fam` (Just (fam2, tys2)) =
fam1 `eqIfTc` fam2 &&& eqListBy eqIfType tys1 tys2
_ `eqIfTc_fam` _ = NotEqual
-----------------------
eqIfInst d1 d2 = bool (ifDFun d1 == ifDFun d2 && ifOFlag d1 == ifOFlag d2)
-- All other changes are handled via the version info on the dfun
......
......@@ -1070,10 +1070,12 @@ tyThingToIfaceDecl (AClass clas)
tyThingToIfaceDecl (ATyCon tycon)
| isSynTyCon tycon
= IfaceSyn { ifName = getOccName tycon,
ifTyVars = toIfaceTvBndrs tyvars,
= IfaceSyn { ifName = getOccName tycon,
ifTyVars = toIfaceTvBndrs tyvars,
ifOpenSyn = syn_isOpen,
ifSynRhs = toIfaceType syn_tyki }
ifSynRhs = toIfaceType syn_tyki,
ifFamInst = famInstToIface (tyConFamInst_maybe tycon)
}
| isAlgTyCon tycon
= IfaceData { ifName = getOccName tycon,
......
......@@ -383,14 +383,21 @@ tcIfaceDecl ignore_prags
tcIfaceDecl ignore_prags
(IfaceSyn {ifName = occ_name, ifTyVars = tv_bndrs,
ifOpenSyn = isOpen, ifSynRhs = rdr_rhs_ty})
ifOpenSyn = isOpen, ifSynRhs = rdr_rhs_ty,
ifFamInst = mb_family})
= bindIfaceTyVars tv_bndrs $ \ tyvars -> do
{ tc_name <- lookupIfaceTop occ_name
; rhs_tyki <- tcIfaceType rdr_rhs_ty
; let rhs = if isOpen then OpenSynTyCon rhs_tyki Nothing
else SynonymTyCon rhs_tyki
-- !!!TODO: read mb_family info from iface and pass as last argument
; tycon <- buildSynTyCon tc_name tyvars rhs Nothing
; famInst <- case mb_family of
Nothing -> return Nothing
Just (fam, tys) ->
do { famTyCon <- tcIfaceTyCon fam
; insttys <- mapM tcIfaceType tys
; return $ Just (famTyCon, insttys)
}
; tycon <- buildSynTyCon tc_name tyvars rhs famInst
; return $ ATyCon tycon
}
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment