From: sewardj Date: Mon, 23 Oct 2000 11:50:42 +0000 (+0000) Subject: [project @ 2000-10-23 11:50:40 by sewardj] X-Git-Tag: Approximately_9120_patches~3534 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=6c1d2ec4f8f08d77e39de6f79afa4143110901fa;p=ghc-hetmet.git [project @ 2000-10-23 11:50:40 by sewardj] Small cleanups. --- diff --git a/ghc/compiler/coreSyn/CoreLint.lhs b/ghc/compiler/coreSyn/CoreLint.lhs index f21f0e0..015e6a6 100644 --- a/ghc/compiler/coreSyn/CoreLint.lhs +++ b/ghc/compiler/coreSyn/CoreLint.lhs @@ -38,7 +38,7 @@ import Type ( Type, tyVarsOfType, isUnboxedTupleType, hasMoreBoxityInfo ) -import TyCon ( TyCon, isPrimTyCon, tyConDataCons ) +import TyCon ( isPrimTyCon ) import BasicTypes ( RecFlag(..), isNonRec ) import CmdLineOpts import Maybe diff --git a/ghc/compiler/main/Finder.lhs b/ghc/compiler/main/Finder.lhs index 19185bf..d0de38f 100644 --- a/ghc/compiler/main/Finder.lhs +++ b/ghc/compiler/main/Finder.lhs @@ -13,7 +13,7 @@ module Finder ( #include "HsVersions.h" -import HscTyes ( Finder, ModuleLocation(..) ) +import HscTypes ( Finder, ModuleLocation(..) ) import CmStaticInfo import DriverPhases import DriverState diff --git a/ghc/compiler/main/HscMain.lhs b/ghc/compiler/main/HscMain.lhs index 484ae8f..f308b8f 100644 --- a/ghc/compiler/main/HscMain.lhs +++ b/ghc/compiler/main/HscMain.lhs @@ -1,5 +1,5 @@ % -% (c) The GRASP/AQUA Project, Glasgow University, 1993-1998 +% (c) The GRASP/AQUA Project, Glasgow University, 1993-2000 % \section[GHC_Main]{Main driver for Glasgow Haskell compiler} @@ -41,13 +41,8 @@ import UniqSupply ( mkSplitUniqSupply ) import Outputable import Char ( isSpace ) -#if REPORT_TO_MOTHERLODE && __GLASGOW_HASKELL__ >= 303 -import SocketPrim -import BSD -import IOExts ( unsafePerformIO ) -import NativeInfo ( os, arch ) -#endif import StgInterp ( runStgI ) +import HscStats ( ppSourceStats ) \end{code} @@ -277,186 +272,3 @@ initOrigNames = grab knownKeyNames `plusFM` grab (map getName wiredInThings) grab names = foldl add emptyFM names add env name = addToFM env (moduleName (nameModule name), nameOccName name) name \end{code} - -%************************************************************************ -%* * -\subsection{Statistics} -%* * -%************************************************************************ - -\begin{code} -ppSourceStats short (HsModule name version exports imports decls _ src_loc) - = (if short then hcat else vcat) - (map pp_val - [("ExportAll ", export_all), -- 1 if no export list - ("ExportDecls ", export_ds), - ("ExportModules ", export_ms), - ("Imports ", import_no), - (" ImpQual ", import_qual), - (" ImpAs ", import_as), - (" ImpAll ", import_all), - (" ImpPartial ", import_partial), - (" ImpHiding ", import_hiding), - ("FixityDecls ", fixity_ds), - ("DefaultDecls ", default_ds), - ("TypeDecls ", type_ds), - ("DataDecls ", data_ds), - ("NewTypeDecls ", newt_ds), - ("DataConstrs ", data_constrs), - ("DataDerivings ", data_derivs), - ("ClassDecls ", class_ds), - ("ClassMethods ", class_method_ds), - ("DefaultMethods ", default_method_ds), - ("InstDecls ", inst_ds), - ("InstMethods ", inst_method_ds), - ("TypeSigs ", bind_tys), - ("ValBinds ", val_bind_ds), - ("FunBinds ", fn_bind_ds), - ("InlineMeths ", method_inlines), - ("InlineBinds ", bind_inlines), --- ("SpecialisedData ", data_specs), --- ("SpecialisedInsts ", inst_specs), - ("SpecialisedMeths ", method_specs), - ("SpecialisedBinds ", bind_specs) - ]) - where - pp_val (str, 0) = empty - pp_val (str, n) - | not short = hcat [text str, int n] - | otherwise = hcat [text (trim str), equals, int n, semi] - - trim ls = takeWhile (not.isSpace) (dropWhile isSpace ls) - - fixity_ds = length [() | FixD d <- decls] - -- NB: this omits fixity decls on local bindings and - -- in class decls. ToDo - - tycl_decls = [d | TyClD d <- decls] - (class_ds, data_ds, newt_ds, type_ds) = countTyClDecls tycl_decls - - inst_decls = [d | InstD d <- decls] - inst_ds = length inst_decls - default_ds = length [() | DefD _ <- decls] - val_decls = [d | ValD d <- decls] - - real_exports = case exports of { Nothing -> []; Just es -> es } - n_exports = length real_exports - export_ms = length [() | IEModuleContents _ <- real_exports] - export_ds = n_exports - export_ms - export_all = case exports of { Nothing -> 1; other -> 0 } - - (val_bind_ds, fn_bind_ds, bind_tys, bind_specs, bind_inlines) - = count_binds (foldr ThenBinds EmptyBinds val_decls) - - (import_no, import_qual, import_as, import_all, import_partial, import_hiding) - = foldr add6 (0,0,0,0,0,0) (map import_info imports) - (data_constrs, data_derivs) - = foldr add2 (0,0) (map data_info tycl_decls) - (class_method_ds, default_method_ds) - = foldr add2 (0,0) (map class_info tycl_decls) - (inst_method_ds, method_specs, method_inlines) - = foldr add3 (0,0,0) (map inst_info inst_decls) - - - count_binds EmptyBinds = (0,0,0,0,0) - count_binds (ThenBinds b1 b2) = count_binds b1 `add5` count_binds b2 - count_binds (MonoBind b sigs _) = case (count_monobinds b, count_sigs sigs) of - ((vs,fs),(ts,_,ss,is)) -> (vs,fs,ts,ss,is) - - count_monobinds EmptyMonoBinds = (0,0) - count_monobinds (AndMonoBinds b1 b2) = count_monobinds b1 `add2` count_monobinds b2 - count_monobinds (PatMonoBind (VarPatIn n) r _) = (1,0) - count_monobinds (PatMonoBind p r _) = (0,1) - count_monobinds (FunMonoBind f _ m _) = (0,1) - - count_sigs sigs = foldr add4 (0,0,0,0) (map sig_info sigs) - - sig_info (Sig _ _ _) = (1,0,0,0) - sig_info (ClassOpSig _ _ _ _) = (0,1,0,0) - sig_info (SpecSig _ _ _) = (0,0,1,0) - sig_info (InlineSig _ _ _) = (0,0,0,1) - sig_info (NoInlineSig _ _ _) = (0,0,0,1) - sig_info _ = (0,0,0,0) - - import_info (ImportDecl _ _ qual as spec _) - = add6 (1, qual_info qual, as_info as, 0,0,0) (spec_info spec) - qual_info False = 0 - qual_info True = 1 - as_info Nothing = 0 - as_info (Just _) = 1 - spec_info Nothing = (0,0,0,1,0,0) - spec_info (Just (False, _)) = (0,0,0,0,1,0) - spec_info (Just (True, _)) = (0,0,0,0,0,1) - - data_info (TyData _ _ _ _ _ nconstrs derivs _ _ _ _) - = (nconstrs, case derivs of {Nothing -> 0; Just ds -> length ds}) - data_info other = (0,0) - - class_info (ClassDecl _ _ _ _ meth_sigs def_meths _ _ _ ) - = case count_sigs meth_sigs of - (_,classops,_,_) -> - (classops, addpr (count_monobinds def_meths)) - class_info other = (0,0) - - inst_info (InstDecl _ inst_meths inst_sigs _ _) - = case count_sigs inst_sigs of - (_,_,ss,is) -> - (addpr (count_monobinds inst_meths), ss, is) - - addpr :: (Int,Int) -> Int - add1 :: Int -> Int -> Int - add2 :: (Int,Int) -> (Int,Int) -> (Int, Int) - add3 :: (Int,Int,Int) -> (Int,Int,Int) -> (Int, Int, Int) - add4 :: (Int,Int,Int,Int) -> (Int,Int,Int,Int) -> (Int, Int, Int, Int) - add5 :: (Int,Int,Int,Int,Int) -> (Int,Int,Int,Int,Int) -> (Int, Int, Int, Int, Int) - add6 :: (Int,Int,Int,Int,Int,Int) -> (Int,Int,Int,Int,Int,Int) -> (Int, Int, Int, Int, Int, Int) - - addpr (x,y) = x+y - add1 x1 y1 = x1+y1 - add2 (x1,x2) (y1,y2) = (x1+y1,x2+y2) - add3 (x1,x2,x3) (y1,y2,y3) = (x1+y1,x2+y2,x3+y3) - add4 (x1,x2,x3,x4) (y1,y2,y3,y4) = (x1+y1,x2+y2,x3+y3,x4+y4) - add5 (x1,x2,x3,x4,x5) (y1,y2,y3,y4,y5) = (x1+y1,x2+y2,x3+y3,x4+y4,x5+y5) - add6 (x1,x2,x3,x4,x5,x6) (y1,y2,y3,y4,y5,y6) = (x1+y1,x2+y2,x3+y3,x4+y4,x5+y5,x6+y6) -\end{code} - -\begin{code} -\end{code} - -\begin{code} -reportCompile :: ModuleName -> String -> IO () -#if REPORT_TO_MOTHERLODE && __GLASGOW_HASKELL__ >= 303 -reportCompile mod_name info - | not opt_ReportCompile = return () - | otherwise = (do - sock <- udpSocket 0 - addr <- motherShip - sendTo sock (moduleNameUserString mod_name ++ ';': compiler_version ++ - ';': os ++ ';':arch ++ '\n':' ':info ++ "\n") addr - return ()) `catch` (\ _ -> return ()) - -motherShip :: IO SockAddr -motherShip = do - he <- getHostByName "laysan.dcs.gla.ac.uk" - case (hostAddresses he) of - [] -> IOERROR (userError "No address!") - (x:_) -> return (SockAddrInet motherShipPort x) - ---magick -motherShipPort :: PortNumber -motherShipPort = mkPortNumber 12345 - --- creates a socket capable of sending datagrams, --- binding it to a port --- ( 0 => have the system pick next available port no.) -udpSocket :: Int -> IO Socket -udpSocket p = do - pr <- getProtocolNumber "udp" - s <- socket AF_INET Datagram pr - bindSocket s (SockAddrInet (mkPortNumber p) iNADDR_ANY) - return s -#else -reportCompile _ _ = return () -#endif - -\end{code} diff --git a/ghc/compiler/main/HscStats.lhs b/ghc/compiler/main/HscStats.lhs new file mode 100644 index 0000000..8d115ae --- /dev/null +++ b/ghc/compiler/main/HscStats.lhs @@ -0,0 +1,166 @@ +% +% (c) The GRASP/AQUA Project, Glasgow University, 1993-1998 +% +\section[GHC_Stats]{Statistics for per-module compilations} + +\begin{code} +module HscStats ( ppSourceStats ) where + +#include "HsVersions.h" + +import IO ( hPutStr, stderr ) +import HsSyn +import Outputable +import Char ( isSpace ) +\end{code} + +%************************************************************************ +%* * +\subsection{Statistics} +%* * +%************************************************************************ + +\begin{code} +ppSourceStats short (HsModule name version exports imports decls _ src_loc) + = (if short then hcat else vcat) + (map pp_val + [("ExportAll ", export_all), -- 1 if no export list + ("ExportDecls ", export_ds), + ("ExportModules ", export_ms), + ("Imports ", import_no), + (" ImpQual ", import_qual), + (" ImpAs ", import_as), + (" ImpAll ", import_all), + (" ImpPartial ", import_partial), + (" ImpHiding ", import_hiding), + ("FixityDecls ", fixity_ds), + ("DefaultDecls ", default_ds), + ("TypeDecls ", type_ds), + ("DataDecls ", data_ds), + ("NewTypeDecls ", newt_ds), + ("DataConstrs ", data_constrs), + ("DataDerivings ", data_derivs), + ("ClassDecls ", class_ds), + ("ClassMethods ", class_method_ds), + ("DefaultMethods ", default_method_ds), + ("InstDecls ", inst_ds), + ("InstMethods ", inst_method_ds), + ("TypeSigs ", bind_tys), + ("ValBinds ", val_bind_ds), + ("FunBinds ", fn_bind_ds), + ("InlineMeths ", method_inlines), + ("InlineBinds ", bind_inlines), +-- ("SpecialisedData ", data_specs), +-- ("SpecialisedInsts ", inst_specs), + ("SpecialisedMeths ", method_specs), + ("SpecialisedBinds ", bind_specs) + ]) + where + pp_val (str, 0) = empty + pp_val (str, n) + | not short = hcat [text str, int n] + | otherwise = hcat [text (trim str), equals, int n, semi] + + trim ls = takeWhile (not.isSpace) (dropWhile isSpace ls) + + fixity_ds = length [() | FixD d <- decls] + -- NB: this omits fixity decls on local bindings and + -- in class decls. ToDo + + tycl_decls = [d | TyClD d <- decls] + (class_ds, data_ds, newt_ds, type_ds) = countTyClDecls tycl_decls + + inst_decls = [d | InstD d <- decls] + inst_ds = length inst_decls + default_ds = length [() | DefD _ <- decls] + val_decls = [d | ValD d <- decls] + + real_exports = case exports of { Nothing -> []; Just es -> es } + n_exports = length real_exports + export_ms = length [() | IEModuleContents _ <- real_exports] + export_ds = n_exports - export_ms + export_all = case exports of { Nothing -> 1; other -> 0 } + + (val_bind_ds, fn_bind_ds, bind_tys, bind_specs, bind_inlines) + = count_binds (foldr ThenBinds EmptyBinds val_decls) + + (import_no, import_qual, import_as, import_all, import_partial, import_hiding) + = foldr add6 (0,0,0,0,0,0) (map import_info imports) + (data_constrs, data_derivs) + = foldr add2 (0,0) (map data_info tycl_decls) + (class_method_ds, default_method_ds) + = foldr add2 (0,0) (map class_info tycl_decls) + (inst_method_ds, method_specs, method_inlines) + = foldr add3 (0,0,0) (map inst_info inst_decls) + + + count_binds EmptyBinds = (0,0,0,0,0) + count_binds (ThenBinds b1 b2) = count_binds b1 `add5` count_binds b2 + count_binds (MonoBind b sigs _) = case (count_monobinds b, count_sigs sigs) of + ((vs,fs),(ts,_,ss,is)) -> (vs,fs,ts,ss,is) + + count_monobinds EmptyMonoBinds = (0,0) + count_monobinds (AndMonoBinds b1 b2) = count_monobinds b1 `add2` count_monobinds b2 + count_monobinds (PatMonoBind (VarPatIn n) r _) = (1,0) + count_monobinds (PatMonoBind p r _) = (0,1) + count_monobinds (FunMonoBind f _ m _) = (0,1) + + count_sigs sigs = foldr add4 (0,0,0,0) (map sig_info sigs) + + sig_info (Sig _ _ _) = (1,0,0,0) + sig_info (ClassOpSig _ _ _ _) = (0,1,0,0) + sig_info (SpecSig _ _ _) = (0,0,1,0) + sig_info (InlineSig _ _ _) = (0,0,0,1) + sig_info (NoInlineSig _ _ _) = (0,0,0,1) + sig_info _ = (0,0,0,0) + + import_info (ImportDecl _ _ qual as spec _) + = add6 (1, qual_info qual, as_info as, 0,0,0) (spec_info spec) + qual_info False = 0 + qual_info True = 1 + as_info Nothing = 0 + as_info (Just _) = 1 + spec_info Nothing = (0,0,0,1,0,0) + spec_info (Just (False, _)) = (0,0,0,0,1,0) + spec_info (Just (True, _)) = (0,0,0,0,0,1) + + data_info (TyData _ _ _ _ _ nconstrs derivs _ _ _ _) + = (nconstrs, case derivs of {Nothing -> 0; Just ds -> length ds}) + data_info other = (0,0) + + class_info (ClassDecl _ _ _ _ meth_sigs def_meths _ _ _ ) + = case count_sigs meth_sigs of + (_,classops,_,_) -> + (classops, addpr (count_monobinds def_meths)) + class_info other = (0,0) + + inst_info (InstDecl _ inst_meths inst_sigs _ _) + = case count_sigs inst_sigs of + (_,_,ss,is) -> + (addpr (count_monobinds inst_meths), ss, is) + + addpr :: (Int,Int) -> Int + add1 :: Int -> Int -> Int + add2 :: (Int,Int) -> (Int,Int) -> (Int, Int) + add3 :: (Int,Int,Int) -> (Int,Int,Int) -> (Int, Int, Int) + add4 :: (Int,Int,Int,Int) -> (Int,Int,Int,Int) -> (Int, Int, Int, Int) + add5 :: (Int,Int,Int,Int,Int) -> (Int,Int,Int,Int,Int) -> (Int, Int, Int, Int, Int) + add6 :: (Int,Int,Int,Int,Int,Int) -> (Int,Int,Int,Int,Int,Int) -> (Int, Int, Int, Int, Int, Int) + + addpr (x,y) = x+y + add1 x1 y1 = x1+y1 + add2 (x1,x2) (y1,y2) = (x1+y1,x2+y2) + add3 (x1,x2,x3) (y1,y2,y3) = (x1+y1,x2+y2,x3+y3) + add4 (x1,x2,x3,x4) (y1,y2,y3,y4) = (x1+y1,x2+y2,x3+y3,x4+y4) + add5 (x1,x2,x3,x4,x5) (y1,y2,y3,y4,y5) = (x1+y1,x2+y2,x3+y3,x4+y4,x5+y5) + add6 (x1,x2,x3,x4,x5,x6) (y1,y2,y3,y4,y5,y6) = (x1+y1,x2+y2,x3+y3,x4+y4,x5+y5,x6+y6) +\end{code} + + + + + + + + + diff --git a/ghc/compiler/rename/ParseIface.y b/ghc/compiler/rename/ParseIface.y index c83a0f8..b9cfc89 100644 --- a/ghc/compiler/rename/ParseIface.y +++ b/ghc/compiler/rename/ParseIface.y @@ -49,9 +49,9 @@ import IdInfo ( exactArity, InlinePragInfo(..) ) import PrimOp ( CCall(..), CCallTarget(..) ) import Lex -import RnMonad ( ParsedIface(..) ) +import RnMonad ( ParsedIface(..), ExportItem ) import HscTypes ( WhetherHasOrphans, IsBootInterface, GenAvailInfo(..), - ImportVersion, ExportItem, WhatsImported(..), + ImportVersion, WhatsImported(..), RdrAvailInfo ) import RdrName ( RdrName, mkRdrUnqual, mkSysQual, mkSysUnqual ) @@ -260,7 +260,7 @@ is_boot : { False } whats_imported :: { WhatsImported OccName } whats_imported : { NothingAtAll } | '::' version { Everything $2 } - | '::' version version version name_version_pairs { Specifically $2 $3 $4 $5 } + | '::' version version name_version_pairs version { Specifically $2 (Just $3) $4 $5 } name_version_pairs :: { [(OccName, Version)] } name_version_pairs : { [] } diff --git a/ghc/compiler/rename/RnIfaces.lhs b/ghc/compiler/rename/RnIfaces.lhs index e637ea6..05aa9c2 100644 --- a/ghc/compiler/rename/RnIfaces.lhs +++ b/ghc/compiler/rename/RnIfaces.lhs @@ -28,7 +28,7 @@ import HsSyn ( HsDecl(..), TyClDecl(..), InstDecl(..), IfaceSig(..), FixitySig(..), RuleDecl(..), isClassOpSig, DeprecDecl(..) ) -import HsImpExp ( ieNames ) +import HsImpExp ( ImportDecl(..), ieNames ) import CoreSyn ( CoreRule ) import BasicTypes ( Version, defaultFixity ) import RdrHsSyn ( RdrNameHsDecl, RdrNameInstDecl, RdrNameRuleDecl, @@ -44,10 +44,11 @@ import Name ( Name {-instance NamedThing-}, nameOccName, NamedThing(..), mkNameEnv, elemNameEnv, extendNameEnv ) -import Module ( Module, +import Module ( Module, ModuleEnv, moduleName, isModuleInThisPackage, ModuleName, WhereFrom(..), - extendModuleEnv, lookupModuleEnv, lookupModuleEnvByName + extendModuleEnv, lookupModuleEnv, lookupModuleEnvByName, + plusModuleEnv_C, lookupWithDefaultModuleEnv ) import RdrName ( RdrName, rdrNameOcc ) import NameSet @@ -64,7 +65,7 @@ import Outputable import Bag import HscTypes -import List ( nub ) +import List ( nub ) \end{code} @@ -175,10 +176,10 @@ tryLoadInterface doc_str mod_name from foldlRn (loadInstDecl mod) (iInsts ifaces) (pi_insts iface) `thenRn` \ new_insts -> loadExports (pi_exports iface) `thenRn` \ avails -> let - version = VersionInfo { modVers = pi_vers iface, + version = VersionInfo { vers_module = pi_vers iface, fixVers = fix_vers, - ruleVers = rule_vers, - declVers = decls_vers } + vers_rules = rule_vers, + vers_decls = decls_vers } -- For an explicit user import, add to mod_map info about -- the things the imported module depends on, extracted @@ -833,26 +834,24 @@ mkImportExportInfo this_mod export_avails exports so_far | not opened -- We didn't even open the interface - -> -- This happens when a module, Foo, that we explicitly imported has + = -- This happens when a module, Foo, that we explicitly imported has -- 'import Baz' in its interface file, recording that Baz is below -- Foo in the module dependency hierarchy. We want to propagate this -- information. The Nothing says that we didn't even open the interface - -- file but we must still propagate the dependeny info. + -- file but we must still propagate the dependency info. -- The module in question must be a local module (in the same package) go_for_it NothingAtAll | is_lib_module && not has_orphans - -> so_far + = so_far - | is_lib_module -- Record the module version only - -> go_for_it (Everything mod_vers) + | is_lib_module -- Record the module version only + = go_for_it (Everything vers_module) - | otherwise - -> go_for_it (mk_whats_imported mod mod_vers) + | otherwise + = go_for_it (mk_whats_imported mod vers_module) - where - where go_for_it exports = (mod_name, has_orphans, is_boot, exports) : so_far mod_iface = lookupIface hit pit mod_name @@ -868,8 +867,10 @@ mkImportExportInfo this_mod export_avails exports let v = lookupNameEnv version_env `orElse` pprPanic "mk_whats_imported" (ppr n) ] - export_vers | moduleName mod `elem` import_all_mods = Just (vers_exports version_info) - | otherwise = Nothing + export_vers | moduleName mod `elem` import_all_mods + = Just (vers_exports version_info) + | otherwise + = Nothing import_info = foldFM mk_imp_info [] mod_map diff --git a/ghc/compiler/rename/RnMonad.lhs b/ghc/compiler/rename/RnMonad.lhs index a86298c..4c0c519 100644 --- a/ghc/compiler/rename/RnMonad.lhs +++ b/ghc/compiler/rename/RnMonad.lhs @@ -43,7 +43,8 @@ import HscTypes ( Finder, DeclsMap, IfaceInsts, IfaceRules, HomeSymbolTable, PackageSymbolTable, PersistentCompilerState(..), GlobalRdrEnv, - HomeIfaceTable, PackageIfaceTable ) + HomeIfaceTable, PackageIfaceTable, + RdrAvailInfo, ModIface ) import BasicTypes ( Version, defaultFixity ) import ErrUtils ( addShortErrLocLine, addShortWarnLocLine, pprBagOfErrors, ErrMsg, WarnMsg, Message @@ -58,7 +59,7 @@ import Name ( Name, OccName, NamedThing(..), getSrcLoc, NameEnv, lookupNameEnv, emptyNameEnv, unitNameEnv, extendNameEnvList ) -import Module ( Module, ModuleName ) +import Module ( Module, ModuleName, lookupModuleEnvByName ) import NameSet import CmdLineOpts ( DynFlags, DynFlag(..), dopt ) import SrcLoc ( SrcLoc, generatedSrcLoc ) @@ -68,7 +69,7 @@ import Bag ( Bag, emptyBag, isEmptyBag, snocBag ) import UniqSupply import Outputable import PrelNames ( mkUnboundName ) -import Maybes ( maybeToBool, seqMaybe ) +import Maybes ( maybeToBool, seqMaybe, orElse ) infixr 9 `thenRn`, `thenRn_` \end{code} @@ -335,7 +336,7 @@ is_done :: HomeSymbolTable -> PackageSymbolTable -> Name -> Bool -- Returns True iff the name is in either symbol table is_done hst pst n = maybeToBool (lookupTypeEnv pst n `seqMaybe` lookupTypeEnv hst n) -lookupIface :: HomeInterfaceTable -> PackageInterfaceTable -> ModuleName -> ModIface +lookupIface :: HomeIfaceTable -> PackageIfaceTable -> ModuleName -> ModIface lookupIface hit pit mod = lookupModuleEnvByName hit mod `orElse` lookupModuleEnvByName pit mod `orElse` pprPanic "lookupIface" (ppr mod) diff --git a/ghc/compiler/stranal/WorkWrap.lhs b/ghc/compiler/stranal/WorkWrap.lhs index e556ead..305261c 100644 --- a/ghc/compiler/stranal/WorkWrap.lhs +++ b/ghc/compiler/stranal/WorkWrap.lhs @@ -9,19 +9,19 @@ module WorkWrap ( wwTopBinds, mkWrapper ) where #include "HsVersions.h" import CoreSyn -import CoreUnfold ( Unfolding, certainlyWillInline ) +import CoreUnfold ( certainlyWillInline ) import CoreLint ( beginPass, endPass ) -import CoreUtils ( exprType, exprEtaExpandArity ) +import CoreUtils ( exprType ) import MkId ( mkWorkerId ) import Id ( Id, idType, idStrictness, idArity, isOneShotLambda, setIdStrictness, idInlinePragma, setIdWorkerInfo, idCprInfo, setInlinePragma ) import Type ( Type, isNewType, splitForAllTys, splitFunTys ) import IdInfo ( mkStrictnessInfo, noStrictnessInfo, StrictnessInfo(..), - CprInfo(..), exactArity, InlinePragInfo(..), isNeverInlinePrag, + CprInfo(..), InlinePragInfo(..), isNeverInlinePrag, WorkerInfo(..) ) -import Demand ( Demand, wwLazy ) +import Demand ( Demand ) import UniqSupply ( UniqSupply, initUs_, returnUs, thenUs, mapUs, getUniqueUs, UniqSM ) import CmdLineOpts import WwLib diff --git a/ghc/compiler/stranal/WwLib.lhs b/ghc/compiler/stranal/WwLib.lhs index 58800cd..dc70984 100644 --- a/ghc/compiler/stranal/WwLib.lhs +++ b/ghc/compiler/stranal/WwLib.lhs @@ -15,25 +15,22 @@ import CoreSyn import CoreUtils ( exprType ) import Id ( Id, idType, mkSysLocal, idDemandInfo, setIdDemandInfo, isOneShotLambda, setOneShotLambda, - mkWildId, setIdInfo + setIdInfo ) -import IdInfo ( CprInfo(..), noCprInfo, vanillaIdInfo ) -import DataCon ( DataCon, splitProductType ) +import IdInfo ( CprInfo(..), vanillaIdInfo ) +import DataCon ( splitProductType ) import Demand ( Demand(..), wwLazy, wwPrim ) import PrelInfo ( realWorldPrimId, aBSENT_ERROR_ID ) import TysPrim ( realWorldStatePrimTy ) import TysWiredIn ( tupleCon ) -import Type ( isUnLiftedType, +import Type ( Type, isUnLiftedType, splitForAllTys, splitFunTys, isAlgType, - splitNewType_maybe, - mkTyConApp, mkFunTys, - Type + splitNewType_maybe, mkFunTys ) import BasicTypes ( NewOrData(..), Arity, Boxity(..) ) -import Var ( TyVar, Var, isId ) -import UniqSupply ( returnUs, thenUs, getUniqueUs, getUniquesUs, - mapUs, UniqSM ) -import Util ( zipWithEqual, zipEqual, lengthExceeds ) +import Var ( Var, isId ) +import UniqSupply ( returnUs, thenUs, getUniqueUs, getUniquesUs, UniqSM ) +import Util ( zipWithEqual ) import Outputable import List ( zipWith4 ) \end{code} diff --git a/ghc/compiler/typecheck/TcClassDcl.lhs b/ghc/compiler/typecheck/TcClassDcl.lhs index d4ad7e8..1b1a7b0 100644 --- a/ghc/compiler/typecheck/TcClassDcl.lhs +++ b/ghc/compiler/typecheck/TcClassDcl.lhs @@ -16,16 +16,17 @@ import HsSyn ( HsDecl(..), TyClDecl(..), Sig(..), MonoBinds(..), isClassDecl, isClassOpSig, isPragSig, fromClassDeclNameList, tyClDeclName ) -import BasicTypes ( NewOrData(..), TopLevelFlag(..), RecFlag(..), EP(..) ) +import BasicTypes ( TopLevelFlag(..), RecFlag(..) ) import RnHsSyn ( RenamedTyClDecl, RenamedClassOpSig, RenamedMonoBinds, RenamedContext, RenamedHsDecl, RenamedSig, - RenamedHsExpr, maybeGenericMatch + maybeGenericMatch ) import TcHsSyn ( TcMonoBinds, idsToMonoBinds ) -import Inst ( InstOrigin(..), LIE, emptyLIE, plusLIE, plusLIEs, newDicts, newMethod ) -import TcEnv ( TcId, TcEnv, TyThing(..), TyThingDetails(..), tcAddImportedIdInfo, +import Inst ( InstOrigin(..), LIE, emptyLIE, plusLIE, plusLIEs, + newDicts, newMethod ) +import TcEnv ( TcId, TcEnv, TyThingDetails(..), tcAddImportedIdInfo, tcLookupClass, tcExtendTyVarEnvForMeths, tcExtendGlobalTyVars, tcExtendLocalValEnv, tcExtendTyVarEnv, newDefaultMethodName ) @@ -36,15 +37,15 @@ import TcType ( TcType, TcTyVar, tcInstTyVars, zonkTcSigTyVars ) import TcMonad import Generics ( mkGenericRhs, validGenericMethodType ) import PrelInfo ( nO_METHOD_BINDING_ERROR_ID ) -import Class ( classTyVars, classBigSig, classSelIds, classTyCon, Class, ClassOpItem, - DefMeth (..) ) -import Bag ( bagToList ) +import Class ( classTyVars, classBigSig, classSelIds, classTyCon, + Class, ClassOpItem, DefMeth (..) ) import MkId ( mkDictSelId, mkDataConId, mkDataConWrapId, mkDefaultMethodId ) import DataCon ( mkDataCon, notMarkedStrict ) import Id ( Id, idType, idName ) -import Name ( Name, nameOccName, isLocallyDefined, NamedThing(..), mkSysLocalName, - NameEnv, lookupNameEnv, emptyNameEnv, unitNameEnv, plusNameEnv, nameEnvElts ) -import NameSet ( NameSet, mkNameSet, elemNameSet, emptyNameSet ) +import Name ( Name, isLocallyDefined, NamedThing(..), + NameEnv, lookupNameEnv, emptyNameEnv, unitNameEnv, + plusNameEnv, nameEnvElts ) +import NameSet ( emptyNameSet ) import Outputable import Type ( Type, ClassContext, mkTyVarTys, mkDictTys, mkSigmaTy, mkClassPred, splitTyConApp_maybe, isTyVarTy diff --git a/ghc/compiler/typecheck/TcEnv.lhs b/ghc/compiler/typecheck/TcEnv.lhs index 63f91ae..27b0a8b 100644 --- a/ghc/compiler/typecheck/TcEnv.lhs +++ b/ghc/compiler/typecheck/TcEnv.lhs @@ -44,35 +44,30 @@ import TcType ( TcKind, TcType, TcTyVar, TcTyVarSet, TcThetaType, import Id ( mkUserLocal, isDataConWrapId_maybe ) import IdInfo ( vanillaIdInfo ) import MkId ( mkSpecPragmaId ) -import Var ( TyVar, Id, setVarName, - idType, lazySetIdInfo, idInfo, tyVarKind, UVar, - ) +import Var ( TyVar, Id, idType, lazySetIdInfo, idInfo ) import VarSet -import Type ( Kind, Type, superKind, - tyVarsOfType, tyVarsOfTypes, - splitForAllTys, splitRhoTy, splitFunTys, - splitAlgTyConApp_maybe, getTyVar, getDFunTyKey +import Type ( Type, + tyVarsOfTypes, + splitForAllTys, splitRhoTy, + getDFunTyKey ) import DataCon ( DataCon ) -import TyCon ( TyCon, tyConKind, tyConArity, isSynTyCon ) -import Class ( Class, ClassOpItem, ClassContext, classTyCon ) +import TyCon ( TyCon ) +import Class ( Class, ClassOpItem, ClassContext ) import Subst ( substTy ) import Name ( Name, OccName, NamedThing(..), nameOccName, nameModule, getSrcLoc, mkGlobalName, isLocallyDefined, - NameEnv, emptyNameEnv, lookupNameEnv, nameEnvElts, - extendNameEnv, extendNameEnvList + NameEnv, lookupNameEnv, nameEnvElts, + extendNameEnvList, emptyNameEnv ) import OccName ( mkDFunOcc, mkDefaultMethodOcc, occNameString ) import Module ( Module ) -import HscTypes ( ModDetails(..), InstEnv, lookupTypeEnv, TyThing(..), - GlobalSymbolTable, Provenance(..) ) -import Unique ( pprUnique10, Unique, Uniquable(..) ) +import HscTypes ( InstEnv, lookupTypeEnv, TyThing(..), + GlobalSymbolTable ) import UniqFM -import Unique ( Uniquable(..) ) -import Util ( zipEqual, zipWith3Equal, mapAccumL ) +import Util ( zipEqual ) import SrcLoc ( SrcLoc ) -import FastString ( FastString ) import Outputable import TcInstUtil ( emptyInstEnv ) diff --git a/ghc/compiler/typecheck/TcMonoType.lhs b/ghc/compiler/typecheck/TcMonoType.lhs index 531baeb..93d86c4 100644 --- a/ghc/compiler/typecheck/TcMonoType.lhs +++ b/ghc/compiler/typecheck/TcMonoType.lhs @@ -18,7 +18,7 @@ module TcMonoType ( tcHsType, tcHsSigType, tcHsBoxedSigType, #include "HsVersions.h" -import HsSyn ( HsType(..), HsTyVarBndr(..), HsUsageAnn(..), +import HsSyn ( HsType(..), HsTyVarBndr(..), Sig(..), HsPred(..), pprParendHsType, HsTupCon(..), hsTyVarNames ) import RnHsSyn ( RenamedHsType, RenamedHsPred, RenamedContext, RenamedSig ) import TcHsSyn ( TcId ) @@ -38,16 +38,16 @@ import Inst ( Inst, InstOrigin(..), newMethodWithGivenTy, instToIdBndr, instFunDeps, instFunDepsOfTheta ) import FunDeps ( tyVarFunDep, oclose ) import TcUnify ( unifyKind, unifyOpenTypeKind ) -import Type ( Type, Kind, PredType(..), ThetaType, UsageAnn(..), - mkTyVarTy, mkTyVarTys, mkFunTy, mkSynTy, mkUsgTy, - mkUsForAllTy, zipFunTys, hoistForAllTys, +import Type ( Type, Kind, PredType(..), ThetaType, + mkTyVarTy, mkTyVarTys, mkFunTy, mkSynTy, + zipFunTys, hoistForAllTys, mkSigmaTy, mkPredTy, mkTyConApp, mkAppTys, splitForAllTys, splitRhoTy, mkRhoTy, boxedTypeKind, unboxedTypeKind, mkArrowKind, mkArrowKinds, getTyVar_maybe, getTyVar, splitFunTy_maybe, tidyOpenType, tidyOpenTypes, tidyTyVar, tidyTyVars, tyVarsOfType, tyVarsOfPred, mkForAllTys, - classesOfPreds, isUnboxedTupleType + classesOfPreds, ) import PprType ( pprType, pprPred ) import Subst ( mkTopTyVarSubst, substTy ) @@ -56,9 +56,9 @@ import Var ( Var, TyVar, mkTyVar, tyVarKind ) import VarEnv import VarSet import ErrUtils ( Message ) -import TyCon ( TyCon, isSynTyCon, tyConArity, tyConKind, tyConName ) +import TyCon ( TyCon, isSynTyCon, tyConArity, tyConKind ) import Class ( ClassContext, classArity, classTyCon ) -import Name ( Name, isLocallyDefined ) +import Name ( Name ) import TysWiredIn ( mkListTy, mkTupleTy, genUnitTyCon ) import UniqFM ( elemUFM ) import BasicTypes ( Boxity(..) ) diff --git a/ghc/compiler/typecheck/TcRules.lhs b/ghc/compiler/typecheck/TcRules.lhs index 34aa305..fa48203 100644 --- a/ghc/compiler/typecheck/TcRules.lhs +++ b/ghc/compiler/typecheck/TcRules.lhs @@ -8,7 +8,7 @@ module TcRules ( tcRules ) where #include "HsVersions.h" -import HsSyn ( HsDecl(..), RuleDecl(..), RuleBndr(..), HsTyVarBndr(..) ) +import HsSyn ( HsDecl(..), RuleDecl(..), RuleBndr(..) ) import CoreSyn ( CoreRule(..) ) import RnHsSyn ( RenamedHsDecl ) import TcHsSyn ( TypecheckedRuleDecl, mkHsLet ) diff --git a/ghc/compiler/typecheck/TcType.lhs b/ghc/compiler/typecheck/TcType.lhs index 09c069e..58aac30 100644 --- a/ghc/compiler/typecheck/TcType.lhs +++ b/ghc/compiler/typecheck/TcType.lhs @@ -43,8 +43,8 @@ module TcType ( -- friends: import TypeRep ( Type(..), Kind, TyNote(..) ) -- friend -import Type ( ThetaType, PredType(..), - getTyVar, mkAppTy, mkTyConApp, mkPredTy, +import Type ( PredType(..), + getTyVar, mkAppTy, splitPredTy_maybe, splitForAllTys, isNotUsgTy, isTyVarTy, mkTyVarTy, mkTyVarTys, openTypeKind, boxedTypeKind, @@ -52,7 +52,7 @@ import Type ( ThetaType, PredType(..), defaultKind, boxedBoxity ) import Subst ( Subst, mkTopTyVarSubst, substTy ) -import TyCon ( tyConKind, mkPrimTyCon ) +import TyCon ( mkPrimTyCon ) import PrimRep ( PrimRep(VoidRep) ) import Var ( TyVar, tyVarKind, tyVarName, isTyVar, isMutTyVar, mkTyVar ) @@ -63,7 +63,7 @@ import TysWiredIn ( voidTy ) import Name ( Name, NamedThing(..), setNameUnique, mkSysLocalName, mkDerivedName, mkDerivedTyConOcc ) -import Unique ( Unique, Uniquable(..) ) +import Unique ( Uniquable(..) ) import Util ( nOfThem ) import Outputable \end{code}