projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Merge branch 'master' of http://darcs.haskell.org/ghc into ghc-generics
[ghc-hetmet.git]
/
compiler
/
iface
/
IfaceSyn.lhs
diff --git
a/compiler/iface/IfaceSyn.lhs
b/compiler/iface/IfaceSyn.lhs
index
44dd34a
..
ea1ace8
100644
(file)
--- a/
compiler/iface/IfaceSyn.lhs
+++ b/
compiler/iface/IfaceSyn.lhs
@@
-27,7
+27,8
@@
module IfaceSyn (
#include "HsVersions.h"
import IfaceType
#include "HsVersions.h"
import IfaceType
-
+import CoreSyn( DFunArg, dfunArgExprs )
+import PprCore() -- Printing DFunArgs
import Demand
import Annotations
import Class
import Demand
import Annotations
import Class
@@
-66,14
+67,6
@@
data IfaceDecl
ifRec :: RecFlag, -- Recursive or not?
ifGadtSyntax :: Bool, -- True <=> declared using
-- GADT syntax
ifRec :: RecFlag, -- Recursive or not?
ifGadtSyntax :: Bool, -- True <=> declared using
-- GADT syntax
- ifGeneric :: Bool, -- True <=> generic converter
- -- functions available
- -- We need this for imported
- -- data decls, since the
- -- imported modules may have
- -- been compiled with
- -- different flags to the
- -- current compilation unit
ifFamInst :: Maybe (IfaceTyCon, [IfaceType])
-- Just <=> instance of family
-- Invariant:
ifFamInst :: Maybe (IfaceTyCon, [IfaceType])
-- Just <=> instance of family
-- Invariant:
@@
-105,7
+98,7
@@
data IfaceDecl
-- beyond .NET
ifExtName :: Maybe FastString }
-- beyond .NET
ifExtName :: Maybe FastString }
-data IfaceClassOp = IfaceClassOp OccName DefMeth IfaceType
+data IfaceClassOp = IfaceClassOp OccName DefMethSpec IfaceType
-- Nothing => no default method
-- Just False => ordinary polymorphic default method
-- Just True => generic default method
-- Nothing => no default method
-- Just False => ordinary polymorphic default method
-- Just True => generic default method
@@
-137,9
+130,9
@@
data IfaceConDecl
-- or 1-1 corresp with arg tys
data IfaceInst
-- or 1-1 corresp with arg tys
data IfaceInst
- = IfaceInst { ifInstCls :: Name, -- See comments with
+ = IfaceInst { ifInstCls :: IfExtName, -- See comments with
ifInstTys :: [Maybe IfaceTyCon], -- the defn of Instance
ifInstTys :: [Maybe IfaceTyCon], -- the defn of Instance
- ifDFun :: Name, -- The dfun
+ ifDFun :: IfExtName, -- The dfun
ifOFlag :: OverlapFlag, -- Overlap flag
ifInstOrph :: Maybe OccName } -- See Note [Orphans]
-- There's always a separate IfaceDecl for the DFun, which gives
ifOFlag :: OverlapFlag, -- Overlap flag
ifInstOrph :: Maybe OccName } -- See Note [Orphans]
-- There's always a separate IfaceDecl for the DFun, which gives
@@
-150,7
+143,7
@@
data IfaceInst
-- and if the head does not change it won't be used if it wasn't before
data IfaceFamInst
-- and if the head does not change it won't be used if it wasn't before
data IfaceFamInst
- = IfaceFamInst { ifFamInstFam :: Name -- Family tycon
+ = IfaceFamInst { ifFamInstFam :: IfExtName -- Family tycon
, ifFamInstTys :: [Maybe IfaceTyCon] -- Rough match types
, ifFamInstTyCon :: IfaceTyCon -- Instance decl
}
, ifFamInstTys :: [Maybe IfaceTyCon] -- Rough match types
, ifFamInstTyCon :: IfaceTyCon -- Instance decl
}
@@
-160,9
+153,10
@@
data IfaceRule
ifRuleName :: RuleName,
ifActivation :: Activation,
ifRuleBndrs :: [IfaceBndr], -- Tyvars and term vars
ifRuleName :: RuleName,
ifActivation :: Activation,
ifRuleBndrs :: [IfaceBndr], -- Tyvars and term vars
- ifRuleHead :: Name, -- Head of lhs
+ ifRuleHead :: IfExtName, -- Head of lhs
ifRuleArgs :: [IfaceExpr], -- Args of LHS
ifRuleRhs :: IfaceExpr,
ifRuleArgs :: [IfaceExpr], -- Args of LHS
ifRuleRhs :: IfaceExpr,
+ ifRuleAuto :: Bool,
ifRuleOrph :: Maybe OccName -- Just like IfaceInst
}
ifRuleOrph :: Maybe OccName -- Just like IfaceInst
}
@@
-182,7
+176,7
@@
type IfaceAnnTarget = AnnTarget OccName
data IfaceIdDetails
= IfVanillaId
| IfRecSelId IfaceTyCon Bool
data IfaceIdDetails
= IfVanillaId
| IfRecSelId IfaceTyCon Bool
- | IfDFunId
+ | IfDFunId Int -- Number of silent args
data IfaceIdInfo
= NoInfo -- When writing interface file without -O
data IfaceIdInfo
= NoInfo -- When writing interface file without -O
@@
-210,28
+204,32
@@
data IfaceInfoItem
-- only later attached to the Id. Partial reason: some are orphans.
data IfaceUnfolding
-- only later attached to the Id. Partial reason: some are orphans.
data IfaceUnfolding
- = IfCoreUnfold IfaceExpr
+ = IfCoreUnfold Bool IfaceExpr -- True <=> INLINABLE, False <=> regular unfolding
+ -- Possibly could eliminate the Bool here, the information
+ -- is also in the InlinePragma.
+
| IfCompulsory IfaceExpr -- Only used for default methods, in fact
| IfCompulsory IfaceExpr -- Only used for default methods, in fact
- | IfInlineRule Arity
+ | IfInlineRule Arity -- INLINE pragmas
Bool -- OK to inline even if *un*-saturated
Bool -- OK to inline even if context is boring
IfaceExpr
Bool -- OK to inline even if *un*-saturated
Bool -- OK to inline even if context is boring
IfaceExpr
- | IfWrapper Arity Name -- NB: we need a Name (not just OccName) because the worker
- -- can simplify to a function in another module.
+ | IfExtWrapper Arity IfExtName -- NB: sometimes we need a IfExtName (not just IfLclName)
+ | IfLclWrapper Arity IfLclName -- because the worker can simplify to a function in
+ -- another module.
- | IfDFunUnfold [IfaceExpr]
+ | IfDFunUnfold [DFunArg IfaceExpr]
--------------------------------
data IfaceExpr
--------------------------------
data IfaceExpr
- = IfaceLcl FastString
- | IfaceExt Name
+ = IfaceLcl IfLclName
+ | IfaceExt IfExtName
| IfaceType IfaceType
| IfaceTuple Boxity [IfaceExpr] -- Saturated; type arguments omitted
| IfaceLam IfaceBndr IfaceExpr
| IfaceApp IfaceExpr IfaceExpr
| IfaceType IfaceType
| IfaceTuple Boxity [IfaceExpr] -- Saturated; type arguments omitted
| IfaceLam IfaceBndr IfaceExpr
| IfaceApp IfaceExpr IfaceExpr
- | IfaceCase IfaceExpr FastString IfaceType [IfaceAlt]
+ | IfaceCase IfaceExpr IfLclName IfaceType [IfaceAlt]
| IfaceLet IfaceBinding IfaceExpr
| IfaceNote IfaceNote IfaceExpr
| IfaceCast IfaceExpr IfaceCoercion
| IfaceLet IfaceBinding IfaceExpr
| IfaceNote IfaceNote IfaceExpr
| IfaceCast IfaceExpr IfaceCoercion
@@
-242,13
+240,13
@@
data IfaceExpr
data IfaceNote = IfaceSCC CostCentre
| IfaceCoreNote String
data IfaceNote = IfaceSCC CostCentre
| IfaceCoreNote String
-type IfaceAlt = (IfaceConAlt, [FastString], IfaceExpr)
- -- Note: FastString, not IfaceBndr (and same with the case binder)
+type 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
data IfaceConAlt = IfaceDefault
-- We reconstruct the kind/type of the thing from the context
-- thus saving bulk in interface files
data IfaceConAlt = IfaceDefault
- | IfaceDataAlt Name
+ | IfaceDataAlt IfExtName
| IfaceTupleAlt Boxity
| IfaceLitAlt Literal
| IfaceTupleAlt Boxity
| IfaceLitAlt Literal
@@
-259,7
+257,7
@@
data IfaceBinding
-- IfaceLetBndr is like IfaceIdBndr, but has IdInfo too
-- It's used for *non-top-level* let/rec binders
-- See Note [IdInfo on nested let-bindings]
-- IfaceLetBndr is like IfaceIdBndr, but has IdInfo too
-- It's used for *non-top-level* let/rec binders
-- See Note [IdInfo on nested let-bindings]
-data IfaceLetBndr = IfLetBndr FastString IfaceType IfaceIdInfo
+data IfaceLetBndr = IfLetBndr IfLclName IfaceType IfaceIdInfo
\end{code}
Note [Expose recursive functions]
\end{code}
Note [Expose recursive functions]
@@
-276,10
+274,8
@@
that came up was a NOINLINE pragma on a let-binding inside an INLINE
function. The user (Duncan Coutts) really wanted the NOINLINE control
to cross the separate compilation boundary.
function. The user (Duncan Coutts) really wanted the NOINLINE control
to cross the separate compilation boundary.
-So a IfaceLetBndr keeps a trimmed-down list of IfaceIdInfo stuff.
-Currently we only actually retain InlinePragInfo, but in principle we could
-add strictness etc.
-
+In general we retain all info that is left by CoreTidy.tidyLetBndr, since
+that is what is seen by importing module with --make
Note [Orphans]: the ifInstOrph and ifRuleOrph fields
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Note [Orphans]: the ifInstOrph and ifRuleOrph fields
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@
-467,11
+463,11
@@
pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars,
= hang (ptext (sLit "type family") <+> pprIfaceDeclHead [] tycon tyvars)
4 (dcolon <+> ppr kind)
= hang (ptext (sLit "type family") <+> pprIfaceDeclHead [] tycon tyvars)
4 (dcolon <+> ppr kind)
-pprIfaceDecl (IfaceData {ifName = tycon, ifGeneric = gen, ifCtxt = context,
+pprIfaceDecl (IfaceData {ifName = tycon, ifCtxt = context,
ifTyVars = tyvars, ifCons = condecls,
ifRec = isrec, ifFamInst = mbFamInst})
= hang (pp_nd <+> pprIfaceDeclHead context tycon tyvars)
ifTyVars = tyvars, ifCons = condecls,
ifRec = isrec, ifFamInst = mbFamInst})
= hang (pp_nd <+> pprIfaceDeclHead context tycon tyvars)
- 4 (vcat [pprRec isrec, pprGen gen, pp_condecls tycon condecls,
+ 4 (vcat [pprRec isrec, pp_condecls tycon condecls,
pprFamily mbFamInst])
where
pp_nd = case condecls of
pprFamily mbFamInst])
where
pp_nd = case condecls of
@@
-491,10
+487,6
@@
pprIfaceDecl (IfaceClass {ifCtxt = context, ifName = clas, ifTyVars = tyvars,
pprRec :: RecFlag -> SDoc
pprRec isrec = ptext (sLit "RecFlag") <+> ppr isrec
pprRec :: RecFlag -> SDoc
pprRec isrec = ptext (sLit "RecFlag") <+> ppr isrec
-pprGen :: Bool -> SDoc
-pprGen True = ptext (sLit "Generics: yes")
-pprGen False = ptext (sLit "Generics: no")
-
pprFamily :: Maybe (IfaceTyCon, [IfaceType]) -> SDoc
pprFamily Nothing = ptext (sLit "FamilyInstance: none")
pprFamily (Just famInst) = ptext (sLit "FamilyInstance:") <+> ppr famInst
pprFamily :: Maybe (IfaceTyCon, [IfaceType]) -> SDoc
pprFamily Nothing = ptext (sLit "FamilyInstance: none")
pprFamily (Just famInst) = ptext (sLit "FamilyInstance:") <+> ppr famInst
@@
-636,11
+628,11
@@
pprIfaceExpr add_par (IfaceLet (IfaceRec pairs) body)
pprIfaceExpr add_par (IfaceNote note body) = add_par (ppr note <+> pprParendIfaceExpr body)
pprIfaceExpr add_par (IfaceNote note body) = add_par (ppr note <+> pprParendIfaceExpr body)
-ppr_alt :: (IfaceConAlt, [FastString], IfaceExpr) -> SDoc
+ppr_alt :: (IfaceConAlt, [IfLclName], IfaceExpr) -> SDoc
ppr_alt (con, bs, rhs) = sep [ppr_con_bs con bs,
arrow <+> pprIfaceExpr noParens rhs]
ppr_alt (con, bs, rhs) = sep [ppr_con_bs con bs,
arrow <+> pprIfaceExpr noParens rhs]
-ppr_con_bs :: IfaceConAlt -> [FastString] -> SDoc
+ppr_con_bs :: IfaceConAlt -> [IfLclName] -> SDoc
ppr_con_bs (IfaceTupleAlt tup_con) bs = tupleParens tup_con (interpp'SP bs)
ppr_con_bs con bs = ppr con <+> hsep (map ppr bs)
ppr_con_bs (IfaceTupleAlt tup_con) bs = tupleParens tup_con (interpp'SP bs)
ppr_con_bs con bs = ppr con <+> hsep (map ppr bs)
@@
-672,7
+664,7
@@
instance Outputable IfaceIdDetails where
ppr IfVanillaId = empty
ppr (IfRecSelId tc b) = ptext (sLit "RecSel") <+> ppr tc
<+> if b then ptext (sLit "<naughty>") else empty
ppr IfVanillaId = empty
ppr (IfRecSelId tc b) = ptext (sLit "RecSel") <+> ppr tc
<+> if b then ptext (sLit "<naughty>") else empty
- ppr IfDFunId = ptext (sLit "DFunId")
+ ppr (IfDFunId ns) = ptext (sLit "DFunId") <> brackets (int ns)
instance Outputable IfaceIdInfo where
ppr NoInfo = empty
instance Outputable IfaceIdInfo where
ppr NoInfo = empty
@@
-688,12
+680,15
@@
instance Outputable IfaceInfoItem where
instance Outputable IfaceUnfolding where
ppr (IfCompulsory e) = ptext (sLit "<compulsory>") <+> parens (ppr e)
instance Outputable IfaceUnfolding where
ppr (IfCompulsory e) = ptext (sLit "<compulsory>") <+> parens (ppr e)
- ppr (IfCoreUnfold e) = parens (ppr e)
+ ppr (IfCoreUnfold s e) = (if s then ptext (sLit "<stable>") else empty) <+> parens (ppr e)
ppr (IfInlineRule a uok bok e) = sep [ptext (sLit "InlineRule") <+> ppr (a,uok,bok),
pprParendIfaceExpr e]
ppr (IfInlineRule a uok bok e) = sep [ptext (sLit "InlineRule") <+> ppr (a,uok,bok),
pprParendIfaceExpr e]
- ppr (IfWrapper a wkr) = ptext (sLit "Worker:") <+> ppr wkr <+> parens (ptext (sLit "arity") <+> int a)
- ppr (IfDFunUnfold ns) = ptext (sLit "DFun:") <+> brackets (pprWithCommas pprParendIfaceExpr ns)
-
+ ppr (IfLclWrapper a wkr) = ptext (sLit "Worker(lcl):") <+> ppr wkr
+ <+> parens (ptext (sLit "arity") <+> int a)
+ ppr (IfExtWrapper a wkr) = ptext (sLit "Worker(ext0:") <+> ppr wkr
+ <+> parens (ptext (sLit "arity") <+> int a)
+ ppr (IfDFunUnfold ns) = ptext (sLit "DFun:")
+ <+> brackets (pprWithCommas ppr ns)
-- -----------------------------------------------------------------------------
-- Finding the Names in IfaceSyn
-- -----------------------------------------------------------------------------
-- Finding the Names in IfaceSyn
@@
-791,8
+786,10
@@
freeNamesIfBndr (IfaceTvBndr b) = freeNamesIfTvBndr b
freeNamesIfLetBndr :: IfaceLetBndr -> NameSet
-- Remember IfaceLetBndr is used only for *nested* bindings
freeNamesIfLetBndr :: IfaceLetBndr -> NameSet
-- Remember IfaceLetBndr is used only for *nested* bindings
--- The cut-down IdInfo never contains any Names, but the type may!
-freeNamesIfLetBndr (IfLetBndr _name ty _info) = freeNamesIfType ty
+-- The IdInfo can contain an unfolding (in the case of
+-- local INLINE pragmas), so look there too
+freeNamesIfLetBndr (IfLetBndr _name ty info) = freeNamesIfType ty
+ &&& freeNamesIfIdInfo info
freeNamesIfTvBndr :: IfaceTvBndr -> NameSet
freeNamesIfTvBndr (_fs,k) = freeNamesIfType k
freeNamesIfTvBndr :: IfaceTvBndr -> NameSet
freeNamesIfTvBndr (_fs,k) = freeNamesIfType k
@@
-810,11
+807,12
@@
freeNamesItem (HsUnfold _ u) = freeNamesIfUnfold u
freeNamesItem _ = emptyNameSet
freeNamesIfUnfold :: IfaceUnfolding -> NameSet
freeNamesItem _ = emptyNameSet
freeNamesIfUnfold :: IfaceUnfolding -> NameSet
-freeNamesIfUnfold (IfCoreUnfold e) = freeNamesIfExpr e
+freeNamesIfUnfold (IfCoreUnfold _ e) = freeNamesIfExpr e
freeNamesIfUnfold (IfCompulsory e) = freeNamesIfExpr e
freeNamesIfUnfold (IfInlineRule _ _ _ e) = freeNamesIfExpr e
freeNamesIfUnfold (IfCompulsory e) = freeNamesIfExpr e
freeNamesIfUnfold (IfInlineRule _ _ _ e) = freeNamesIfExpr e
-freeNamesIfUnfold (IfWrapper _ v) = unitNameSet v
-freeNamesIfUnfold (IfDFunUnfold vs) = fnList freeNamesIfExpr vs
+freeNamesIfUnfold (IfExtWrapper _ v) = unitNameSet v
+freeNamesIfUnfold (IfLclWrapper {}) = emptyNameSet
+freeNamesIfUnfold (IfDFunUnfold vs) = fnList freeNamesIfExpr (dfunArgExprs vs)
freeNamesIfExpr :: IfaceExpr -> NameSet
freeNamesIfExpr (IfaceExt v) = unitNameSet v
freeNamesIfExpr :: IfaceExpr -> NameSet
freeNamesIfExpr (IfaceExt v) = unitNameSet v
@@
-850,14
+848,14
@@
freeNamesIfExpr (IfaceLet (IfaceRec as) x)
freeNamesIfExpr _ = emptyNameSet
freeNamesIfExpr _ = emptyNameSet
-
freeNamesIfTc :: IfaceTyCon -> NameSet
freeNamesIfTc (IfaceTc tc) = unitNameSet tc
-- ToDo: shouldn't we include IfaceIntTc & co.?
freeNamesIfTc _ = emptyNameSet
freeNamesIfRule :: IfaceRule -> NameSet
freeNamesIfTc :: IfaceTyCon -> NameSet
freeNamesIfTc (IfaceTc tc) = unitNameSet tc
-- ToDo: shouldn't we include IfaceIntTc & co.?
freeNamesIfTc _ = emptyNameSet
freeNamesIfRule :: IfaceRule -> NameSet
-freeNamesIfRule (IfaceRule _n _a bs f es rhs _o)
+freeNamesIfRule (IfaceRule { ifRuleBndrs = bs, ifRuleHead = f
+ , ifRuleArgs = es, ifRuleRhs = rhs })
= unitNameSet f &&&
fnList freeNamesIfBndr bs &&&
fnList freeNamesIfExpr es &&&
= unitNameSet f &&&
fnList freeNamesIfBndr bs &&&
fnList freeNamesIfExpr es &&&