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
f86f4b9
..
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:
@@
-183,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
@@
-226,7
+219,7
@@
data IfaceUnfolding
| IfLclWrapper Arity IfLclName -- because the worker can simplify to a function in
-- another module.
| IfLclWrapper Arity IfLclName -- because the worker can simplify to a function in
-- another module.
- | IfDFunUnfold [IfaceExpr]
+ | IfDFunUnfold [DFunArg IfaceExpr]
--------------------------------
data IfaceExpr
--------------------------------
data IfaceExpr
@@
-470,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
@@
-494,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
@@
-675,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
@@
-699,8
+688,7
@@
instance Outputable IfaceUnfolding where
ppr (IfExtWrapper a wkr) = ptext (sLit "Worker(ext0:") <+> ppr wkr
<+> parens (ptext (sLit "arity") <+> int a)
ppr (IfDFunUnfold ns) = ptext (sLit "DFun:")
ppr (IfExtWrapper a wkr) = ptext (sLit "Worker(ext0:") <+> ppr wkr
<+> parens (ptext (sLit "arity") <+> int a)
ppr (IfDFunUnfold ns) = ptext (sLit "DFun:")
- <+> brackets (pprWithCommas pprParendIfaceExpr ns)
-
+ <+> brackets (pprWithCommas ppr ns)
-- -----------------------------------------------------------------------------
-- Finding the Names in IfaceSyn
-- -----------------------------------------------------------------------------
-- Finding the Names in IfaceSyn
@@
-798,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
@@
-822,7
+812,7
@@
freeNamesIfUnfold (IfCompulsory e) = freeNamesIfExpr e
freeNamesIfUnfold (IfInlineRule _ _ _ e) = freeNamesIfExpr e
freeNamesIfUnfold (IfExtWrapper _ v) = unitNameSet v
freeNamesIfUnfold (IfLclWrapper {}) = emptyNameSet
freeNamesIfUnfold (IfInlineRule _ _ _ e) = freeNamesIfExpr e
freeNamesIfUnfold (IfExtWrapper _ v) = unitNameSet v
freeNamesIfUnfold (IfLclWrapper {}) = emptyNameSet
-freeNamesIfUnfold (IfDFunUnfold vs) = fnList freeNamesIfExpr vs
+freeNamesIfUnfold (IfDFunUnfold vs) = fnList freeNamesIfExpr (dfunArgExprs vs)
freeNamesIfExpr :: IfaceExpr -> NameSet
freeNamesIfExpr (IfaceExt v) = unitNameSet v
freeNamesIfExpr :: IfaceExpr -> NameSet
freeNamesIfExpr (IfaceExt v) = unitNameSet v
@@
-858,7
+848,6
@@
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 :: IfaceTyCon -> NameSet
freeNamesIfTc (IfaceTc tc) = unitNameSet tc
-- ToDo: shouldn't we include IfaceIntTc & co.?