diff options
| -rw-r--r-- | compiler/basicTypes/Name.hs | 4 | ||||
| -rw-r--r-- | compiler/iface/MkIface.hs | 17 |
2 files changed, 10 insertions, 11 deletions
diff --git a/compiler/basicTypes/Name.hs b/compiler/basicTypes/Name.hs index 74eec8aa14..eb820d4670 100644 --- a/compiler/basicTypes/Name.hs +++ b/compiler/basicTypes/Name.hs @@ -68,7 +68,7 @@ module Name ( -- * Class 'NamedThing' and overloaded friends NamedThing(..), - getSrcLoc, getSrcSpan, getOccString, + getSrcLoc, getSrcSpan, getOccString, getOccFS, pprInfixName, pprPrefixName, pprModulePrefix, nameStableString, @@ -633,10 +633,12 @@ class NamedThing a where getSrcLoc :: NamedThing a => a -> SrcLoc getSrcSpan :: NamedThing a => a -> SrcSpan getOccString :: NamedThing a => a -> String +getOccFS :: NamedThing a => a -> FastString getSrcLoc = nameSrcLoc . getName getSrcSpan = nameSrcSpan . getName getOccString = occNameString . getOccName +getOccFS = occNameFS . getOccName pprInfixName :: (Outputable a, NamedThing a) => a -> SDoc -- See Outputable.pprPrefixVar, pprInfixVar; diff --git a/compiler/iface/MkIface.hs b/compiler/iface/MkIface.hs index 4bd5c3611f..6970b08aba 100644 --- a/compiler/iface/MkIface.hs +++ b/compiler/iface/MkIface.hs @@ -1427,7 +1427,7 @@ tyConToIfaceDecl env tycon if_binders = zipIfaceBinders tc_tyvars (tyConBinders tycon) if_res_kind = tidyToIfaceType tc_env1 (tyConResKind tycon) if_syn_type ty = tidyToIfaceType tc_env1 ty - if_res_var = getFS `fmap` tyConFamilyResVar_maybe tycon + if_res_var = getOccFS `fmap` tyConFamilyResVar_maybe tycon -- use these when you don't have tyConTyVars (degenerate_binders, degenerate_res_kind) @@ -1528,7 +1528,7 @@ classToIfaceDecl env clas ifFDs = map toIfaceFD clas_fds, ifATs = map toIfaceAT clas_ats, ifSigs = map toIfaceClassOp op_stuff, - ifMinDef = fmap getFS (classMinimalDef clas), + ifMinDef = fmap getOccFS (classMinimalDef clas), ifRec = boolToRecFlag (isRecursiveTyCon tycon) }) where (clas_tyvars, clas_fds, sc_theta, _, clas_ats, op_stuff) @@ -1562,8 +1562,8 @@ classToIfaceDecl env clas toDmSpec (_, VanillaDM) = VanillaDM toDmSpec (_, GenericDM dm_ty) = GenericDM (tidyToIfaceType env1 dm_ty) - toIfaceFD (tvs1, tvs2) = (map (getFS . tidyTyVar env1) tvs1, - map (getFS . tidyTyVar env1) tvs2) + toIfaceFD (tvs1, tvs2) = (map (getOccFS . tidyTyVar env1) tvs1, + map (getOccFS . tidyTyVar env1) tvs2) -------------------------- tidyToIfaceType :: TidyEnv -> Type -> IfaceType @@ -1590,9 +1590,6 @@ tidyTyVar :: TidyEnv -> TyVar -> TyVar tidyTyVar (_, subst) tv = lookupVarEnv subst tv `orElse` tv -- TcType.tidyTyVarOcc messes around with FlatSkols -getFS :: NamedThing a => a -> FastString -getFS x = occNameFS (getOccName x) - -------------------------- instanceToIfaceInst :: ClsInst -> IfaceClsInst instanceToIfaceInst (ClsInst { is_dfun = dfun_id, is_flag = oflag @@ -1768,7 +1765,7 @@ toIfaceExpr (Lam x b) = IfaceLam (toIfaceBndr x, toIfaceOneShot x) (toIfac toIfaceExpr (App f a) = toIfaceApp f [a] toIfaceExpr (Case s x ty as) | null as = IfaceECase (toIfaceExpr s) (toIfaceType ty) - | otherwise = IfaceCase (toIfaceExpr s) (getFS x) (map toIfaceAlt as) + | otherwise = IfaceCase (toIfaceExpr s) (getOccFS x) (map toIfaceAlt as) toIfaceExpr (Let b e) = IfaceLet (toIfaceBind b) (toIfaceExpr e) toIfaceExpr (Cast e co) = IfaceCast (toIfaceExpr e) (toIfaceCoercion co) toIfaceExpr (Tick t e) @@ -1799,7 +1796,7 @@ toIfaceBind (Rec prs) = IfaceRec [(toIfaceLetBndr b, toIfaceExpr r) | (b,r) < --------------------- toIfaceAlt :: (AltCon, [Var], CoreExpr) -> (IfaceConAlt, [FastString], IfaceExpr) -toIfaceAlt (c,bs,r) = (toIfaceCon c, map getFS bs, toIfaceExpr r) +toIfaceAlt (c,bs,r) = (toIfaceCon c, map getOccFS bs, toIfaceExpr r) --------------------- toIfaceCon :: AltCon -> IfaceConAlt @@ -1835,5 +1832,5 @@ toIfaceVar v | Just fcall <- isFCallId_maybe v = IfaceFCall fcall (toIfaceType (idType v)) -- Foreign calls have special syntax | isExternalName name = IfaceExt name - | otherwise = IfaceLcl (getFS name) + | otherwise = IfaceLcl (getOccFS name) where name = idName v |