From 73c0472d57af773f9920bf27547211d5c8785943 Mon Sep 17 00:00:00 2001 From: simonpj Date: Fri, 27 Oct 2000 16:43:25 +0000 Subject: [PATCH] [project @ 2000-10-27 16:43:24 by simonpj] Wibble --- ghc/compiler/basicTypes/DataCon.lhs | 4 ++-- ghc/compiler/basicTypes/Module.lhs | 18 ++++++++++++++++-- ghc/compiler/basicTypes/Name.lhs | 4 ++-- ghc/compiler/main/HscTypes.lhs | 2 +- ghc/compiler/rename/ParseIface.y | 2 +- ghc/compiler/rename/RnIfaces.lhs | 5 +++-- ghc/compiler/specialise/Rules.lhs | 6 ++---- ghc/compiler/types/Class.lhs | 1 - ghc/compiler/types/PprType.lhs | 13 ++++--------- ghc/compiler/types/TyCon.lhs | 2 +- ghc/compiler/types/TypeRep.lhs | 2 +- 11 files changed, 33 insertions(+), 26 deletions(-) diff --git a/ghc/compiler/basicTypes/DataCon.lhs b/ghc/compiler/basicTypes/DataCon.lhs index 57293f0..39f4952 100644 --- a/ghc/compiler/basicTypes/DataCon.lhs +++ b/ghc/compiler/basicTypes/DataCon.lhs @@ -28,10 +28,10 @@ module DataCon ( import {-# SOURCE #-} Subst( substTy, mkTyVarSubst ) import CmdLineOpts ( opt_DictsStrict ) -import Type ( Type, ThetaType, TauType, ClassContext, +import Type ( Type, TauType, ClassContext, mkForAllTys, mkFunTys, mkTyConApp, mkTyVarTys, mkDictTys, - splitTyConApp_maybe, classesToPreds + splitTyConApp_maybe ) import TyCon ( TyCon, tyConDataCons, tyConDataConsIfAvailable, isDataTyCon, isProductTyCon, isTupleTyCon, isUnboxedTupleTyCon, isRecursiveTyCon ) diff --git a/ghc/compiler/basicTypes/Module.lhs b/ghc/compiler/basicTypes/Module.lhs index fa073be..276a0e4 100644 --- a/ghc/compiler/basicTypes/Module.lhs +++ b/ghc/compiler/basicTypes/Module.lhs @@ -24,7 +24,8 @@ module Module Module, moduleName -- abstract, instance of Eq, Ord, Outputable , ModuleName - , isModuleInThisPackage, mkModuleInThisPackage + , isModuleInThisPackage, mkModuleInThisPackage, + , printModulePrefix , moduleNameString -- :: ModuleName -> EncodedString , moduleNameUserString -- :: ModuleName -> UserString @@ -98,6 +99,12 @@ data PackageInfo -- as the one being compiled | AnotherPackage PackageName -- A module from a different package + | DunnoYet -- This is used when we don't yet know + -- Main case: we've come across Foo.x in an interface file + -- but we havn't yet opened Foo.hi. We need a Name for Foo.x + -- Later on (in RnEnv.newTopBinder) we'll update the cache + -- to have the right PackageInfo + type PackageName = FastString -- No encoding at all preludePackage :: PackageName @@ -106,6 +113,7 @@ preludePackage = SLIT("std") instance Outputable PackageInfo where -- Just used in debug prints of lex tokens and in debug modde ppr ThisPackage = ptext SLIT("") + ppr DunnoYet = ptext SLIT("") ppr (AnotherPackage p) = ptext p \end{code} @@ -235,7 +243,7 @@ mkHomeModule mod_nm = Module mod_nm ThisPackage -- file, but before we've opened Foo.hi. -- (Until we've opened Foo.hi we don't know what the PackageInfo is.) mkVanillaModule :: ModuleName -> Module -mkVanillaModule name = mkModule name (panic "mkVanillaModule:unknown mod_kind field") +mkVanillaModule name = Module name DunnoYet mkPrelModule :: ModuleName -> Module mkPrelModule name = mkModule name preludePackage @@ -252,8 +260,14 @@ moduleUserString (Module mod _) = moduleNameUserString mod isModuleInThisPackage :: Module -> Bool isModuleInThisPackage (Module nm ThisPackage) = True isModuleInThisPackage _ = False + +printModulePrefix :: Module -> Bool + -- When printing, say M.x +printModulePrefix (Module nm ThisPackage) = False +printModulePrefix _ = True \end{code} + %************************************************************************ %* * \subsection{@ModuleEnv@s} diff --git a/ghc/compiler/basicTypes/Name.lhs b/ghc/compiler/basicTypes/Name.lhs index 130dc90..2eeb949 100644 --- a/ghc/compiler/basicTypes/Name.lhs +++ b/ghc/compiler/basicTypes/Name.lhs @@ -42,7 +42,7 @@ module Name ( import OccName -- All of it import Module ( Module, moduleName, mkVanillaModule, - isModuleInThisPackage ) + printModulePrefix, isModuleInThisPackage ) import RdrName ( RdrName, mkRdrQual, mkRdrUnqual, rdrNameOcc, rdrNameModule ) import CmdLineOpts ( opt_Static, opt_PprStyle_NoPrags, @@ -446,7 +446,7 @@ pprName (Name {n_sort = sort, n_uniq = uniq, n_occ = occ}) global m | codeStyle sty = ppr (moduleName m) <> char '_' <> pprOccName occ - | debugStyle sty || not (isModuleInThisPackage m) + | debugStyle sty || printModulePrefix m = ppr (moduleName m) <> dot <> pprOccName occ | otherwise = pprOccName occ diff --git a/ghc/compiler/main/HscTypes.lhs b/ghc/compiler/main/HscTypes.lhs index ec776c7..752f2e4 100644 --- a/ghc/compiler/main/HscTypes.lhs +++ b/ghc/compiler/main/HscTypes.lhs @@ -65,7 +65,7 @@ import HsSyn ( DeprecTxt ) import RdrHsSyn ( RdrNameHsDecl, RdrNameTyClDecl ) import RnHsSyn ( RenamedTyClDecl, RenamedRuleDecl, RenamedInstDecl ) -import CoreSyn ( CoreRule, IdCoreRule ) +import CoreSyn ( IdCoreRule ) import Type ( Type ) import FiniteMap ( FiniteMap, emptyFM, addToFM, lookupFM, foldFM ) diff --git a/ghc/compiler/rename/ParseIface.y b/ghc/compiler/rename/ParseIface.y index 0aff924..feed79f 100644 --- a/ghc/compiler/rename/ParseIface.y +++ b/ghc/compiler/rename/ParseIface.y @@ -257,7 +257,7 @@ is_boot : { False } whats_imported :: { WhatsImported OccName } whats_imported : { NothingAtAll } | '::' version { Everything $2 } - | '::' version version name_version_pairs version { Specifically $2 (Just $3) $4 $5 } + | '::' version version version name_version_pairs { Specifically $2 (Just $3) $5 $4 } name_version_pairs :: { [(OccName, Version)] } name_version_pairs : { [] } diff --git a/ghc/compiler/rename/RnIfaces.lhs b/ghc/compiler/rename/RnIfaces.lhs index a56da3b..7d85e22 100644 --- a/ghc/compiler/rename/RnIfaces.lhs +++ b/ghc/compiler/rename/RnIfaces.lhs @@ -40,7 +40,7 @@ import Name ( Name {-instance NamedThing-}, nameOccName, NamedThing(..), elemNameEnv ) -import Module ( Module, ModuleEnv, +import Module ( Module, ModuleEnv, mkVanillaModule, moduleName, isModuleInThisPackage, ModuleName, WhereFrom(..), emptyModuleEnv, lookupModuleEnvByName, @@ -79,7 +79,8 @@ getInterfaceExports mod_name from Just mi -> returnRn (mi_module mi, mi_exports mi) ; -- loadInterface always puts something in the map -- even if it's a fake - Nothing -> pprPanic "getInterfaceExports" (ppr mod_name) + Nothing -> returnRn (mkVanillaModule mod_name, []) + -- pprPanic "getInterfaceExports" (ppr mod_name) } where doc_str = sep [ppr mod_name, ptext SLIT("is directly imported")] diff --git a/ghc/compiler/specialise/Rules.lhs b/ghc/compiler/specialise/Rules.lhs index 1f5e74e..760cd79 100644 --- a/ghc/compiler/specialise/Rules.lhs +++ b/ghc/compiler/specialise/Rules.lhs @@ -25,10 +25,8 @@ import Subst ( Subst, InScopeSet, mkInScopeSet, lookupSubst, extendSubst, substEnv, setSubstEnv, emptySubst, isInScope, bindSubstList, unBindSubstList, substInScope, uniqAway ) -import Id ( Id, idUnfolding, zapLamIdInfo, - idSpecialisation, setIdSpecialisation - ) -import Var ( isTyVar, isId ) +import Id ( Id, idUnfolding, idSpecialisation, setIdSpecialisation ) +import Var ( isId ) import VarSet import VarEnv import Type ( mkTyVarTy ) diff --git a/ghc/compiler/types/Class.lhs b/ghc/compiler/types/Class.lhs index d7d8146..3553763 100644 --- a/ghc/compiler/types/Class.lhs +++ b/ghc/compiler/types/Class.lhs @@ -23,7 +23,6 @@ import Name ( NamedThing(..), Name ) import BasicTypes ( Arity ) import Unique ( Unique, Uniquable(..) ) import Outputable -import Util \end{code} %************************************************************************ diff --git a/ghc/compiler/types/PprType.lhs b/ghc/compiler/types/PprType.lhs index 7b7b55a..fbd55bf 100644 --- a/ghc/compiler/types/PprType.lhs +++ b/ghc/compiler/types/PprType.lhs @@ -27,18 +27,16 @@ import Type ( PredType(..), ThetaType, isDictTy, splitTyConApp_maybe, splitFunTy_maybe, splitUsForAllTys, predRepTy ) -import Var ( TyVar, tyVarKind, - tyVarName, setTyVarName - ) +import Var ( TyVar, tyVarKind ) import TyCon ( TyCon, isPrimTyCon, isTupleTyCon, isUnboxedTupleTyCon, maybeTyConSingleCon, isEnumerationTyCon, - tyConArity, tyConUnique + tyConArity ) -import Class ( Class, className ) +import Class ( Class ) -- others: import Maybes ( maybeToBool ) -import Name ( getOccString, NamedThing(..) ) +import Name ( getOccString ) import Outputable import PprEnv import Unique ( Uniquable(..) ) @@ -217,9 +215,6 @@ ppr_ty env ctxt_prec (NoteTy (UsgNote u) ty) ppr_ty env ctxt_prec (PredTy p) = braces (ppr_pred env p) -ppr_theta env [] = empty -ppr_theta env theta = braces (hsep (punctuate comma (map (ppr_pred env) theta))) - ppr_pred env (Class clas tys) = ppr clas <+> hsep (map (ppr_ty env tYCON_PREC) tys) ppr_pred env (IParam n ty) = hsep [char '?' <> ppr n, text "::", diff --git a/ghc/compiler/types/TyCon.lhs b/ghc/compiler/types/TyCon.lhs index c4cbcd5..624c9c7 100644 --- a/ghc/compiler/types/TyCon.lhs +++ b/ghc/compiler/types/TyCon.lhs @@ -57,7 +57,7 @@ import {-# SOURCE #-} DataCon ( DataCon, isExistentialDataCon ) import Class ( Class, ClassContext ) import Var ( TyVar, Id ) -import BasicTypes ( Arity, NewOrData(..), RecFlag(..), Boxity(..), +import BasicTypes ( Arity, RecFlag(..), Boxity(..), isBoxed, EP(..) ) import Name ( Name, nameUnique, NamedThing(getName) ) import PrelNames ( Unique, Uniquable(..), anyBoxConKey ) diff --git a/ghc/compiler/types/TypeRep.lhs b/ghc/compiler/types/TypeRep.lhs index f9643dc..400ae46 100644 --- a/ghc/compiler/types/TypeRep.lhs +++ b/ghc/compiler/types/TypeRep.lhs @@ -28,7 +28,7 @@ import VarEnv import VarSet import Name ( Name, mkGlobalName, mkKindOccFS, tcName ) -import OccName ( mkOccFS, tcName ) +import OccName ( tcName ) import TyCon ( TyCon, KindCon, mkFunTyCon, mkKindCon, mkSuperKindCon, ) -- 1.7.10.4