From a73d6d950f6599d35f1e0aeb80d30112816a6928 Mon Sep 17 00:00:00 2001 From: Simon Marlow Date: Mon, 24 Jul 2006 15:48:26 +0000 Subject: [PATCH] In interface files, store FastStrings rather than OccNames where possible In all cases the namespace is known from the context, so this saves 1 byte per variable binding/occurrence (a few percent per iface file). --- compiler/iface/IfaceEnv.lhs | 20 +++++++++-------- compiler/iface/IfaceSyn.lhs | 36 +++++++++++++++---------------- compiler/iface/IfaceType.lhs | 18 ++++++++-------- compiler/iface/TcIface.lhs | 44 ++++++++++++++++++++------------------ compiler/parser/ParserCore.y | 20 ++++++++--------- compiler/typecheck/TcRnTypes.lhs | 6 +++--- 6 files changed, 74 insertions(+), 70 deletions(-) diff --git a/compiler/iface/IfaceEnv.lhs b/compiler/iface/IfaceEnv.lhs index 3c1db55..0f65c8f 100644 --- a/compiler/iface/IfaceEnv.lhs +++ b/compiler/iface/IfaceEnv.lhs @@ -33,11 +33,13 @@ import Name ( Name, nameUnique, nameModule, isWiredInName, mkIPName, mkExternalName, mkInternalName ) import NameSet ( NameSet, emptyNameSet, addListToNameSet ) -import OccName ( OccName, isTupleOcc_maybe, tcName, dataName, mapOccEnv, +import OccName ( OccName, isTupleOcc_maybe, tcName, dataName, mapOccEnv, occNameFS, lookupOccEnv, unitOccEnv, extendOccEnv, extendOccEnvList ) import PrelNames ( gHC_PRIM, pREL_TUP ) import Module ( Module, emptyModuleEnv, lookupModuleEnv, extendModuleEnv_C ) +import UniqFM ( lookupUFM, addListToUFM ) +import FastString ( FastString ) import UniqSupply ( UniqSupply, splitUniqSupply, uniqFromSupply, uniqsFromSupply ) import FiniteMap ( emptyFM, lookupFM, addToFM ) import BasicTypes ( IPName(..), mapIPName ) @@ -285,10 +287,10 @@ initOrigNames names = foldl extendOrigNameCache emptyModuleEnv names %************************************************************************ \begin{code} -tcIfaceLclId :: OccName -> IfL Id +tcIfaceLclId :: FastString -> IfL Id tcIfaceLclId occ = do { lcl <- getLclEnv - ; case (lookupOccEnv (if_id_env lcl) occ) of + ; case (lookupUFM (if_id_env lcl) occ) of Just ty_var -> return ty_var Nothing -> failIfM (text "Iface id out of scope: " <+> ppr occ) } @@ -304,15 +306,15 @@ refineIfaceIdEnv (tv_subst, _) thing_inside extendIfaceIdEnv :: [Id] -> IfL a -> IfL a extendIfaceIdEnv ids thing_inside = do { env <- getLclEnv - ; let { id_env' = extendOccEnvList (if_id_env env) pairs - ; pairs = [(getOccName id, id) | id <- ids] } + ; let { id_env' = addListToUFM (if_id_env env) pairs + ; pairs = [(occNameFS (getOccName id), id) | id <- ids] } ; setLclEnv (env { if_id_env = id_env' }) thing_inside } -tcIfaceTyVar :: OccName -> IfL TyVar +tcIfaceTyVar :: FastString -> IfL TyVar tcIfaceTyVar occ = do { lcl <- getLclEnv - ; case (lookupOccEnv (if_tv_env lcl) occ) of + ; case (lookupUFM (if_tv_env lcl) occ) of Just ty_var -> return ty_var Nothing -> failIfM (text "Iface type variable out of scope: " <+> ppr occ) } @@ -320,8 +322,8 @@ tcIfaceTyVar occ extendIfaceTyVarEnv :: [TyVar] -> IfL a -> IfL a extendIfaceTyVarEnv tyvars thing_inside = do { env <- getLclEnv - ; let { tv_env' = extendOccEnvList (if_tv_env env) pairs - ; pairs = [(getOccName tv, tv) | tv <- tyvars] } + ; let { tv_env' = addListToUFM (if_tv_env env) pairs + ; pairs = [(occNameFS (getOccName tv), tv) | tv <- tyvars] } ; setLclEnv (env { if_tv_env = tv_env' }) thing_inside } \end{code} diff --git a/compiler/iface/IfaceSyn.lhs b/compiler/iface/IfaceSyn.lhs index 2702181..4563714 100644 --- a/compiler/iface/IfaceSyn.lhs +++ b/compiler/iface/IfaceSyn.lhs @@ -56,9 +56,9 @@ import TyCon ( TyCon, ArgVrcs, AlgTyConRhs(..), isRecursiveTyCon, isForeignTyCo 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 ) @@ -109,7 +109,7 @@ data IfaceDecl | 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 ... @@ -201,13 +201,13 @@ data IfaceInfoItem -------------------------------- 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 @@ -218,7 +218,7 @@ data IfaceNote = IfaceSCC CostCentre | 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 @@ -481,7 +481,7 @@ tyThingToIfaceDecl ext (AClass clas) (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 @@ -652,7 +652,7 @@ toIfaceExpr ext (Lit l) = IfaceLit l 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) @@ -667,7 +667,7 @@ toIfaceBind ext (NonRec b r) = IfaceNonRec (toIfaceIdBndr ext b) (toIfaceExpr ex 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) @@ -703,7 +703,7 @@ toIfaceVar ext v | 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} @@ -949,24 +949,24 @@ eqIfTc _ _ = 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 @@ -983,7 +983,7 @@ eq_ifIdBndr env (v1, t1) (v2, t2) k = eq_ifType env t1 t2 &&& k (extendEqEnv env 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 diff --git a/compiler/iface/IfaceType.lhs b/compiler/iface/IfaceType.lhs index 76438dd..bf0f383 100644 --- a/compiler/iface/IfaceType.lhs +++ b/compiler/iface/IfaceType.lhs @@ -31,7 +31,7 @@ import TypeRep ( TyThing(..), Type(..), PredType(..), ThetaType ) import TyCon ( TyCon, isTupleTyCon, tyConArity, tupleTyConBoxity, tyConName ) import Var ( isId, tyVarKind, idType ) import TysWiredIn ( listTyConName, parrTyConName, tupleTyCon, intTyConName, charTyConName, boolTyConName ) -import OccName ( OccName, parenSymOcc ) +import OccName ( OccName, parenSymOcc, occNameFS ) import Name ( Name, getName, getOccName, nameModule, nameOccName, wiredInNameTyThing_maybe ) import Module ( Module ) @@ -98,17 +98,17 @@ interactiveExtNameFun print_unqual name \begin{code} data IfaceBndr -- Local (non-top-level) binders - = IfaceIdBndr IfaceIdBndr - | IfaceTvBndr IfaceTvBndr + = IfaceIdBndr {-# UNPACK #-} !IfaceIdBndr + | IfaceTvBndr {-# UNPACK #-} !IfaceTvBndr -type IfaceIdBndr = (OccName, IfaceType) -- OccName, because always local -type IfaceTvBndr = (OccName, IfaceKind) +type IfaceIdBndr = (FastString, IfaceType) +type IfaceTvBndr = (FastString, IfaceKind) ------------------------------- type IfaceKind = Kind -- Re-use the Kind type, but no KindVars in it data IfaceType - = IfaceTyVar OccName -- Type variable only, not tycon + = IfaceTyVar FastString -- Type variable only, not tycon | IfaceAppTy IfaceType IfaceType | IfaceForAllTy IfaceTvBndr IfaceType | IfacePredTy IfacePredType @@ -327,8 +327,8 @@ pabrackets p = ptext SLIT("[:") <> p <> ptext SLIT(":]") \begin{code} ---------------- -toIfaceTvBndr tyvar = (getOccName tyvar, tyVarKind tyvar) -toIfaceIdBndr ext id = (getOccName id, toIfaceType ext (idType id)) +toIfaceTvBndr tyvar = (occNameFS (getOccName tyvar), tyVarKind tyvar) +toIfaceIdBndr ext id = (occNameFS (getOccName id), toIfaceType ext (idType id)) toIfaceTvBndrs tyvars = map toIfaceTvBndr tyvars toIfaceBndr ext var @@ -338,7 +338,7 @@ toIfaceBndr ext var --------------------- toIfaceType :: (Name -> IfaceExtName) -> Type -> IfaceType -- Synonyms are retained in the interface type -toIfaceType ext (TyVarTy tv) = IfaceTyVar (getOccName tv) +toIfaceType ext (TyVarTy tv) = IfaceTyVar (occNameFS (getOccName tv)) toIfaceType ext (AppTy t1 t2) = IfaceAppTy (toIfaceType ext t1) (toIfaceType ext t2) toIfaceType ext (FunTy t1 t2) = IfaceFunTy (toIfaceType ext t1) (toIfaceType ext t2) toIfaceType ext (TyConApp tc tys) = IfaceTyConApp (toIfaceTyCon ext tc) (toIfaceTypes ext tys) diff --git a/compiler/iface/TcIface.lhs b/compiler/iface/TcIface.lhs index 7c4c535..0b4df33 100644 --- a/compiler/iface/TcIface.lhs +++ b/compiler/iface/TcIface.lhs @@ -51,14 +51,15 @@ import Var ( TyVar, mkTyVar, tyVarKind ) import Name ( Name, nameModule, nameIsLocalOrFrom, isWiredInName, wiredInNameTyThing_maybe, nameParent ) import NameEnv -import OccName ( OccName ) +import OccName ( OccName, mkVarOccFS, mkTyVarOcc ) +import FastString ( FastString ) import Module ( Module, lookupModuleEnv ) import UniqSupply ( initUs_ ) import Outputable import ErrUtils ( Message ) import Maybes ( MaybeErr(..) ) import SrcLoc ( noSrcLoc ) -import Util ( zipWithEqual, dropList, equalLength ) +import Util ( zipWithEqual, equalLength, splitAtList ) import DynFlags ( DynFlag(..), isOneShot ) \end{code} @@ -603,7 +604,7 @@ tcIfaceExpr (IfaceApp fun arg) tcIfaceExpr (IfaceCase scrut case_bndr ty alts) = tcIfaceExpr scrut `thenM` \ scrut' -> - newIfaceName case_bndr `thenM` \ case_bndr_name -> + newIfaceName (mkVarOccFS case_bndr) `thenM` \ case_bndr_name -> let scrut_ty = exprType scrut' case_bndr' = mkLocalId case_bndr_name scrut_ty @@ -657,23 +658,24 @@ tcIfaceAlt _ (IfaceLitAlt lit, names, rhs) -- A case alternative is made quite a bit more complicated -- by the fact that we omit type annotations because we can -- work them out. True enough, but its not that easy! -tcIfaceAlt (tycon, inst_tys) (IfaceDataAlt data_occ, arg_occs, rhs) +tcIfaceAlt (tycon, inst_tys) (IfaceDataAlt data_occ, arg_strs, rhs) = do { let tycon_mod = nameModule (tyConName tycon) ; con <- tcIfaceDataCon (ExtPkg tycon_mod data_occ) ; ASSERT2( con `elem` tyConDataCons tycon, ppr con $$ ppr tycon $$ ppr (tyConDataCons tycon) ) if isVanillaDataCon con then - tcVanillaAlt con inst_tys arg_occs rhs + tcVanillaAlt con inst_tys arg_strs rhs else do { -- General case - arg_names <- newIfaceNames arg_occs + let (tyvar_strs, id_strs) = splitAtList (dataConTyVars con) arg_strs + ; tyvar_names <- mapM (newIfaceName . mkTyVarOcc) tyvar_strs + ; id_names <- mapM (newIfaceName . mkVarOccFS) id_strs ; let tyvars = [ mkTyVar name (tyVarKind tv) - | (name,tv) <- arg_names `zip` dataConTyVars con] + | (name,tv) <- tyvar_names `zip` dataConTyVars con ] arg_tys = dataConInstArgTys con (mkTyVarTys tyvars) - id_names = dropList tyvars arg_names arg_ids = ASSERT2( equalLength id_names arg_tys, - ppr (con, arg_names, rhs) $$ ppr tyvars $$ ppr arg_tys ) + ppr (con, tyvar_names++id_names, rhs) $$ ppr tyvars $$ ppr arg_tys ) zipWith mkLocalId id_names arg_tys Just refine = coreRefineTys con tyvars (mkTyConApp tycon inst_tys) @@ -694,11 +696,11 @@ tcIfaceAlt (tycon, inst_tys) (IfaceTupleAlt boxity, arg_occs, rhs) do { let [data_con] = tyConDataCons tycon ; tcVanillaAlt data_con inst_tys arg_occs rhs } -tcVanillaAlt data_con inst_tys arg_occs rhs - = do { arg_names <- newIfaceNames arg_occs +tcVanillaAlt data_con inst_tys arg_strs rhs + = do { arg_names <- newIfaceNames (map mkVarOccFS arg_strs) ; let arg_tys = dataConInstArgTys data_con inst_tys ; let arg_ids = ASSERT2( equalLength arg_names arg_tys, - ppr data_con <+> ppr inst_tys <+> ppr arg_occs $$ ppr rhs ) + ppr data_con <+> ppr inst_tys <+> ppr arg_strs $$ ppr rhs ) zipWith mkLocalId arg_names arg_tys ; rhs' <- extendIfaceIdEnv arg_ids (tcIfaceExpr rhs) ; returnM (DataAlt data_con, arg_ids, rhs') } @@ -931,16 +933,16 @@ bindIfaceBndrs (b:bs) thing_inside thing_inside (b':bs') ----------------------- -bindIfaceId :: (OccName, IfaceType) -> (Id -> IfL a) -> IfL a +bindIfaceId :: IfaceIdBndr -> (Id -> IfL a) -> IfL a bindIfaceId (occ, ty) thing_inside - = do { name <- newIfaceName occ + = do { name <- newIfaceName (mkVarOccFS occ) ; ty' <- tcIfaceType ty ; let { id = mkLocalId name ty' } ; extendIfaceIdEnv [id] (thing_inside id) } -bindIfaceIds :: [(OccName, IfaceType)] -> ([Id] -> IfL a) -> IfL a +bindIfaceIds :: [IfaceIdBndr] -> ([Id] -> IfL a) -> IfL a bindIfaceIds bndrs thing_inside - = do { names <- newIfaceNames occs + = do { names <- newIfaceNames (map mkVarOccFS occs) ; tys' <- mappM tcIfaceType tys ; let { ids = zipWithEqual "tcCoreValBndr" mkLocalId names tys' } ; extendIfaceIdEnv ids (thing_inside ids) } @@ -949,23 +951,23 @@ bindIfaceIds bndrs thing_inside ----------------------- -newExtCoreBndr :: (OccName, IfaceType) -> IfL Id -newExtCoreBndr (occ, ty) +newExtCoreBndr :: IfaceIdBndr -> IfL Id +newExtCoreBndr (var, ty) = do { mod <- getIfModule - ; name <- newGlobalBinder mod occ Nothing noSrcLoc + ; name <- newGlobalBinder mod (mkVarOccFS var) Nothing noSrcLoc ; ty' <- tcIfaceType ty ; return (mkLocalId name ty') } ----------------------- bindIfaceTyVar :: IfaceTvBndr -> (TyVar -> IfL a) -> IfL a bindIfaceTyVar (occ,kind) thing_inside - = do { name <- newIfaceName occ + = do { name <- newIfaceName (mkTyVarOcc occ) ; let tyvar = mk_iface_tyvar name kind ; extendIfaceTyVarEnv [tyvar] (thing_inside tyvar) } bindIfaceTyVars :: [IfaceTvBndr] -> ([TyVar] -> IfL a) -> IfL a bindIfaceTyVars bndrs thing_inside - = do { names <- newIfaceNames occs + = do { names <- newIfaceNames (map mkTyVarOcc occs) ; let tyvars = zipWith mk_iface_tyvar names kinds ; extendIfaceTyVarEnv tyvars (thing_inside tyvars) } where diff --git a/compiler/parser/ParserCore.y b/compiler/parser/ParserCore.y index 4d2fc70..02a6c7b 100644 --- a/compiler/parser/ParserCore.y +++ b/compiler/parser/ParserCore.y @@ -168,7 +168,7 @@ vdef :: { (IfaceIdBndr, IfaceExpr) } -- same as the module being compiled, and Iface syntax only -- has OccNames in binding positions -qd_occ :: { OccName } +qd_occ :: { FastString } : var_occ { $1 } | d_occ { $1 } @@ -212,7 +212,7 @@ kind :: { IfaceKind } aexp :: { IfaceExpr } : var_occ { IfaceLcl $1 } - | modid '.' qd_occ { IfaceExt (ExtPkg $1 $3) } + | modid '.' qd_occ { IfaceExt (ExtPkg $1 (mkVarOccFS $3)) } | lit { IfaceLit $1 } | '(' exp ')' { $2 } @@ -260,11 +260,11 @@ lit :: { Literal } | '(' CHAR '::' aty ')' { MachChar $2 } | '(' STRING '::' aty ')' { MachStr (mkFastString $2) } -tv_occ :: { OccName } - : NAME { mkOccName tvName $1 } +tv_occ :: { FastString } + : NAME { mkFastString $1 } -var_occ :: { OccName } - : NAME { mkVarOcc $1 } +var_occ :: { FastString } + : NAME { mkFastString $1 } -- Type constructor @@ -278,8 +278,8 @@ d_pat_occ :: { OccName } -- Data constructor occurrence in an expression; -- use the varName because that's the worker Id -d_occ :: { OccName } - : CNAME { mkVarOcc $1 } +d_occ :: { FastString } + : CNAME { mkFastString $1 } { @@ -314,14 +314,14 @@ eqTc (IfaceTc (ExtPkg mod occ)) tycon -- are very limited (see the productions for 'ty', so the translation -- isn't hard toHsType :: IfaceType -> LHsType RdrName -toHsType (IfaceTyVar v) = noLoc $ HsTyVar (mkRdrUnqual v) +toHsType (IfaceTyVar v) = noLoc $ HsTyVar (mkRdrUnqual (mkTyVarOcc v)) toHsType (IfaceAppTy t1 t2) = noLoc $ HsAppTy (toHsType t1) (toHsType t2) toHsType (IfaceFunTy t1 t2) = noLoc $ HsFunTy (toHsType t1) (toHsType t2) toHsType (IfaceTyConApp (IfaceTc tc) ts) = foldl mkHsAppTy (noLoc $ HsTyVar (ifaceExtRdrName tc)) (map toHsType ts) toHsType (IfaceForAllTy tv t) = add_forall (toHsTvBndr tv) (toHsType t) toHsTvBndr :: IfaceTvBndr -> LHsTyVarBndr RdrName -toHsTvBndr (tv,k) = noLoc $ KindedTyVar (mkRdrUnqual tv) k +toHsTvBndr (tv,k) = noLoc $ KindedTyVar (mkRdrUnqual (mkTyVarOcc tv)) k ifaceExtRdrName :: IfaceExtName -> RdrName ifaceExtRdrName (ExtPkg mod occ) = mkOrig mod occ diff --git a/compiler/typecheck/TcRnTypes.lhs b/compiler/typecheck/TcRnTypes.lhs index f16e9a8..4ad1b0d 100644 --- a/compiler/typecheck/TcRnTypes.lhs +++ b/compiler/typecheck/TcRnTypes.lhs @@ -59,13 +59,13 @@ import RdrName ( GlobalRdrEnv, LocalRdrEnv ) import Name ( Name ) import NameEnv import NameSet ( NameSet, unionNameSets, DefUses ) -import OccName ( OccEnv ) import Var ( Id, TyVar ) import VarEnv ( TidyEnv ) import Module import SrcLoc ( SrcSpan, SrcLoc, Located, srcSpanStart ) import VarSet ( IdSet ) import ErrUtils ( Messages, Message ) +import UniqFM ( UniqFM ) import UniqSupply ( UniqSupply ) import BasicTypes ( IPName ) import Util ( thenCmp ) @@ -266,8 +266,8 @@ data IfLclEnv -- .hi file, or GHCi state, or ext core -- plus which bit is currently being examined - if_tv_env :: OccEnv TyVar, -- Nested tyvar bindings - if_id_env :: OccEnv Id -- Nested id binding + if_tv_env :: UniqFM TyVar, -- Nested tyvar bindings + if_id_env :: UniqFM Id -- Nested id binding } \end{code} -- 1.7.10.4