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
1941ef4f
Commit
1941ef4f
authored
Mar 18, 2020
by
Sylvain Henry
Committed by
Marge Bot
Mar 29, 2020
Browse files
Modules: Types (
#13009
)
Update Haddock submodule Metric Increase: haddock.compiler
parent
1c446220
Changes
457
Hide whitespace changes
Inline
Side-by-side
compiler/GHC.hs
View file @
1941ef4f
...
...
@@ -313,12 +313,12 @@ import GHC.Iface.Load ( loadSysInterface )
import
TcRnTypes
import
GHC.Core.Predicate
import
GHC.Driver.Packages
import
NameSet
import
RdrName
import
GHC.Types.
Name
.
Set
import
GHC.Types.Name.Reader
import
GHC.Hs
import
GHC.Core.Type
hiding
(
typeKind
)
import
TcType
import
Id
import
GHC.Types.
Id
import
TysPrim
(
alphaTyVars
)
import
GHC.Core.TyCon
import
GHC.Core.TyCo.Ppr
(
pprForAll
)
...
...
@@ -327,9 +327,9 @@ import GHC.Core.DataCon
import
GHC.Core.FVs
(
orphNamesOfFamInst
)
import
GHC.Core.FamInstEnv
(
FamInst
,
famInstEnvElts
)
import
GHC.Core.InstEnv
import
Name
hiding
(
varName
)
import
Avail
import
SrcLoc
import
GHC.Types.Name
hiding
(
varName
)
import
GHC.Types.
Avail
import
GHC.Types.
SrcLoc
import
GHC.Core
import
GHC.Iface.Tidy
import
GHC.Driver.Phases
(
Phase
(
..
),
isHaskellSrcFilename
)
...
...
@@ -340,8 +340,8 @@ import GHC.Driver.Session hiding (WarnReason(..))
import
GHC.Driver.Ways
import
SysTools
import
SysTools.BaseDir
import
Annotations
import
Module
import
GHC.Types.
Annotations
import
GHC.Types.
Module
import
Panic
import
GHC.Platform
import
Bag
(
listToBag
)
...
...
@@ -350,13 +350,13 @@ import MonadUtils
import
Util
import
StringBuffer
import
Outputable
import
Basic
Types
import
GHC.Types.
Basic
import
FastString
import
qualified
Parser
import
Lexer
import
ApiAnnotation
import
qualified
GHC.LanguageExtensions
as
LangExt
import
NameEnv
import
GHC.Types.
Name
.
Env
import
TcRnDriver
import
Inst
import
FamInst
...
...
compiler/GHC/ByteCode/Asm.hs
View file @
1941ef4f
...
...
@@ -24,9 +24,9 @@ import GHCi.RemoteTypes
import
GHC.Runtime.Interpreter
import
GHC.Driver.Types
import
Name
import
NameSet
import
Literal
import
GHC.Types.
Name
import
GHC.Types.
Name
.
Set
import
GHC.Types.
Literal
import
GHC.Core.TyCon
import
FastString
import
GHC.StgToCmm.Layout
(
ArgRep
(
..
)
)
...
...
@@ -35,8 +35,8 @@ import GHC.Driver.Session
import
Outputable
import
GHC.Platform
import
Util
import
Unique
import
UniqDSet
import
GHC.Types.
Unique
import
GHC.Types.
Uniq
ue.
DSet
-- From iserv
import
SizedSeq
...
...
compiler/GHC/ByteCode/InfoTable.hs
View file @
1941ef4f
...
...
@@ -15,8 +15,8 @@ import GHC.ByteCode.Types
import
GHC.Runtime.Interpreter
import
GHC.Driver.Session
import
GHC.Driver.Types
import
Name
(
Name
,
getName
)
import
NameEnv
import
GHC.Types.Name
(
Name
,
getName
)
import
GHC.Types.
Name
.
Env
import
GHC.Core.DataCon
(
DataCon
,
dataConRepArgTys
,
dataConIdentity
)
import
GHC.Core.TyCon
(
TyCon
,
tyConFamilySize
,
isDataTyCon
,
tyConDataCons
)
import
GHC.Types.RepType
...
...
compiler/GHC/ByteCode/Instr.hs
View file @
1941ef4f
...
...
@@ -20,13 +20,13 @@ import GHC.StgToCmm.Layout ( ArgRep(..) )
import
GHC.Core.Ppr
import
Outputable
import
FastString
import
Name
import
Unique
import
Id
import
GHC.Types.
Name
import
GHC.Types.
Unique
import
GHC.Types.
Id
import
GHC.Core
import
Literal
import
GHC.Types.
Literal
import
GHC.Core.DataCon
import
VarSet
import
GHC.Types.
Var
.
Set
import
PrimOp
import
GHC.Runtime.Heap.Layout
...
...
compiler/GHC/ByteCode/Linker.hs
View file @
1941ef4f
...
...
@@ -28,10 +28,10 @@ import SizedSeq
import
GHC.Runtime.Interpreter
import
GHC.ByteCode.Types
import
GHC.Driver.Types
import
Name
import
NameEnv
import
GHC.Types.
Name
import
GHC.Types.
Name
.
Env
import
PrimOp
import
Module
import
GHC.Types.
Module
import
FastString
import
Panic
import
Outputable
...
...
compiler/GHC/ByteCode/Types.hs
View file @
1941ef4f
...
...
@@ -16,14 +16,14 @@ module GHC.ByteCode.Types
import
GhcPrelude
import
FastString
import
Id
import
Name
import
NameEnv
import
GHC.Types.
Id
import
GHC.Types.
Name
import
GHC.Types.
Name
.
Env
import
Outputable
import
PrimOp
import
SizedSeq
import
GHC.Core.Type
import
SrcLoc
import
GHC.Types.
SrcLoc
import
GHCi.BreakArray
import
GHCi.RemoteTypes
import
GHCi.FFI
...
...
compiler/GHC/Cmm.hs
View file @
1941ef4f
...
...
@@ -26,8 +26,8 @@ module GHC.Cmm (
import
GhcPrelude
import
Id
import
CostCentre
import
GHC.Types.
Id
import
GHC.Types.
CostCentre
import
GHC.Cmm.CLabel
import
GHC.Cmm.BlockId
import
GHC.Cmm.Node
...
...
compiler/GHC/Cmm/BlockId.hs
View file @
1941ef4f
...
...
@@ -11,10 +11,10 @@ module GHC.Cmm.BlockId
import
GhcPrelude
import
GHC.Cmm.CLabel
import
IdInfo
import
Name
import
Unique
import
UniqSupply
import
GHC.Types.
Id
.
Info
import
GHC.Types.
Name
import
GHC.Types.
Unique
import
GHC.Types.
Uniq
ue.
Supply
import
GHC.Cmm.Dataflow.Label
(
Label
,
mkHooplLabel
)
...
...
compiler/GHC/Cmm/BlockId.hs-boot
View file @
1941ef4f
module
GHC.Cmm.BlockId
(
BlockId
,
mkBlockId
)
where
import
GHC.Cmm.Dataflow.Label
(
Label
)
import
Unique
(
Unique
)
import
GHC.Types.
Unique
(
Unique
)
type
BlockId
=
Label
...
...
compiler/GHC/Cmm/CLabel.hs
View file @
1941ef4f
...
...
@@ -115,20 +115,20 @@ module GHC.Cmm.CLabel (
import
GhcPrelude
import
IdInfo
import
Basic
Types
import
GHC.Types.
Id
.
Info
import
GHC.Types.
Basic
import
{-#
SOURCE
#-
}
GHC
.
Cmm
.
BlockId
(
BlockId
,
mkBlockId
)
import
GHC.Driver.Packages
import
Module
import
Name
import
Unique
import
GHC.Types.
Module
import
GHC.Types.
Name
import
GHC.Types.
Unique
import
PrimOp
import
CostCentre
import
GHC.Types.
CostCentre
import
Outputable
import
FastString
import
GHC.Driver.Session
import
GHC.Platform
import
UniqSet
import
GHC.Types.
Uniq
ue.
Set
import
Util
import
GHC.Core.Ppr
(
{- instances -}
)
...
...
compiler/GHC/Cmm/CommonBlockElim.hs
View file @
1941ef4f
...
...
@@ -25,8 +25,8 @@ import Data.Word
import
qualified
Data.Map
as
M
import
Outputable
import
qualified
TrieMap
as
TM
import
UniqFM
import
Unique
import
GHC.Types.
Uniq
ue.
FM
import
GHC.Types.
Unique
import
Control.Arrow
(
first
,
second
)
-- -----------------------------------------------------------------------------
...
...
compiler/GHC/Cmm/Dataflow.hs
View file @
1941ef4f
...
...
@@ -37,7 +37,7 @@ where
import
GhcPrelude
import
GHC.Cmm
import
UniqSupply
import
GHC.Types.
Uniq
ue.
Supply
import
Data.Array
import
Data.Maybe
...
...
compiler/GHC/Cmm/Dataflow/Label.hs
View file @
1941ef4f
...
...
@@ -20,7 +20,7 @@ import Outputable
-- TODO: This should really just use GHC's Unique and Uniq{Set,FM}
import
GHC.Cmm.Dataflow.Collections
import
Unique
(
Uniquable
(
..
))
import
GHC.Types.
Unique
(
Uniquable
(
..
))
import
TrieMap
...
...
compiler/GHC/Cmm/DebugBlock.hs
View file @
1941ef4f
...
...
@@ -34,10 +34,10 @@ import GHC.Cmm
import
GHC.Cmm.Utils
import
GHC.Core
import
FastString
(
nilFS
,
mkFastString
)
import
Module
import
GHC.Types.
Module
import
Outputable
import
GHC.Cmm.Ppr.Expr
(
pprExpr
)
import
SrcLoc
import
GHC.Types.
SrcLoc
import
Util
(
seqList
)
import
GHC.Cmm.Dataflow.Block
...
...
compiler/GHC/Cmm/Expr.hs
View file @
1941ef4f
...
...
@@ -40,12 +40,12 @@ import GHC.Cmm.MachOp
import
GHC.Cmm.Type
import
GHC.Driver.Session
import
Outputable
(
panic
)
import
Unique
import
GHC.Types.
Unique
import
Data.Set
(
Set
)
import
qualified
Data.Set
as
Set
import
Basic
Types
(
Alignment
,
mkAlignment
,
alignmentOf
)
import
GHC.Types.
Basic
(
Alignment
,
mkAlignment
,
alignmentOf
)
-----------------------------------------------------------------------------
-- CmmExpr
...
...
compiler/GHC/Cmm/Graph.hs
View file @
1941ef4f
...
...
@@ -33,10 +33,10 @@ import GHC.Cmm.Dataflow.Graph
import
GHC.Cmm.Dataflow.Label
import
GHC.Driver.Session
import
FastString
import
ForeignCall
import
GHC.Types.
ForeignCall
import
OrdList
import
GHC.Runtime.Heap.Layout
(
ByteOff
)
import
UniqSupply
import
GHC.Types.
Uniq
ue.
Supply
import
Util
import
Panic
...
...
compiler/GHC/Cmm/Info.hs
View file @
1941ef4f
...
...
@@ -49,7 +49,7 @@ import Maybes
import
GHC.Driver.Session
import
ErrUtils
(
withTimingSilent
)
import
Panic
import
UniqSupply
import
GHC.Types.
Uniq
ue.
Supply
import
MonadUtils
import
Util
import
Outputable
...
...
compiler/GHC/Cmm/Info/Build.hs
View file @
1941ef4f
...
...
@@ -10,15 +10,15 @@ module GHC.Cmm.Info.Build
import
GhcPrelude
hiding
(
succ
)
import
Id
import
IdInfo
import
GHC.Types.
Id
import
GHC.Types.
Id
.
Info
import
GHC.Cmm.BlockId
import
GHC.Cmm.Dataflow.Block
import
GHC.Cmm.Dataflow.Graph
import
GHC.Cmm.Dataflow.Label
import
GHC.Cmm.Dataflow.Collections
import
GHC.Cmm.Dataflow
import
Module
import
GHC.Types.
Module
import
GHC.Platform
import
Digraph
import
GHC.Cmm.CLabel
...
...
@@ -28,8 +28,8 @@ import GHC.Driver.Session
import
Maybes
import
Outputable
import
GHC.Runtime.Heap.Layout
import
UniqSupply
import
CostCentre
import
GHC.Types.
Uniq
ue.
Supply
import
GHC.Types.
CostCentre
import
GHC.StgToCmm.Heap
import
Control.Monad
...
...
@@ -41,7 +41,7 @@ import Control.Monad.Trans.State
import
Control.Monad.Trans.Class
import
Data.List
(
unzip4
)
import
NameSet
import
GHC.Types.
Name
.
Set
{- Note [SRTs]
...
...
compiler/GHC/Cmm/LayoutStack.hs
View file @
1941ef4f
...
...
@@ -8,14 +8,14 @@ import GhcPrelude hiding ((<*>))
import
GHC.StgToCmm.Utils
(
callerSaveVolatileRegs
,
newTemp
)
-- XXX layering violation
import
GHC.StgToCmm.Foreign
(
saveThreadState
,
loadThreadState
)
-- XXX layering violation
import
Basic
Types
import
GHC.Types.
Basic
import
GHC.Cmm
import
GHC.Cmm.Info
import
GHC.Cmm.BlockId
import
GHC.Cmm.CLabel
import
GHC.Cmm.Utils
import
GHC.Cmm.Graph
import
ForeignCall
import
GHC.Types.
ForeignCall
import
GHC.Cmm.Liveness
import
GHC.Cmm.ProcPoint
import
GHC.Runtime.Heap.Layout
...
...
@@ -24,9 +24,9 @@ import GHC.Cmm.Dataflow.Collections
import
GHC.Cmm.Dataflow
import
GHC.Cmm.Dataflow.Graph
import
GHC.Cmm.Dataflow.Label
import
UniqSupply
import
GHC.Types.
Uniq
ue.
Supply
import
Maybes
import
UniqFM
import
GHC.Types.
Uniq
ue.
FM
import
Util
import
GHC.Platform
...
...
compiler/GHC/Cmm/Lexer.x
View file @
1941ef4f
...
...
@@ -21,8 +21,8 @@ import GHC.Cmm.Expr
import Lexer
import GHC.Cmm.Monad
import SrcLoc
import UniqFM
import
GHC.Types.
SrcLoc
import
GHC.Types.
Uniq
ue.
FM
import StringBuffer
import FastString
import Ctype
...
...
Prev
1
2
3
4
5
…
23
Next
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment