Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
6c1d2ec4
Commit
6c1d2ec4
authored
Oct 23, 2000
by
sewardj
Browse files
[project @ 2000-10-23 11:50:40 by sewardj]
Small cleanups.
parent
f2cf99c9
Changes
14
Hide whitespace changes
Inline
Side-by-side
ghc/compiler/coreSyn/CoreLint.lhs
View file @
6c1d2ec4
...
...
@@ -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
...
...
ghc/compiler/main/Finder.lhs
View file @
6c1d2ec4
...
...
@@ -13,7 +13,7 @@ module Finder (
#include "HsVersions.h"
import HscTyes ( Finder, ModuleLocation(..) )
import HscTy
p
es ( Finder, ModuleLocation(..) )
import CmStaticInfo
import DriverPhases
import DriverState
...
...
ghc/compiler/main/HscMain.lhs
View file @
6c1d2ec4
%
% (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}
ghc/compiler/main/HscStats.lhs
0 → 100644
View file @
6c1d2ec4
%
% (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}
ghc/compiler/rename/ParseIface.y
View file @
6c1d2ec4
...
...
@@ -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
:
{
[]
}
...
...
ghc/compiler/rename/RnIfaces.lhs
View file @
6c1d2ec4
...
...
@@ -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,
rule
Ver
s = rule_vers,
decl
Ver
s = 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 dependen
c
y 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
...
...
ghc/compiler/rename/RnMonad.lhs
View file @
6c1d2ec4
...
...
@@ -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 :: HomeI
nter
faceTable -> PackageI
nter
faceTable -> ModuleName -> ModIface
lookupIface :: HomeIfaceTable -> PackageIfaceTable -> ModuleName -> ModIface
lookupIface hit pit mod = lookupModuleEnvByName hit mod `orElse`
lookupModuleEnvByName pit mod `orElse`
pprPanic "lookupIface" (ppr mod)
...
...
ghc/compiler/stranal/WorkWrap.lhs
View file @
6c1d2ec4
...
...
@@ -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
...
...
ghc/compiler/stranal/WwLib.lhs
View file @
6c1d2ec4
...
...
@@ -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}
...
...
ghc/compiler/typecheck/TcClassDcl.lhs
View file @
6c1d2ec4
...
...
@@ -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 )