import DataCon ( dataConName, dataConSig, dataConFieldLabels, dataConStrictMarks,
dataConTyCon, dataConIsInfix, isVanillaDataCon )
import Class ( FunDep, DefMeth, classExtraBigSig, classTyCon )
-import OccName ( OccName, OccEnv, emptyOccEnv,
- lookupOccEnv, extendOccEnv, parenSymOcc,
+import OccName ( OccName, parenSymOcc, occNameFS,
OccSet, unionOccSets, unitOccSet )
+import UniqFM ( UniqFM, emptyUFM, addToUFM, lookupUFM )
import Name ( Name, NamedThing(..), nameOccName, isExternalName )
import CostCentre ( CostCentre, pprCostCentreCore )
import Literal ( Literal )
| IfaceClass { ifCtxt :: IfaceContext, -- Context...
ifName :: OccName, -- Name of the class
ifTyVars :: [IfaceTvBndr], -- Type variables
- ifFDs :: [FunDep OccName], -- Functional dependencies
+ ifFDs :: [FunDep FastString], -- Functional dependencies
ifSigs :: [IfaceClassOp], -- Method signatures
ifRec :: RecFlag, -- Is newtype/datatype associated with the class recursive?
ifVrcs :: ArgVrcs -- ... and what are its argument variances ...
--------------------------------
data IfaceExpr
- = IfaceLcl OccName
+ = IfaceLcl FastString
| IfaceExt IfaceExtName
| IfaceType IfaceType
| IfaceTuple Boxity [IfaceExpr] -- Saturated; type arguments omitted
| IfaceLam IfaceBndr IfaceExpr
| IfaceApp IfaceExpr IfaceExpr
- | IfaceCase IfaceExpr OccName IfaceType [IfaceAlt]
+ | IfaceCase IfaceExpr FastString IfaceType [IfaceAlt]
| IfaceLet IfaceBinding IfaceExpr
| IfaceNote IfaceNote IfaceExpr
| IfaceLit Literal
data IfaceNote = IfaceSCC CostCentre
| IfaceCoerce IfaceType
- | IfaceInlineCall
| IfaceInlineMe
| IfaceCoreNote String
-type IfaceAlt = (IfaceConAlt, [OccName], IfaceExpr)
+type IfaceAlt = (IfaceConAlt, [FastString], IfaceExpr)
-- Note: OccName, 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
instance Outputable IfaceNote where
ppr (IfaceSCC cc) = pprCostCentreCore cc
ppr (IfaceCoerce ty) = ptext SLIT("__coerce") <+> pprParendIfaceType ty
- ppr IfaceInlineCall = ptext SLIT("__inline_call")
ppr IfaceInlineMe = ptext SLIT("__inline_me")
ppr (IfaceCoreNote s) = ptext SLIT("__core_note") <+> pprHsString (mkFastString s)
(sel_tyvars, rho_ty) = splitForAllTys (idType sel_id)
op_ty = funResultTy rho_ty
- toIfaceFD (tvs1, tvs2) = (map getOccName tvs1, map getOccName tvs2)
+ toIfaceFD (tvs1, tvs2) = (map (occNameFS.getOccName) tvs1, map (occNameFS.getOccName) tvs2)
tyThingToIfaceDecl ext (ATyCon tycon)
| isSynTyCon tycon
toIfaceExpr ext (Type ty) = IfaceType (toIfaceType ext ty)
toIfaceExpr ext (Lam x b) = IfaceLam (toIfaceBndr ext x) (toIfaceExpr ext b)
toIfaceExpr ext (App f a) = toIfaceApp ext f [a]
-toIfaceExpr ext (Case s x ty as) = IfaceCase (toIfaceExpr ext s) (getOccName x) (toIfaceType ext ty) (map (toIfaceAlt ext) as)
+toIfaceExpr ext (Case s x ty as) = IfaceCase (toIfaceExpr ext s) (occNameFS (getOccName x)) (toIfaceType ext ty) (map (toIfaceAlt ext) as)
toIfaceExpr ext (Let b e) = IfaceLet (toIfaceBind ext b) (toIfaceExpr ext e)
toIfaceExpr ext (Note n e) = IfaceNote (toIfaceNote ext n) (toIfaceExpr ext e)
---------------------
toIfaceNote ext (SCC cc) = IfaceSCC cc
toIfaceNote ext (Coerce t1 _) = IfaceCoerce (toIfaceType ext t1)
-toIfaceNote ext InlineCall = IfaceInlineCall
toIfaceNote ext InlineMe = IfaceInlineMe
toIfaceNote ext (CoreNote s) = IfaceCoreNote s
toIfaceBind ext (Rec prs) = IfaceRec [(toIfaceIdBndr ext b, toIfaceExpr ext r) | (b,r) <- prs]
---------------------
-toIfaceAlt ext (c,bs,r) = (toIfaceCon c, map getOccName bs, toIfaceExpr ext r)
+toIfaceAlt ext (c,bs,r) = (toIfaceCon c, map (occNameFS.getOccName) bs, toIfaceExpr ext r)
---------------------
toIfaceCon (DataAlt dc) | isTupleTyCon tc = IfaceTupleAlt (tupleTyConBoxity tc)
| Just fcall <- isFCallId_maybe v = IfaceFCall fcall (toIfaceType ext (idType v))
-- Foreign calls have special syntax
| isExternalName name = IfaceExt (ext name)
- | otherwise = IfaceLcl (nameOccName name)
+ | otherwise = IfaceLcl (occNameFS (nameOccName name))
where
name = idName v
\end{code}
eqWith = eq_ifTvBndrs emptyEqEnv
-----------------------
-eqIfInst d1 d2 = bool (ifDFun d1 == ifDFun d2)
+eqIfInst d1 d2 = bool (ifDFun d1 == ifDFun d2 && ifOFlag d1 == ifOFlag d2)
-- All other changes are handled via the version info on the dfun
eqIfRule (IfaceRule n1 a1 bs1 f1 es1 rhs1 o1)
eq_ifaceNote :: EqEnv -> IfaceNote -> IfaceNote -> IfaceEq
eq_ifaceNote env (IfaceSCC c1) (IfaceSCC c2) = bool (c1==c2)
eq_ifaceNote env (IfaceCoerce t1) (IfaceCoerce t2) = eq_ifType env t1 t2
-eq_ifaceNote env IfaceInlineCall IfaceInlineCall = Equal
eq_ifaceNote env IfaceInlineMe IfaceInlineMe = Equal
eq_ifaceNote env (IfaceCoreNote s1) (IfaceCoreNote s2) = bool (s1==s2)
eq_ifaceNote env _ _ = NotEqual
\begin{code}
------------------------------------
-type EqEnv = OccEnv OccName -- Tracks the mapping from L-variables to R-variables
+type EqEnv = UniqFM FastString -- Tracks the mapping from L-variables to R-variables
-eqIfOcc :: EqEnv -> OccName -> OccName -> IfaceEq
-eqIfOcc env n1 n2 = case lookupOccEnv env n1 of
+eqIfOcc :: EqEnv -> FastString -> FastString -> IfaceEq
+eqIfOcc env n1 n2 = case lookupUFM env n1 of
Just n1 -> bool (n1 == n2)
Nothing -> bool (n1 == n2)
-extendEqEnv :: EqEnv -> OccName -> OccName -> EqEnv
+extendEqEnv :: EqEnv -> FastString -> FastString -> EqEnv
extendEqEnv env n1 n2 | n1 == n2 = env
- | otherwise = extendOccEnv env n1 n2
+ | otherwise = addToUFM env n1 n2
emptyEqEnv :: EqEnv
-emptyEqEnv = emptyOccEnv
+emptyEqEnv = emptyUFM
------------------------------------
type ExtEnv bndr = EqEnv -> bndr -> bndr -> (EqEnv -> IfaceEq) -> IfaceEq
-eq_ifNakedBndr :: ExtEnv OccName
+eq_ifNakedBndr :: ExtEnv FastString
eq_ifBndr :: ExtEnv IfaceBndr
eq_ifTvBndr :: ExtEnv IfaceTvBndr
eq_ifIdBndr :: ExtEnv IfaceIdBndr
eq_ifBndrs :: ExtEnv [IfaceBndr]
eq_ifIdBndrs :: ExtEnv [IfaceIdBndr]
eq_ifTvBndrs :: ExtEnv [IfaceTvBndr]
-eq_ifNakedBndrs :: ExtEnv [OccName]
+eq_ifNakedBndrs :: ExtEnv [FastString]
eq_ifBndrs = eq_bndrs_with eq_ifBndr
eq_ifIdBndrs = eq_bndrs_with eq_ifIdBndr
eq_ifTvBndrs = eq_bndrs_with eq_ifTvBndr