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
ab22f4e6
Commit
ab22f4e6
authored
Oct 11, 2006
by
Simon Marlow
Browse files
More import tidying and fixing the stage 2 build
parent
6b459294
Changes
52
Hide whitespace changes
Inline
Side-by-side
compiler/coreSyn/CoreUtils.lhs
View file @
ab22f4e6
...
...
@@ -69,10 +69,7 @@ import Outputable
import DynFlags
import TysPrim
import FastString
#ifdef DEBUG
import Util
#endif
import GHC.Exts -- For `xori`
\end{code}
...
...
compiler/deSugar/DsMeta.hs
View file @
ab22f4e6
...
...
@@ -1412,14 +1412,10 @@ thLib = mkTHModule FSLIT("Language.Haskell.TH.Lib")
mkTHModule
m
=
mkModule
thPackageId
(
mkModuleNameFS
m
)
mk_known_key_name
mod
space
str
uniq
=
mkExternalName
uniq
mod
(
mkOccNameFS
space
str
)
Nothing
noSrcLoc
libFun
=
mk_known_key_name
thLib
OccName
.
varName
libTc
=
mk_known_key_name
thLib
OccName
.
tcName
thFun
=
mk_known_key_name
thSyn
OccName
.
varName
thTc
=
mk_known_key_name
thSyn
OccName
.
tcName
libFun
=
mk_known_key_name
OccName
.
varName
thLib
libTc
=
mk_known_key_name
OccName
.
tcName
thLib
thFun
=
mk_known_key_name
OccName
.
varName
thSyn
thTc
=
mk_known_key_name
OccName
.
tcName
thSyn
-------------------- TH.Syntax -----------------------
qTyConName
=
thTc
FSLIT
(
"Q"
)
qTyConKey
...
...
compiler/ghci/ByteCodeAsm.lhs
View file @
ab22f4e6
%
% (c) The University of Glasgow 2002
% (c) The University of Glasgow 2002
-2006
%
\section[ByteCodeLink]{Bytecode assembler and linker}
ByteCodeLink: Bytecode assembler and linker
\begin{code}
{-# OPTIONS -optc-DNON_POSIX_SOURCE #-}
...
...
@@ -18,17 +19,17 @@ module ByteCodeAsm (
#include "HsVersions.h"
import ByteCodeInstr
import ByteCodeItbls
( ItblEnv, mkITbls )
import ByteCodeItbls
import Name
( Name, getName )
import Name
import NameSet
import FiniteMap
( addToFM, lookupFM, emptyFM )
import Literal
( Literal(..) )
import TyCon
( TyCon )
import PrimOp
( PrimOp )
import Constants
( wORD_SIZE )
import FastString
( FastString(..) )
import SMRep
( CgRep(..), StgWord )
import FiniteMap
import Literal
import TyCon
import PrimOp
import Constants
import FastString
import SMRep
import FiniteMap
import Outputable
...
...
compiler/ghci/ByteCodeFFI.lhs
View file @
ab22f4e6
%
% (c) The University of Glasgow 2001
% (c) The University of Glasgow 2001
-2006
%
\section[ByteCodeGen]{Generate machine-code sequences for foreign import}
ByteCodeGen: Generate machine-code sequences for foreign import
\begin{code}
module ByteCodeFFI ( mkMarshalCode, moan64 ) where
...
...
@@ -9,21 +10,20 @@ module ByteCodeFFI ( mkMarshalCode, moan64 ) where
#include "HsVersions.h"
import Outputable
import SMRep
( CgRep(..), cgRepSizeW )
import ForeignCall
( CCallConv(..) )
import SMRep
import ForeignCall
import Panic
-- DON'T remove apparently unused imports here ..
-- there is ifdeffery below
import Control.Exception ( throwDyn )
import D
ATA_BITS
( Bits(..), shiftR, shiftL )
import Foreign ( newArray )
import D
ata.Bits
( Bits(..), shiftR, shiftL )
import Foreign ( newArray
, Ptr
)
import Data.List ( mapAccumL )
import DATA_WORD ( Word8, Word32 )
import Foreign ( Ptr )
import Data.Word ( Word8, Word32 )
import System.IO.Unsafe ( unsafePerformIO )
import IO
( hPutStrLn, stderr )
import
System.
IO ( hPutStrLn, stderr )
-- import Debug.Trace ( trace )
\end{code}
...
...
compiler/ghci/ByteCodeGen.lhs
View file @
ab22f4e6
%
% (c) The University of Glasgow 2002
% (c) The University of Glasgow 2002
-2006
%
\section[ByteCodeGen]{Generate bytecode from Core}
ByteCodeGen: Generate bytecode from Core
\begin{code}
module ByteCodeGen ( UnlinkedBCO, byteCodeGen, coreExprToBCOs ) where
...
...
@@ -9,48 +10,41 @@ module ByteCodeGen ( UnlinkedBCO, byteCodeGen, coreExprToBCOs ) where
#include "HsVersions.h"
import ByteCodeInstr
import ByteCodeFFI ( mkMarshalCode, moan64 )
import ByteCodeAsm ( CompiledByteCode(..), UnlinkedBCO,
assembleBCO, assembleBCOs, iNTERP_STACK_CHECK_THRESH )
import ByteCodeLink ( lookupStaticPtr )
import ByteCodeFFI
import ByteCodeAsm
import ByteCodeLink
import Outputable
import Name
( Name, getName, mkSystemVarName )
import Name
import Id
import FiniteMap
import ForeignCall
( ForeignCall(..), CCallTarget(..), CCallSpec(..) )
import HscTypes
( TypeEnv, typeEnvTyCons, typeEnvClasses )
import CoreUtils
( exprType )
import ForeignCall
import HscTypes
import CoreUtils
import CoreSyn
import PprCore ( pprCoreExpr )
import Literal ( Literal(..), literalType )
import PrimOp ( PrimOp(..) )
import CoreFVs ( freeVars )
import Type ( isUnLiftedType, splitTyConApp_maybe )
import DataCon ( DataCon, dataConTag, fIRST_TAG, dataConTyCon,
isUnboxedTupleCon, isNullaryRepDataCon, dataConWorkId,
dataConRepArity )
import TyCon ( TyCon, tyConFamilySize, isDataTyCon,
tyConDataCons, isUnboxedTupleTyCon )
import Class ( Class, classTyCon )
import Type ( Type, repType, splitFunTys, dropForAlls, pprType )
import PprCore
import Literal
import PrimOp
import CoreFVs
import Type
import DataCon
import TyCon
import Class
import Type
import Util
import DataCon ( dataConRepArity )
import Var ( isTyVar )
import VarSet ( VarSet, varSetElems )
import TysPrim ( arrayPrimTyCon, mutableArrayPrimTyCon,
byteArrayPrimTyCon, mutableByteArrayPrimTyCon
)
import DynFlags ( DynFlags, DynFlag(..) )
import ErrUtils ( showPass, dumpIfSet_dyn )
import Unique ( mkPseudoUniqueE )
import FastString ( FastString(..), unpackFS )
import Panic ( GhcException(..) )
import SMRep ( typeCgRep, arrWordsHdrSize, arrPtrsHdrSize, StgWord,
CgRep(..), cgRepSizeW, isFollowableArg, idCgRep )
import Bitmap ( intsToReverseBitmap, mkBitmap )
import DataCon
import Var
import VarSet
import TysPrim
import DynFlags
import ErrUtils
import Unique
import FastString
import Panic
import SMRep
import Bitmap
import OrdList
import Constants
( wORD_SIZE )
import Constants
import Data.List ( intersperse, sortBy, zip4, zip6, partition )
import Foreign ( Ptr, castPtr, mallocBytes, pokeByteOff, Word8,
...
...
@@ -101,7 +95,7 @@ coreExprToBCOs dflags expr
-- create a totally bogus name for the top-level BCO; this
-- should be harmless, since it's never used for anything
let invented_name = mkSystemVarName (mkPseudoUniqueE 0) FSLIT("ExprTopLevel")
invented_id = mkLocalId invented_name (panic "invented_id's type")
invented_id =
Id.
mkLocalId invented_name (panic "invented_id's type")
(BcM_State final_ctr mallocd, proto_bco)
<- runBc (schemeTopBind (invented_id, freeVars expr))
...
...
compiler/ghci/ByteCodeInstr.lhs
View file @
ab22f4e6
%
% (c) The University of Glasgow 2000
% (c) The University of Glasgow 2000
-2006
%
\section[
ByteCodeInstrs
]{
Bytecode instruction definitions
}
ByteCodeInstrs
:
Bytecode instruction definitions
\begin{code}
module ByteCodeInstr (
...
...
@@ -12,15 +12,16 @@ module ByteCodeInstr (
#include "../includes/MachDeps.h"
import Outputable
import Name
( Name )
import Id
( Id )
import Name
import Id
import CoreSyn
import PprCore ( pprCoreExpr, pprCoreAlt )
import Literal ( Literal )
import DataCon ( DataCon )
import VarSet ( VarSet )
import PrimOp ( PrimOp )
import SMRep ( StgWord, CgRep )
import PprCore
import Literal
import DataCon
import VarSet
import PrimOp
import SMRep
import GHC.Ptr
-- ----------------------------------------------------------------------------
...
...
compiler/ghci/ByteCodeItbls.lhs
View file @
ab22f4e6
%
% (c) The University of Glasgow 2000
% (c) The University of Glasgow 2000
-2006
%
\section[
ByteCodeItbls
]{
Generate infotables for interpreter-made bytecodes
}
ByteCodeItbls
:
Generate infotables for interpreter-made bytecodes
\begin{code}
{-# OPTIONS -optc-DNON_POSIX_SOURCE #-}
module ByteCodeItbls ( ItblEnv, ItblPtr, mkITbls ) where
...
...
@@ -23,14 +22,10 @@ import Util ( lengthIs, listLengthCmp )
import Foreign
import Foreign.C
import D
ATA_BITS
( Bits(..), shiftR )
import D
ata.Bits
( Bits(..), shiftR )
import GHC.Exts ( Int(I#), addr2Int# )
#if __GLASGOW_HASKELL__ < 503
import Ptr ( Ptr(..) )
#else
import GHC.Ptr ( Ptr(..) )
#endif
\end{code}
%************************************************************************
...
...
compiler/ghci/ByteCodeLink.lhs
View file @
ab22f4e6
%
% (c) The University of Glasgow 2000
% (c) The University of Glasgow 2000
-2006
%
\section[
ByteCodeLink
]{
Bytecode assembler and linker
}
ByteCodeLink
:
Bytecode assembler and linker
\begin{code}
{-# OPTIONS -optc-DNON_POSIX_SOURCE #-}
module ByteCodeLink (
...
...
@@ -15,21 +14,20 @@ module ByteCodeLink (
#include "HsVersions.h"
import ByteCodeItbls
( ItblEnv, ItblPtr )
import ByteCodeAsm
( UnlinkedBCO(..), BCOPtr(..), sizeSS, ssElts )
import ObjLink
( lookupSymbol )
import ByteCodeItbls
import ByteCodeAsm
import ObjLink
import Name
( Name, nameModule, nameOccName )
import Name
import NameEnv
import OccName
( occNameFS )
import PrimOp
( PrimOp, primOpOcc )
import OccName
import PrimOp
import Module
import PackageConfig
( mainPackageId, packageIdFS )
import FastString
( FastString(..), unpackFS, zEncodeFS )
import Panic
( GhcException(..) )
import PackageConfig
import FastString
import Panic
#ifdef DEBUG
import Name ( isExternalName )
import Outputable
#endif
...
...
compiler/ghci/InteractiveUI.hs
View file @
ab22f4e6
...
...
@@ -3,7 +3,7 @@
--
-- GHC Interactive User Interface
--
-- (c) The GHC Team 2005
-- (c) The GHC Team 2005
-2006
--
-----------------------------------------------------------------------------
module
InteractiveUI
(
...
...
@@ -17,49 +17,40 @@ module InteractiveUI (
import
GHC.Exts
(
Int
(
..
),
Ptr
(
..
),
int2Addr
#
)
import
Foreign.StablePtr
(
deRefStablePtr
,
castPtrToStablePtr
)
import
System.IO.Unsafe
(
unsafePerformIO
)
import
Var
(
Id
,
globaliseId
,
idName
,
idType
)
import
HscTypes
(
Session
(
..
),
InteractiveContext
(
..
),
HscEnv
(
..
)
,
extendTypeEnvWithIds
)
import
RdrName
(
extendLocalRdrEnv
,
mkRdrUnqual
,
lookupLocalRdrEnv
)
import
NameEnv
(
delListFromNameEnv
)
import
TcType
(
tidyTopType
)
import
qualified
Id
(
setIdType
)
import
IdInfo
(
GlobalIdDetails
(
..
)
)
import
Linker
(
HValue
,
extendLinkEnv
,
withExtendedLinkEnv
,
initDynLinker
)
import
PrelNames
(
breakpointJumpName
,
breakpointCondJumpName
)
import
Var
import
HscTypes
import
RdrName
import
NameEnv
import
TcType
import
qualified
Id
import
IdInfo
import
PrelNames
#
endif
-- The GHC interface
import
qualified
GHC
import
GHC
(
Session
,
dopt
,
DynFlag
(
..
),
Target
(
..
),
TargetId
(
..
),
DynFlags
(
..
),
pprModule
,
Type
,
Module
,
ModuleName
,
SuccessFlag
(
..
),
TyThing
(
..
),
Name
,
LoadHowMuch
(
..
),
Phase
,
GhcException
(
..
),
showGhcException
,
CheckedModule
(
..
),
SrcLoc
)
import
DynFlags
(
allFlags
)
import
Packages
(
PackageState
(
..
)
)
import
PackageConfig
(
InstalledPackageInfo
(
..
)
)
import
UniqFM
(
eltsUFM
)
import
GHC
(
Session
,
LoadHowMuch
(
..
),
Target
(
..
),
TargetId
(
..
),
Type
,
Module
,
ModuleName
,
TyThing
(
..
),
Phase
)
import
DynFlags
import
Packages
import
PackageConfig
import
UniqFM
import
PprTyThing
import
Outputable
-- for createtags
(should these come via GHC?)
import
Name
(
nameSrcLoc
,
nameModule
,
nameOccName
)
import
OccName
(
pprOccName
)
import
SrcLoc
(
isGoodSrcLoc
,
srcLocFile
,
srcLocLine
,
srcLocCol
)
-- for createtags
import
Name
import
OccName
import
SrcLoc
-- Other random utilities
import
Digraph
(
flattenSCCs
)
import
BasicTypes
(
failed
,
successIf
)
import
Panic
(
panic
,
installSignalHandlers
)
import
Digraph
import
BasicTypes
import
Panic
hiding
(
showException
)
import
Config
import
StaticFlags
(
opt_IgnoreDotGhci
)
import
Linker
(
showLinkerState
,
linkPackages
)
import
Util
(
removeSpaces
,
handle
,
global
,
toArgs
,
looksLikeModuleName
,
prefixMatch
,
sortLe
,
joinFileName
)
import
StaticFlags
import
Linker
import
Util
#
ifndef
mingw32_HOST_OS
import
System.Posix
...
...
@@ -718,7 +709,8 @@ info s = do { let names = words s
filterOutChildren
::
[
Name
]
->
[
Name
]
filterOutChildren
names
=
filter
(
not
.
parent_is_there
)
names
where
parent_is_there
n
|
Just
p
<-
GHC
.
nameParent_maybe
n
=
p
`
elem
`
names
-- | Just p <- GHC.nameParent_maybe n = p `elem` names
-- ToDo!!
|
otherwise
=
False
pprInfo
exts
(
thing
,
fixity
,
insts
)
...
...
@@ -864,7 +856,7 @@ checkModule m = do
case
result
of
Nothing
->
io
$
putStrLn
"Nothing"
Just
r
->
io
$
putStrLn
(
showSDoc
(
case
checkedModuleInfo
r
of
case
GHC
.
checkedModuleInfo
r
of
Just
cm
|
Just
scope
<-
GHC
.
modInfoTopLevelScope
cm
->
let
(
local
,
global
)
=
partition
((
==
modl
)
.
GHC
.
moduleName
.
GHC
.
nameModule
)
scope
...
...
compiler/ghci/Linker.lhs
View file @
ab22f4e6
%
% (c) The University of Glasgow 2005
% (c) The University of Glasgow 2005
-2006
%
-- --------------------------------------
...
...
@@ -12,7 +12,6 @@ necessary.
\begin{code}
{-# OPTIONS -optc-DNON_POSIX_SOURCE -#include "Linker.h" #-}
module Linker ( HValue, showLinkerState,
...
...
@@ -23,48 +22,43 @@ module Linker ( HValue, showLinkerState,
#include "HsVersions.h"
import ObjLink
( loadDLL, loadObj, unloadObj, resolveObjs, initObjLinker )
import ByteCodeLink
( HValue, ClosureEnv, extendClosureEnv, linkBCO )
import ByteCodeItbls
( ItblEnv )
import ByteCodeAsm
( CompiledByteCode(..), bcoFreeNames, UnlinkedBCO(..))
import ObjLink
import ByteCodeLink
import ByteCodeItbls
import ByteCodeAsm
import Packages
import DriverPhases ( isObjectFilename, isDynLibFilename )
import Finder ( findHomeModule, findObjectLinkableMaybe,
FindResult(..) )
import DriverPhases
import Finder
import HscTypes
import Name
( Name, nameModule, isExternalName, isWiredInName )
import Name
import NameEnv
import NameSet
( nameSetToList )
import UniqFM
( lookupUFM )
import NameSet
import UniqFM
import Module
import ListSetOps
( minusList )
import DynFlags
( DynFlags(..), getOpts )
import BasicTypes
( SuccessFlag(..), succeeded, failed )
import ListSetOps
import DynFlags
import BasicTypes
import Outputable
import PackageConfig ( rtsPackageId )
import Panic ( GhcException(..) )
import Util ( zipLazy, global, joinFileExt, joinFileName,
replaceFilenameSuffix )
import StaticFlags ( v_Ld_inputs, v_Build_tag )
import ErrUtils ( debugTraceMsg, mkLocMessage )
import DriverPhases ( phaseInputExt, Phase(..) )
import SrcLoc ( SrcSpan )
import PackageConfig
import Panic
import Util
import StaticFlags
import ErrUtils
import DriverPhases
import SrcLoc
-- Standard libraries
import Control.Monad
( when, filterM, foldM )
import Control.Monad
import Data.IORef
( IORef, readIORef, writeIORef, modifyIORef )
import Data.List
( partition, nub )
import Data.IORef
import Data.List
import System.IO
( putStr, putStrLn, hPutStrLn, stderr, fixIO )
import System.Directory
( doesFileExist )
import System.IO
import System.Directory
import Control.Exception ( block, throwDyn, bracket )
import Maybe ( fromJust )
#ifdef DEBUG
import Maybe ( isJust )
#endif
import Control.Exception
import Data.Maybe
#if __GLASGOW_HASKELL__ >= 503
import GHC.IOBase ( IO(..) )
...
...
compiler/ghci/ObjLink.lhs
View file @
ab22f4e6
%
% (c) The University of Glasgow, 2000
% (c) The University of Glasgow, 2000
-2006
%
-- ---------------------------------------------------------------------------
...
...
@@ -22,15 +22,14 @@ module ObjLink (
resolveObjs -- :: IO SuccessFlag
) where
import Monad ( when )
import Foreign.C
import Foreign ( nullPtr )
import Panic ( panic )
import BasicTypes ( SuccessFlag, successIf )
import Config ( cLeadingUnderscore )
import Outputable
import Control.Monad ( when )
import Foreign.C
import Foreign ( nullPtr )
import GHC.Exts ( Ptr(..), unsafeCoerce# )
-- ---------------------------------------------------------------------------
...
...
compiler/hsSyn/Convert.lhs
View file @
ab22f4e6
%
% (c) The University of Glasgow 2006
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
This module converts Template Haskell syntax into HsSyn
\begin{code}
module Convert( convertToHsExpr, convertToHsDecls, convertToHsType, thRdrName ) where
module Convert( convertToHsExpr, convertToHsDecls,
convertToHsType, thRdrName ) where
#include "HsVersions.h"
import Language.Haskell.TH as TH hiding (sigP)
import Language.Haskell.TH.Syntax as TH
import HsSyn as Hs
import qualified Class
(FunDep)
import RdrName
( RdrName, mkRdrUnqual, mkRdrQual, mkOrig, getRdrName, nameRdrName )
import qualified Name
( Name, mkInternalName, getName )
import Module
( ModuleName, mkModuleName, mkModule )
import RdrHsSyn
( mkClassDecl, mkTyData )
import qualified Class
import RdrName
import qualified Name
import Module
import RdrHsSyn
import qualified OccName
import PackageConfig ( PackageId, stringToPackageId )
import OccName ( startsVarId, startsVarSym, startsConId, startsConSym,
pprNameSpace )
import SrcLoc ( Located(..), SrcSpan )
import Type ( Type )
import TysWiredIn ( unitTyCon, tupleTyCon, tupleCon, trueDataCon, nilDataCon, consDataCon )
import BasicTypes( Boxity(..) )
import ForeignCall ( Safety(..), CCallConv(..), CCallTarget(..),
CExportSpec(..))
import Char ( isAscii, isAlphaNum, isAlpha )
import List ( partition )
import Unique ( Unique, mkUniqueGrimily )
import ErrUtils ( Message )
import GLAEXTS ( Int(..), Int# )
import SrcLoc ( noSrcLoc )
import Bag ( listToBag )
import PackageConfig
import OccName
import SrcLoc
import Type
import TysWiredIn
import BasicTypes
import ForeignCall
import Char
import List
import Unique
import ErrUtils
import Bag
import FastString
import Outputable
import Language.Haskell.TH as TH hiding (sigP)
import Language.Haskell.TH.Syntax as TH
import GHC.Exts
-------------------------------------------------------------------
-- The external interface
...
...
@@ -230,8 +227,8 @@ cvtForD (ExportF callconv as nm ty)
; let e = CExport (CExportStatic (mkFastString as) (cvt_conv callconv))
; return $ ForeignExport nm' ty' e }
cvt_conv CCall = CCallConv
cvt_conv StdCall = StdCallConv
cvt_conv
TH.
CCall = CCallConv
cvt_conv
TH.
StdCall = StdCallConv
parse_ccall_impent :: String -> String -> Maybe (FastString, CImportSpec)
parse_ccall_impent nm s
...
...
compiler/hsSyn/HsBinds.lhs
View file @
ab22f4e6
%
% (c) The University of Glasgow 2006
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
\section[HsBinds]{Abstract syntax: top-level bindings and signatures}
...
...
@@ -15,18 +16,18 @@ import {-# SOURCE #-} HsExpr ( HsExpr, pprExpr, LHsExpr,
GRHSs, pprPatBind )
import {-# SOURCE #-} HsPat ( LPat )
import HsTypes
( LHsType, PostTcType )
import PprCore
( {- instances -} )
import Coercion
( Coercion )
import Type
( Type, pprParendType )
import Name
( Name )
import NameSet
( NameSet, elemNameSet )
import BasicTypes
( IPName, RecFlag(..), InlineSpec(..), Fixity )
import HsTypes
import PprCore
import Coercion
import Type
import Name
import NameSet
import BasicTypes
import Outputable
import SrcLoc
( Located(..), SrcSpan, unLoc )
import Util
( sortLe )
import Var
( TyVar, DictId, Id, Var )
import Bag
( Bag, emptyBag, isEmptyBag, bagToList, unionBags, unionManyBags )
import SrcLoc
import Util
import Var