Skip to content
GitLab
Menu
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
af332442
Commit
af332442
authored
Apr 20, 2020
by
Sylvain Henry
Committed by
Marge Bot
Apr 26, 2020
Browse files
Modules: Utils and Data (
#13009
)
Update Haddock submodule Metric Increase: haddock.compiler
parent
b0fbfc75
Changes
565
Hide whitespace changes
Inline
Side-by-side
compiler/GHC.hs
View file @
af332442
...
...
@@ -293,7 +293,7 @@ module GHC (
#
include
"HsVersions.h"
import
G
hc
Prelude
hiding
(
init
)
import
G
HC.
Prelude
hiding
(
init
)
import
GHC.ByteCode.Types
import
GHC.Runtime.Eval
...
...
@@ -342,16 +342,16 @@ import GHC.SysTools
import
GHC.SysTools.BaseDir
import
GHC.Types.Annotations
import
GHC.Types.Module
import
Panic
import
GHC.Utils.
Panic
import
GHC.Platform
import
Bag
(
listToBag
)
import
Err
Utils
import
Monad
Utils
import
Util
import
StringBuffer
import
Outputable
import
GHC.Data.Bag
(
listToBag
)
import
GHC.
Utils
.Error
import
GHC.Utils.
Monad
import
GHC.Utils.Misc
import
GHC.Data.
StringBuffer
import
GHC.Utils.
Outputable
import
GHC.Types.Basic
import
FastString
import
GHC.Data.
FastString
import
qualified
GHC.Parser
as
Parser
import
GHC.Parser.Lexer
import
GHC.Parser.Annotation
...
...
@@ -373,13 +373,13 @@ import Data.Typeable ( Typeable )
import
Data.Word
(
Word8
)
import
Control.Monad
import
System.Exit
(
exitWith
,
ExitCode
(
..
)
)
import
Exception
import
GHC.Utils.
Exception
import
Data.IORef
import
System.FilePath
import
Control.Concurrent
import
Control.Applicative
((
<|>
))
import
Maybe
s
import
GHC.Data.
Maybe
import
System.IO.Error
(
isDoesNotExistError
)
import
System.Environment
(
getEnv
)
import
System.Directory
...
...
compiler/GHC/Builtin/Names.hs
View file @
af332442
...
...
@@ -159,7 +159,7 @@ where
#
include
"HsVersions.h"
import
G
hc
Prelude
import
G
HC.
Prelude
import
GHC.Types.Module
import
GHC.Types.Name.Occurrence
...
...
@@ -167,7 +167,7 @@ import GHC.Types.Name.Reader
import
GHC.Types.Unique
import
GHC.Types.Name
import
GHC.Types.SrcLoc
import
FastString
import
GHC.Data.
FastString
{-
************************************************************************
...
...
compiler/GHC/Builtin/Names/TH.hs
View file @
af332442
...
...
@@ -6,7 +6,7 @@
module
GHC.Builtin.Names.TH
where
import
G
hc
Prelude
()
import
G
HC.
Prelude
()
import
GHC.Builtin.Names
(
mk_known_key_name
)
import
GHC.Types.Module
(
Module
,
mkModuleNameFS
,
mkModule
,
thUnitId
)
...
...
@@ -14,7 +14,7 @@ import GHC.Types.Name( Name )
import
GHC.Types.Name.Occurrence
(
tcName
,
clsName
,
dataName
,
varName
)
import
GHC.Types.Name.Reader
(
RdrName
,
nameRdrName
)
import
GHC.Types.Unique
import
FastString
import
GHC.Data.
FastString
-- To add a name, do three things
--
...
...
compiler/GHC/Builtin/PrimOps.hs
View file @
af332442
...
...
@@ -25,7 +25,7 @@ module GHC.Builtin.PrimOps (
#
include
"HsVersions.h"
import
G
hc
Prelude
import
G
HC.
Prelude
import
GHC.Builtin.Types.Prim
import
GHC.Builtin.Types
...
...
@@ -45,8 +45,8 @@ import GHC.Types.SrcLoc ( wiredInSrcSpan )
import
GHC.Types.ForeignCall
(
CLabelString
)
import
GHC.Types.Unique
(
Unique
,
mkPrimOpIdUnique
,
mkPrimOpWrapperUnique
)
import
GHC.Types.Module
(
UnitId
)
import
Outputable
import
FastString
import
GHC.Utils.
Outputable
import
GHC.Data.
FastString
{-
************************************************************************
...
...
compiler/GHC/Builtin/PrimOps.hs-boot
View file @
af332442
module
GHC.Builtin.PrimOps
where
import
G
hc
Prelude
()
import
G
HC.
Prelude
()
data
PrimOp
compiler/GHC/Builtin/Types.hs
View file @
af332442
...
...
@@ -130,7 +130,7 @@ module GHC.Builtin.Types (
#
include
"HsVersions.h"
import
G
hc
Prelude
import
G
HC.
Prelude
import
{-#
SOURCE
#-
}
GHC
.
Types
.
Id
.
Make
(
mkDataConWorkId
,
mkDictSelId
)
...
...
@@ -159,10 +159,10 @@ import GHC.Types.ForeignCall
import
GHC.Types.SrcLoc
(
noSrcSpan
)
import
GHC.Types.Unique
import
Data.Array
import
FastString
import
Outputable
import
Util
import
BooleanFormula
(
mkAnd
)
import
GHC.Data.
FastString
import
GHC.Utils.
Outputable
import
GHC.Utils.Misc
import
GHC.Data.
BooleanFormula
(
mkAnd
)
import
qualified
Data.ByteString.Char8
as
BS
...
...
compiler/GHC/Builtin/Types/Literals.hs
View file @
af332442
...
...
@@ -21,10 +21,10 @@ module GHC.Builtin.Types.Literals
,
typeSymbolAppendTyCon
)
where
import
G
hc
Prelude
import
G
HC.
Prelude
import
GHC.Core.Type
import
Pair
import
GHC.Data.
Pair
import
GHC.Tc.Utils.TcType
(
TcType
,
tcEqType
)
import
GHC.Core.TyCon
(
TyCon
,
FamTyConFlav
(
..
),
mkFamilyTyCon
,
Injectivity
(
..
)
)
...
...
@@ -33,7 +33,7 @@ import GHC.Tc.Types.Constraint ( Xi )
import
GHC.Core.Coercion.Axiom
(
CoAxiomRule
(
..
),
BuiltInSynFamily
(
..
),
TypeEqn
)
import
GHC.Types.Name
(
Name
,
BuiltInSyntax
(
..
)
)
import
GHC.Builtin.Types
import
GHC.Builtin.Types.Prim
(
mkTemplateAnonTyConBinders
)
import
GHC.Builtin.Types.Prim
(
mkTemplateAnonTyConBinders
)
import
GHC.Builtin.Names
(
gHC_TYPELITS
,
gHC_TYPENATS
...
...
@@ -49,9 +49,7 @@ import GHC.Builtin.Names
,
typeSymbolCmpTyFamNameKey
,
typeSymbolAppendFamNameKey
)
import
FastString
(
FastString
,
fsLit
,
nilFS
,
nullFS
,
unpackFS
,
mkFastString
,
appendFS
)
import
GHC.Data.FastString
import
qualified
Data.Map
as
Map
import
Data.Maybe
(
isJust
)
import
Control.Monad
(
guard
)
...
...
compiler/GHC/Builtin/Types/Prim.hs
View file @
af332442
...
...
@@ -90,7 +90,7 @@ module GHC.Builtin.Types.Prim(
#
include
"HsVersions.h"
import
G
hc
Prelude
import
G
HC.
Prelude
import
{-#
SOURCE
#-
}
GHC
.
Builtin
.
Types
(
runtimeRepTy
,
unboxedTupleKind
,
liftedTypeKind
...
...
@@ -116,8 +116,8 @@ import GHC.Core.TyCon
import
GHC.Types.SrcLoc
import
GHC.Types.Unique
import
GHC.Builtin.Names
import
FastString
import
Outputable
import
GHC.Data.
FastString
import
GHC.Utils.
Outputable
import
GHC.Core.TyCo.Rep
-- Doesn't need special access, but this is easier to avoid
-- import loops which show up if you import Type instead
...
...
compiler/GHC/Builtin/Uniques.hs
View file @
af332442
...
...
@@ -26,17 +26,17 @@ module GHC.Builtin.Uniques
#
include
"HsVersions.h"
import
G
hc
Prelude
import
G
HC.
Prelude
import
GHC.Builtin.Types
import
GHC.Core.TyCon
import
GHC.Core.DataCon
import
GHC.Types.Id
import
GHC.Types.Basic
import
Outputable
import
GHC.Utils.
Outputable
import
GHC.Types.Unique
import
GHC.Types.Name
import
Util
import
GHC.Utils.Misc
import
Data.Bits
import
Data.Maybe
...
...
compiler/GHC/Builtin/Uniques.hs-boot
View file @
af332442
module
GHC.Builtin.Uniques
where
import
G
hc
Prelude
import
G
HC.
Prelude
import
GHC.Types.Unique
import
GHC.Types.Name
import
GHC.Types.Basic
...
...
compiler/GHC/Builtin/Utils.hs
View file @
af332442
...
...
@@ -47,7 +47,7 @@ module GHC.Builtin.Utils (
#
include
"HsVersions.h"
import
G
hc
Prelude
import
G
HC.
Prelude
import
GHC.Builtin.Uniques
import
GHC.Types.Unique
(
isValidKnownKeyUnique
)
...
...
@@ -63,14 +63,14 @@ import GHC.Types.Id
import
GHC.Types.Name
import
GHC.Types.Name.Env
import
GHC.Types.Id.Make
import
Outputable
import
GHC.Utils.
Outputable
import
GHC.Builtin.Types.Prim
import
GHC.Builtin.Types
import
GHC.Driver.Types
import
GHC.Core.Class
import
GHC.Core.TyCon
import
GHC.Types.Unique.FM
import
Util
import
GHC.Utils.Misc
import
GHC.Builtin.Types.Literals
(
typeNatTyCons
)
import
GHC.Hs.Doc
...
...
compiler/GHC/ByteCode/Asm.hs
View file @
af332442
...
...
@@ -15,7 +15,7 @@ module GHC.ByteCode.Asm (
#
include
"HsVersions.h"
import
G
hc
Prelude
import
G
HC.
Prelude
import
GHC.ByteCode.Instr
import
GHC.ByteCode.InfoTable
...
...
@@ -28,13 +28,13 @@ import GHC.Types.Name
import
GHC.Types.Name.Set
import
GHC.Types.Literal
import
GHC.Core.TyCon
import
FastString
import
GHC.Data.
FastString
import
GHC.StgToCmm.Layout
(
ArgRep
(
..
)
)
import
GHC.Runtime.Heap.Layout
import
GHC.Driver.Session
import
Outputable
import
GHC.Utils.
Outputable
import
GHC.Platform
import
Util
import
GHC.Utils.Misc
import
GHC.Types.Unique
import
GHC.Types.Unique.DSet
...
...
compiler/GHC/ByteCode/InfoTable.hs
View file @
af332442
...
...
@@ -9,7 +9,7 @@ module GHC.ByteCode.InfoTable ( mkITbls ) where
#
include
"HsVersions.h"
import
G
hc
Prelude
import
G
HC.
Prelude
import
GHC.ByteCode.Types
import
GHC.Runtime.Interpreter
...
...
@@ -22,8 +22,8 @@ import GHC.Core.TyCon ( TyCon, tyConFamilySize, isDataTyCon, tyConDataCons
import
GHC.Types.RepType
import
GHC.StgToCmm.Layout
(
mkVirtConstrSizes
)
import
GHC.StgToCmm.Closure
(
tagForCon
,
NonVoid
(
..
)
)
import
Util
import
Panic
import
GHC.Utils.Misc
import
GHC.Utils.
Panic
{-
Manufacturing of info tables for DataCons
...
...
compiler/GHC/ByteCode/Instr.hs
View file @
af332442
...
...
@@ -11,15 +11,15 @@ module GHC.ByteCode.Instr (
#
include
"HsVersions.h"
import
G
hc
Prelude
import
G
HC.
Prelude
import
GHC.ByteCode.Types
import
GHCi.RemoteTypes
import
GHCi.FFI
(
C_ffi_cif
)
import
GHC.StgToCmm.Layout
(
ArgRep
(
..
)
)
import
GHC.Core.Ppr
import
Outputable
import
FastString
import
GHC.Utils.
Outputable
import
GHC.Data.
FastString
import
GHC.Types.Name
import
GHC.Types.Unique
import
GHC.Types.Id
...
...
compiler/GHC/ByteCode/Linker.hs
View file @
af332442
...
...
@@ -18,7 +18,7 @@ module GHC.ByteCode.Linker (
#
include
"HsVersions.h"
import
G
hc
Prelude
import
G
HC.
Prelude
import
GHCi.RemoteTypes
import
GHCi.ResolvedBCO
...
...
@@ -32,10 +32,10 @@ import GHC.Types.Name
import
GHC.Types.Name.Env
import
GHC.Builtin.PrimOps
import
GHC.Types.Module
import
FastString
import
Panic
import
Outputable
import
Util
import
GHC.Data.
FastString
import
GHC.Utils.
Panic
import
GHC.Utils.
Outputable
import
GHC.Utils.Misc
-- Standard libraries
import
Data.Array.Unboxed
...
...
compiler/GHC/ByteCode/Types.hs
View file @
af332442
...
...
@@ -13,13 +13,13 @@ module GHC.ByteCode.Types
,
CCostCentre
)
where
import
G
hc
Prelude
import
G
HC.
Prelude
import
FastString
import
GHC.Data.
FastString
import
GHC.Types.Id
import
GHC.Types.Name
import
GHC.Types.Name.Env
import
Outputable
import
GHC.Utils.
Outputable
import
GHC.Builtin.PrimOps
import
SizedSeq
import
GHC.Core.Type
...
...
compiler/GHC/Cmm.hs
View file @
af332442
...
...
@@ -28,7 +28,7 @@ module GHC.Cmm (
module
GHC
.
Cmm
.
Expr
,
)
where
import
G
hc
Prelude
import
G
HC.
Prelude
import
GHC.Types.Id
import
GHC.Types.CostCentre
...
...
@@ -41,7 +41,7 @@ import GHC.Cmm.Dataflow.Block
import
GHC.Cmm.Dataflow.Collections
import
GHC.Cmm.Dataflow.Graph
import
GHC.Cmm.Dataflow.Label
import
Outputable
import
GHC.Utils.
Outputable
import
Data.ByteString
(
ByteString
)
-----------------------------------------------------------------------------
...
...
compiler/GHC/Cmm/BlockId.hs
View file @
af332442
...
...
@@ -8,7 +8,7 @@ module GHC.Cmm.BlockId
,
blockLbl
,
infoTblLbl
)
where
import
G
hc
Prelude
import
G
HC.
Prelude
import
GHC.Cmm.CLabel
import
GHC.Types.Id.Info
...
...
compiler/GHC/Cmm/CLabel.hs
View file @
af332442
...
...
@@ -114,7 +114,7 @@ module GHC.Cmm.CLabel (
#
include
"HsVersions.h"
import
G
hc
Prelude
import
G
HC.
Prelude
import
GHC.Types.Id.Info
import
GHC.Types.Basic
...
...
@@ -125,12 +125,12 @@ import GHC.Types.Name
import
GHC.Types.Unique
import
GHC.Builtin.PrimOps
import
GHC.Types.CostCentre
import
Outputable
import
FastString
import
GHC.Utils.
Outputable
import
GHC.Data.
FastString
import
GHC.Driver.Session
import
GHC.Platform
import
GHC.Types.Unique.Set
import
Util
import
GHC.Utils.Misc
import
GHC.Core.Ppr
(
{- instances -}
)
import
GHC.CmmToAsm.Config
...
...
compiler/GHC/Cmm/CallConv.hs
View file @
af332442
...
...
@@ -5,7 +5,7 @@ module GHC.Cmm.CallConv (
realArgRegsCover
)
where
import
G
hc
Prelude
import
G
HC.
Prelude
import
GHC.Cmm.Expr
import
GHC.Runtime.Heap.Layout
...
...
@@ -14,7 +14,7 @@ import GHC.Cmm.Ppr () -- For Outputable instances
import
GHC.Driver.Session
import
GHC.Platform
import
Outputable
import
GHC.Utils.
Outputable
-- Calculate the 'GlobalReg' or stack locations for function call
-- parameters as used by the Cmm calling convention.
...
...
Prev
1
2
3
4
5
…
29
Next
Sylvain Henry
@hsyl20
mentioned in merge request
!3130 (closed)
·
Apr 27, 2020
mentioned in merge request
!3130 (closed)
mentioned in merge request !3130
Toggle commit list
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Attach a 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