IfaceDecl(..), IfaceClassOp(..), IfaceConDecl(..), IfaceConDecls(..),
IfaceExpr(..), IfaceAlt, IfaceNote(..), IfaceLetBndr(..),
- IfaceBinding(..), IfaceConAlt(..), IfaceIdInfo(..),
- IfaceInfoItem(..), IfaceRule(..), IfaceInst(..), IfaceFamInst(..),
+ IfaceBinding(..), IfaceConAlt(..), IfaceIdInfo(..), IfaceUnfolding(..),
+ IfaceInfoItem(..), IfaceRule(..), IfaceAnnotation(..), IfaceAnnTarget,
+ IfaceInst(..), IfaceFamInst(..),
-- Misc
ifaceDeclSubBndrs, visibleIfConDecls,
#include "HsVersions.h"
-import CoreSyn
import IfaceType
import NewDemand
+import Annotations
import Class
import NameSet
import Name
import CostCentre
import Literal
import ForeignCall
+import Serialized
import BasicTypes
import Outputable
import FastString
| IfaceSyn { ifName :: OccName, -- Type constructor
ifTyVars :: [IfaceTvBndr], -- Type variables
- ifOpenSyn :: Bool, -- Is an open family?
- ifSynRhs :: IfaceType, -- Type for an ordinary
- -- synonym and kind for an
- -- open family
- ifFamInst :: Maybe (IfaceTyCon, [IfaceType])
+ ifSynKind :: IfaceKind, -- Kind of the *rhs* (not of the tycon)
+ ifSynRhs :: Maybe IfaceType, -- Just rhs for an ordinary synonyn
+ -- Nothing for an open family
+ ifFamInst :: Maybe (IfaceTyCon, [IfaceType])
-- Just <=> instance of family
-- Invariant: ifOpenSyn == False
-- for family instances
ifRuleOrph :: Maybe OccName -- Just like IfaceInst
}
+data IfaceAnnotation
+ = IfaceAnnotation {
+ ifAnnotatedTarget :: IfaceAnnTarget,
+ ifAnnotatedValue :: Serialized
+ }
+
+type IfaceAnnTarget = AnnTarget OccName
+
data IfaceIdInfo
= NoInfo -- When writing interface file without -O
| HasInfo [IfaceInfoItem] -- Has info, and here it is
= HsArity Arity
| HsStrictness StrictSig
| HsInline Activation
- | HsUnfold IfaceExpr
+ | HsUnfold IfaceUnfolding
| HsNoCafRefs
- | HsWorker Name Arity -- Worker, if any see IdInfo.WorkerInfo
- -- for why we want arity here.
- -- NB: we need IfaceExtName (not just OccName) because the worker
- -- can simplify to a function in another module.
+
-- NB: Specialisations and rules come in separately and are
-- only later attached to the Id. Partial reason: some are orphans.
+data IfaceUnfolding
+ = IfCoreUnfold IfaceExpr
+ | IfInlineRule Arity IfaceExpr
+ | IfWrapper Arity Name -- NB: we need a Name (not just OccName) because the worker
+ -- can simplify to a function in another module.
+
--------------------------------
data IfaceExpr
= IfaceLcl FastString
| IfaceTick Module Int
data IfaceNote = IfaceSCC CostCentre
- | IfaceInlineMe
| IfaceCoreNote String
type IfaceAlt = (IfaceConAlt, [FastString], IfaceExpr)
= hsep [ptext (sLit "foreign import type dotnet"), ppr tycon]
pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars,
- ifOpenSyn = False, ifSynRhs = mono_ty,
+ ifSynRhs = Just mono_ty,
ifFamInst = mbFamInst})
= hang (ptext (sLit "type") <+> pprIfaceDeclHead [] tycon tyvars)
4 (vcat [equals <+> ppr mono_ty, pprFamily mbFamInst])
pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars,
- ifOpenSyn = True, ifSynRhs = mono_ty})
+ ifSynRhs = Nothing, ifSynKind = kind })
= hang (ptext (sLit "type family") <+> pprIfaceDeclHead [] tycon tyvars)
- 4 (dcolon <+> ppr mono_ty)
+ 4 (dcolon <+> ppr kind)
pprIfaceDecl (IfaceData {ifName = tycon, ifGeneric = gen, ifCtxt = context,
ifTyVars = tyvars, ifCons = condecls,
------------------
instance Outputable IfaceNote where
ppr (IfaceSCC cc) = pprCostCentreCore cc
- ppr IfaceInlineMe = ptext (sLit "__inline_me")
ppr (IfaceCoreNote s) = ptext (sLit "__core_note") <+> pprHsString (mkFastString s)
ppr (HasInfo is) = ptext (sLit "{-") <+> fsep (map ppr is) <+> ptext (sLit "-}")
instance Outputable IfaceInfoItem where
- ppr (HsUnfold unf) = ptext (sLit "Unfolding:") <+>
- parens (pprIfaceExpr noParens unf)
+ ppr (HsUnfold unf) = ptext (sLit "Unfolding:") <+> ppr unf
ppr (HsInline act) = ptext (sLit "Inline:") <+> ppr act
ppr (HsArity arity) = ptext (sLit "Arity:") <+> int arity
ppr (HsStrictness str) = ptext (sLit "Strictness:") <+> pprIfaceStrictSig str
ppr HsNoCafRefs = ptext (sLit "HasNoCafRefs")
- ppr (HsWorker w a) = ptext (sLit "Worker:") <+> ppr w <+> int a
+
+instance Outputable IfaceUnfolding where
+ ppr (IfCoreUnfold e) = parens (ppr e)
+ ppr (IfInlineRule a e) = ptext (sLit "INLINE:") <+> parens (ptext (sLit "arity") <+> int a) <+> parens (ppr e)
+ ppr (IfWrapper a wkr) = ptext (sLit "Worker:") <+> ppr wkr <+> parens (ptext (sLit "arity") <+> int a)
-- -----------------------------------------------------------------------------
freeNamesIfConDecls (ifCons d)
freeNamesIfDecl d@IfaceSyn{} =
freeNamesIfTvBndrs (ifTyVars d) &&&
- freeNamesIfType (ifSynRhs d) &&&
+ freeNamesIfSynRhs (ifSynRhs d) &&&
freeNamesIfTcFam (ifFamInst d)
freeNamesIfDecl d@IfaceClass{} =
freeNamesIfTvBndrs (ifTyVars d) &&&
fnList freeNamesIfClsSig (ifSigs d)
-- All other changes are handled via the version info on the tycon
+freeNamesIfSynRhs :: Maybe IfaceType -> NameSet
+freeNamesIfSynRhs (Just ty) = freeNamesIfType ty
+freeNamesIfSynRhs Nothing = emptyNameSet
+
freeNamesIfTcFam :: Maybe (IfaceTyCon, [IfaceType]) -> NameSet
freeNamesIfTcFam (Just (tc,tys)) =
freeNamesIfTc tc &&& fnList freeNamesIfType tys
freeNamesIfTvBndrs :: [IfaceTvBndr] -> NameSet
freeNamesIfTvBndrs = fnList freeNamesIfTvBndr
+freeNamesIfBndr :: IfaceBndr -> NameSet
+freeNamesIfBndr (IfaceIdBndr b) = freeNamesIfIdBndr b
+freeNamesIfBndr (IfaceTvBndr b) = freeNamesIfTvBndr b
+
freeNamesIfTvBndr :: IfaceTvBndr -> NameSet
freeNamesIfTvBndr (_fs,k) = freeNamesIfType k
-- kinds can have Names inside, when the Kind is an equality predicate
+freeNamesIfIdBndr :: IfaceIdBndr -> NameSet
+freeNamesIfIdBndr = freeNamesIfTvBndr
+
freeNamesIfIdInfo :: IfaceIdInfo -> NameSet
freeNamesIfIdInfo NoInfo = emptyNameSet
freeNamesIfIdInfo (HasInfo i) = fnList freeNamesItem i
freeNamesItem :: IfaceInfoItem -> NameSet
-freeNamesItem (HsUnfold u) = freeNamesIfExpr u
-freeNamesItem (HsWorker wkr _) = unitNameSet wkr
+freeNamesItem (HsUnfold u) = freeNamesIfUnfold u
freeNamesItem _ = emptyNameSet
+freeNamesIfUnfold :: IfaceUnfolding -> NameSet
+freeNamesIfUnfold (IfCoreUnfold e) = freeNamesIfExpr e
+freeNamesIfUnfold (IfInlineRule _ e) = freeNamesIfExpr e
+freeNamesIfUnfold (IfWrapper _ v) = unitNameSet v
+
freeNamesIfExpr :: IfaceExpr -> NameSet
freeNamesIfExpr (IfaceExt v) = unitNameSet v
freeNamesIfExpr (IfaceFCall _ ty) = freeNamesIfType ty
freeNamesIfTc _ = emptyNameSet
freeNamesIfRule :: IfaceRule -> NameSet
-freeNamesIfRule (IfaceRule _n _a _bs f es rhs _o)
- = unitNameSet f &&& fnList freeNamesIfExpr es &&& freeNamesIfExpr rhs
+freeNamesIfRule (IfaceRule _n _a bs f es rhs _o)
+ = unitNameSet f &&&
+ fnList freeNamesIfBndr bs &&&
+ fnList freeNamesIfExpr es &&&
+ freeNamesIfExpr rhs
-- helpers
(&&&) :: NameSet -> NameSet -> NameSet
projects / ghc-hetmet.git / blobdiff