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
99a9f51b
Commit
99a9f51b
authored
Jan 02, 2020
by
Sylvain Henry
Committed by
Marge Bot
Jan 06, 2020
Browse files
Module hierarchy: Iface (cf
#13009
)
parent
5ffea0c6
Pipeline
#14295
failed with stages
in 542 minutes and 34 seconds
Changes
99
Pipelines
2
Hide whitespace changes
Inline
Side-by-side
compiler/
iface/
ToIface.hs
→
compiler/
GHC/Core
ToIface.hs
View file @
99a9f51b
...
...
@@ -2,7 +2,7 @@
{-# LANGUAGE Strict #-}
-- See Note [Avoiding space leaks in toIface*]
-- | Functions for converting Core things to interface file things.
module
ToIface
module
GHC.Core
ToIface
(
-- * Binders
toIfaceTvBndr
,
toIfaceTvBndrs
...
...
@@ -47,7 +47,7 @@ module ToIface
import
GhcPrelude
import
IfaceSyn
import
GHC.
Iface
.
Syn
tax
import
DataCon
import
Id
import
IdInfo
...
...
@@ -86,8 +86,9 @@ after code gen has run, in which case we might carry megabytes of core
AST in the heap which is no longer needed.
We avoid this in two ways.
* First we use -XStrict in ToIface which avoids many thunks to begin with.
* Second we define NFData instance for IFaceSyn and use them to
* First we use -XStrict in GHC.CoreToIface which avoids many thunks
to begin with.
* Second we define NFData instance for Iface syntax and use them to
force any remaining thunks.
-XStrict is not sufficient as patterns of the form `f (g x)` would still
...
...
@@ -156,13 +157,13 @@ toIfaceTypeX :: VarSet -> Type -> IfaceType
-- translates the tyvars in 'free' as IfaceFreeTyVars
--
-- Synonyms are retained in the interface type
toIfaceTypeX
fr
(
TyVarTy
tv
)
-- See Note [TcTyVars in IfaceType] in IfaceType
toIfaceTypeX
fr
(
TyVarTy
tv
)
-- See Note [TcTyVars in IfaceType] in
GHC.
Iface
.
Type
|
tv
`
elemVarSet
`
fr
=
IfaceFreeTyVar
tv
|
otherwise
=
IfaceTyVar
(
toIfaceTyVar
tv
)
toIfaceTypeX
fr
ty
@
(
AppTy
{})
=
-- Flatten as many argument AppTys as possible, then turn them into an
-- IfaceAppArgs list.
-- See Note [Suppressing invisible arguments] in IfaceType.
-- See Note [Suppressing invisible arguments] in
GHC.
Iface
.
Type.
let
(
head
,
args
)
=
splitAppTys
ty
in
IfaceAppTy
(
toIfaceTypeX
fr
head
)
(
toIfaceAppTyArgsX
fr
head
args
)
toIfaceTypeX
_
(
LitTy
n
)
=
IfaceLitTy
(
toIfaceTyLit
n
)
...
...
@@ -268,7 +269,7 @@ toIfaceCoercionX fr co
go
(
Refl
ty
)
=
IfaceReflCo
(
toIfaceTypeX
fr
ty
)
go
(
GRefl
r
ty
mco
)
=
IfaceGReflCo
r
(
toIfaceTypeX
fr
ty
)
(
go_mco
mco
)
go
(
CoVarCo
cv
)
-- See [TcTyVars in IfaceType] in IfaceType
-- See [TcTyVars in IfaceType] in
GHC.
Iface
.
Type
|
cv
`
elemVarSet
`
fr
=
IfaceFreeCoVar
cv
|
otherwise
=
IfaceCoVarCo
(
toIfaceCoVar
cv
)
go
(
HoleCo
h
)
=
IfaceHoleCo
(
coHoleCoVar
h
)
...
...
@@ -314,7 +315,7 @@ toIfaceAppTyArgsX :: VarSet -> Type -> [Type] -> IfaceAppArgs
toIfaceAppTyArgsX
fr
ty
ty_args
=
toIfaceAppArgsX
fr
(
typeKind
ty
)
ty_args
toIfaceAppArgsX
::
VarSet
->
Kind
->
[
Type
]
->
IfaceAppArgs
-- See Note [Suppressing invisible arguments] in IfaceType
-- See Note [Suppressing invisible arguments] in
GHC.
Iface
.
Type
-- We produce a result list of args describing visibility
-- The awkward case is
-- T :: forall k. * -> k
...
...
@@ -422,7 +423,7 @@ toIfaceLetBndr id = IfLetBndr (occNameFS (getOccName id))
(
toIfaceIdInfo
(
idInfo
id
))
(
toIfaceJoinInfo
(
isJoinId_maybe
id
))
-- Put into the interface file any IdInfo that CoreTidy.tidyLetBndr
-- has left on the Id. See Note [IdInfo on nested let-bindings] in IfaceSyn
-- has left on the Id. See Note [IdInfo on nested let-bindings] in
GHC.
Iface
.
Syn
tax
toIfaceIdDetails
::
IdDetails
->
IfaceIdDetails
toIfaceIdDetails
VanillaId
=
IfVanillaId
...
...
@@ -446,7 +447,7 @@ toIfaceIdInfo id_info
[]
->
NoInfo
infos
->
HasInfo
infos
-- NB: strictness and arity must appear in the list before unfolding
-- See
TcIfac
e.tcUnfolding
-- See
GHC.IfaceToCor
e.tcUnfolding
where
------------ Arity --------------
arity_info
=
arityInfo
id_info
...
...
@@ -497,7 +498,7 @@ toIfUnfolding lb (CoreUnfolding { uf_tmpl = rhs
InlineCompulsory
->
IfCompulsory
if_rhs
InlineRhs
->
IfCoreUnfold
False
if_rhs
-- Yes, even if guidance is UnfNever, expose the unfolding
-- If we didn't want to expose the unfolding, Tidy
Pgm
would
-- If we didn't want to expose the unfolding,
GHC.Iface.
Tidy would
-- have stuck in NoUnfolding. For supercompilation we want
-- to see that unfolding!
where
...
...
compiler/
iface/
ToIface.hs-boot
→
compiler/
GHC/Core
ToIface.hs-boot
View file @
99a9f51b
module
ToIface
where
module
GHC.Core
ToIface
where
import
{-#
SOURCE
#-
}
TyCoRep
(
Type
,
TyLit
,
Coercion
)
import
{-#
SOURCE
#-
}
IfaceType
(
IfaceType
,
IfaceTyCon
,
IfaceForAllBndr
,
IfaceCoercion
,
IfaceTyLit
,
IfaceAppArgs
)
import
{-#
SOURCE
#-
}
GHC
.
Iface
.
Type
(
IfaceType
,
IfaceTyCon
,
IfaceForAllBndr
,
IfaceCoercion
,
IfaceTyLit
,
IfaceAppArgs
)
import
Var
(
TyCoVarBinder
)
import
VarEnv
(
TidyEnv
)
import
TyCon
(
TyCon
)
...
...
compiler/GHC/CoreToStg/Prep.hs
View file @
99a9f51b
...
...
@@ -228,7 +228,7 @@ corePrepTopBinds initialCorePrepEnv binds
mkDataConWorkers
::
DynFlags
->
ModLocation
->
[
TyCon
]
->
[
CoreBind
]
-- See Note [Data constructor workers]
-- c.f. Note [Injecting implicit bindings] in Tidy
Pgm
-- c.f. Note [Injecting implicit bindings] in
GHC.Iface.
Tidy
mkDataConWorkers
dflags
mod_loc
data_tycons
=
[
NonRec
id
(
tick_it
(
getName
data_con
)
(
Var
id
))
-- The ice is thin here, but it works
...
...
@@ -1070,8 +1070,8 @@ unsaturated applications (identified by 'hasNoBinding', currently just
foreign calls and unboxed tuple/sum constructors).
Note that eta expansion in CorePrep is very fragile due to the "prediction" of
CAFfyness made
by TidyPgm
(see Note [CAFfyness inconsistencies due to eta
expansion in CorePrep] in Tidy
Pgm
for details. We previously saturated primop
CAFfyness made
during tidying
(see Note [CAFfyness inconsistencies due to eta
expansion in CorePrep] in
GHC.Iface.
Tidy for details. We previously saturated primop
applications here as well but due to this fragility (see #16846) we now deal
with this another way, as described in Note [Primop wrappers] in PrimOp.
...
...
compiler/GHC/Hs/Types.hs
View file @
99a9f51b
...
...
@@ -1686,7 +1686,7 @@ hsTypeNeedsParens p = go
maybeAddSpace
::
[
LHsType
pass
]
->
SDoc
->
SDoc
-- See Note [Printing promoted type constructors]
-- in IfaceType. This code implements the same
-- in
GHC.
Iface
.
Type. This code implements the same
-- logic for printing HsType
maybeAddSpace
tys
doc
|
(
ty
:
_
)
<-
tys
...
...
compiler/
i
face/Bin
Iface
.hs
→
compiler/
GHC/I
face/Bin
ary
.hs
View file @
99a9f51b
...
...
@@ -9,7 +9,7 @@
-- compiler is severely affected
-- | Binary interface file support.
module
Bin
Iface
(
module
GHC.
Iface
.Binary
(
-- * Public API for interface file serialisation
writeBinIface
,
readBinIface
,
...
...
@@ -37,7 +37,7 @@ import GhcPrelude
import
TcRnMonad
import
PrelInfo
(
isKnownKeyName
,
lookupKnownKeyName
)
import
IfaceEnv
import
GHC.
Iface
.
Env
import
HscTypes
import
Module
import
Name
...
...
compiler/
iface
/IfaceEnv.hs
→
compiler/
GHC
/Iface
/
Env.hs
View file @
99a9f51b
...
...
@@ -2,7 +2,7 @@
{-# LANGUAGE CPP, RankNTypes, BangPatterns #-}
module
IfaceEnv
(
module
GHC.
Iface
.
Env
(
newGlobalBinder
,
newInteractiveBinder
,
externaliseName
,
lookupIfaceTop
,
...
...
@@ -33,7 +33,7 @@ import Avail
import
Module
import
FastString
import
FastStringEnv
import
IfaceType
import
GHC.
Iface
.
Type
import
NameCache
import
UniqSupply
import
SrcLoc
...
...
@@ -149,7 +149,7 @@ updNameCacheIO hsc_env mod occ upd_fn = do {
-- we read the name-cache
-- then pull on mod (say)
-- which does some stuff that modifies the name cache
-- This did happen, with tycon_mod in
TcIfac
e.tcIfaceAlt (DataAlt..)
-- This did happen, with tycon_mod in
GHC.IfaceToCor
e.tcIfaceAlt (DataAlt..)
mod
`
seq
`
occ
`
seq
`
return
()
;
updNameCache
(
hsc_NC
hsc_env
)
upd_fn
}
...
...
compiler/
iface
/IfaceEnv.hs-boot
→
compiler/
GHC
/Iface
/
Env.hs-boot
View file @
99a9f51b
module
IfaceEnv
where
module
GHC.
Iface
.
Env
where
import
Module
import
OccName
...
...
compiler/
hieFile/Hie
Ast.hs
→
compiler/
GHC/Iface/Ext/
Ast.hs
View file @
99a9f51b
...
...
@@ -12,7 +12,7 @@ Main functions for .hie file generation
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE DeriveDataTypeable #-}
module
Hie
Ast
(
mkHieFile
)
where
module
GHC.Iface.Ext.
Ast
(
mkHieFile
)
where
import
GhcPrelude
...
...
@@ -37,11 +37,11 @@ import Type ( mkVisFunTys, Type )
import
TysWiredIn
(
mkListTy
,
mkSumTy
)
import
Var
(
Id
,
Var
,
setVarName
,
varName
,
varType
)
import
TcRnTypes
import
Mk
Iface
(
mkIfaceExports
)
import
GHC.
Iface
.Utils
(
mkIfaceExports
)
import
Panic
import
Hie
Types
import
Hie
Utils
import
GHC.Iface.Ext.
Types
import
GHC.Iface.Ext.
Utils
import
qualified
Data.Array
as
A
import
qualified
Data.ByteString
as
BS
...
...
@@ -81,7 +81,7 @@ instance ToHie (IEContext (Located ModuleName)) where ...
data Context a = C ContextInfo a -- Used for names and bindings
`ContextInfo` is defined in `
Hie
Types`, and looks like
`ContextInfo` is defined in `
GHC.Iface.Ext.
Types`, and looks like
data ContextInfo
= Use -- ^ regular variable
...
...
@@ -112,7 +112,7 @@ provide a `Scope` and a `Span` for your binding. Both of these are basically
The `SrcSpan` in the `Scope` is supposed to span over the part of the source
where the symbol can be legally allowed to occur. For more details on how to
calculate this, see Note [Capturing Scopes and other non local information]
in
Hie
Ast.
in
GHC.Iface.Ext.
Ast.
The binding `Span` is supposed to be the span of the entire binding for
the name.
...
...
compiler/
hieFile/HieBin
.hs
→
compiler/
GHC/Iface/Ext/Binary
.hs
View file @
99a9f51b
...
...
@@ -2,14 +2,25 @@
Binary serialization for .hie files.
-}
{-# LANGUAGE ScopedTypeVariables #-}
module
HieBin
(
readHieFile
,
readHieFileWithVersion
,
HieHeader
,
writeHieFile
,
HieName
(
..
),
toHieName
,
HieFileResult
(
..
),
hieMagic
,
hieNameOcc
)
where
module
GHC.Iface.Ext.Binary
(
readHieFile
,
readHieFileWithVersion
,
HieHeader
,
writeHieFile
,
HieName
(
..
)
,
toHieName
,
HieFileResult
(
..
)
,
hieMagic
,
hieNameOcc
)
where
import
GHC.Settings
(
maybeRead
)
import
Config
(
cProjectVersion
)
import
GhcPrelude
import
Binary
import
Bin
Iface
(
getDictFastString
)
import
GHC.
Iface
.Binary
(
getDictFastString
)
import
FastMutInt
import
FastString
(
FastString
)
import
Module
(
Module
)
...
...
@@ -33,7 +44,7 @@ import Control.Monad ( replicateM, when )
import
System.Directory
(
createDirectoryIfMissing
)
import
System.FilePath
(
takeDirectory
)
import
Hie
Types
import
GHC.Iface.Ext.
Types
-- | `Name`'s get converted into `HieName`'s before being written into @.hie@
-- files. See 'toHieName' and 'fromHieName' for logic on how to convert between
...
...
@@ -389,4 +400,4 @@ getHieName bh = do
2
->
do
(
c
,
i
)
<-
get
bh
return
$
KnownKeyName
$
mkUnique
c
i
_
->
panic
"
HieBin
.getHieName: invalid tag"
_
->
panic
"
GHC.Iface.Ext.Binary
.getHieName: invalid tag"
compiler/
hieFile/Hie
Debug.hs
→
compiler/
GHC/Iface/Ext/
Debug.hs
View file @
99a9f51b
...
...
@@ -4,7 +4,8 @@ Functions to validate and check .hie file ASTs generated by GHC.
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
module
HieDebug
where
module
GHC.Iface.Ext.Debug
where
import
GhcPrelude
...
...
@@ -13,9 +14,9 @@ import Module
import
FastString
import
Outputable
import
Hie
Types
import
HieBin
import
Hie
Utils
import
GHC.Iface.Ext.
Types
import
GHC.Iface.Ext.Binary
import
GHC.Iface.Ext.
Utils
import
Name
import
qualified
Data.Map
as
M
...
...
compiler/
hieFile/Hie
Types.hs
→
compiler/
GHC/Iface/Ext/
Types.hs
View file @
99a9f51b
...
...
@@ -8,14 +8,14 @@ For more information see https://gitlab.haskell.org/ghc/ghc/wikis/hie-files
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
module
Hie
Types
where
module
GHC.Iface.Ext.
Types
where
import
GhcPrelude
import
Config
import
Binary
import
FastString
(
FastString
)
import
IfaceType
import
GHC.
Iface
.
Type
import
Module
(
ModuleName
,
Module
)
import
Name
(
Name
)
import
Outputable
hiding
(
(
<>
)
)
...
...
compiler/
hieFile/Hie
Utils.hs
→
compiler/
GHC/Iface/Ext/
Utils.hs
View file @
99a9f51b
...
...
@@ -2,25 +2,25 @@
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleInstances #-}
module
Hie
Utils
where
module
GHC.Iface.Ext.
Utils
where
import
GhcPrelude
import
CoreMap
import
DynFlags
(
DynFlags
)
import
FastString
(
FastString
,
mkFastString
)
import
IfaceType
import
GHC.
Iface
.
Type
import
Name
hiding
(
varName
)
import
Outputable
(
renderWithStyle
,
ppr
,
defaultUserStyle
)
import
SrcLoc
import
ToIface
import
GHC.Core
ToIface
import
TyCon
import
TyCoRep
import
Type
import
Var
import
VarEnv
import
Hie
Types
import
GHC.Iface.Ext.
Types
import
qualified
Data.Map
as
M
import
qualified
Data.Set
as
S
...
...
compiler/
i
face/Load
Iface
.hs
→
compiler/
GHC/I
face/Load.hs
View file @
99a9f51b
...
...
@@ -9,7 +9,7 @@ Loading interface files
{-# LANGUAGE CPP, BangPatterns, RecordWildCards, NondecreasingIndentation #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module
Load
Iface
(
module
GHC.
Iface
.Load
(
-- Importing one thing
tcLookupImported_maybe
,
importDecl
,
checkWiredInTyCon
,
ifCheckWiredInThing
,
...
...
@@ -23,7 +23,7 @@ module LoadIface (
loadInterface
,
loadSysInterface
,
loadUserInterface
,
loadPluginInterface
,
findAndReadIface
,
readIface
,
-- Used when reading the module's old interface
loadDecls
,
-- Should move to
TcIfac
e and be renamed
loadDecls
,
-- Should move to
GHC.IfaceToCor
e and be renamed
initExternalPackageState
,
moduleFreeHolesPrecise
,
needWiredInHomeIface
,
loadWiredInHomeIface
,
...
...
@@ -36,13 +36,13 @@ module LoadIface (
import
GhcPrelude
import
{-#
SOURCE
#-
}
Tc
Iface
(
tcIfaceDecl
,
tcIfaceRules
,
tcIfaceInst
,
tcIfaceFamInst
,
tcIfaceAnnotations
,
tcIfaceCompleteSigs
)
import
{-#
SOURCE
#-
}
GHC
.
Iface
ToCore
(
tcIfaceDecl
,
tcIfaceRules
,
tcIfaceInst
,
tcIfaceFamInst
,
tcIfaceAnnotations
,
tcIfaceCompleteSigs
)
import
DynFlags
import
IfaceSyn
import
IfaceEnv
import
GHC.
Iface
.
Syn
tax
import
GHC.
Iface
.
Env
import
HscTypes
import
BasicTypes
hiding
(
SuccessFlag
(
..
))
...
...
@@ -69,14 +69,14 @@ import Finder
import
UniqFM
import
SrcLoc
import
Outputable
import
Bin
Iface
import
GHC.
Iface
.Binary
import
Panic
import
Util
import
FastString
import
Fingerprint
import
Hooks
import
FieldLabel
import
RnModIfac
e
import
GHC.Iface.Renam
e
import
UniqDSet
import
Plugins
...
...
@@ -187,8 +187,8 @@ for any module with an instance decl or RULE that we might want.
* BUT, if the TyCon is a wired-in TyCon, we don't really need its interface;
but we must make sure we read its interface in case it has instances or
rules. That is what
Load
Iface.loadWiredInHomeIface does. It's called
from
TcIfac
e.{tcImportDecl, checkWiredInTyCon, ifCheckWiredInThing}
rules. That is what
GHC.
Iface.
Load.
loadWiredInHomeIface does. It's called
from
GHC.IfaceToCor
e.{tcImportDecl, checkWiredInTyCon, ifCheckWiredInThing}
* HOWEVER, only do this for TyCons. There are no wired-in Classes. There
are some wired-in Ids, but we don't want to load their interfaces. For
...
...
@@ -486,7 +486,7 @@ loadInterface doc_str mod from
-- Warn warn against an EPS-updating import
-- of one's own boot file! (one-shot only)
-- See Note [Loading your own hi-boot file]
-- in
Mk
Iface.
-- in
GHC.
Iface.
Utils.
;
WARN
(
bad_boot
,
ppr
mod
)
updateEps_
$
\
eps
->
...
...
@@ -535,7 +535,7 @@ loadInterface doc_str mod from
Generally speaking, when compiling module M, we should not
load M.hi boot into the EPS. After all, we are very shortly
going to have full information about M. Moreover, see
Note [Do not update EPS with your own hi-boot] in
Mk
Iface.
Note [Do not update EPS with your own hi-boot] in
GHC.
Iface.
Utils.
But there is a HORRIBLE HACK here.
...
...
compiler/
i
face/Load
Iface
.hs-boot
→
compiler/
GHC/I
face/Load.hs-boot
View file @
99a9f51b
module
LoadIface
where
module
GHC.Iface.Load
where
import
Module
(
Module
)
import
TcRnMonad
(
IfM
)
import
HscTypes
(
ModIface
)
...
...
compiler/
backpack/RnModIfac
e.hs
→
compiler/
GHC/Iface/Renam
e.hs
View file @
99a9f51b
...
...
@@ -6,7 +6,7 @@
-- are doing indefinite typechecking and need instantiations
-- of modules which do not necessarily exist yet.
module
RnModIface
(
module
GHC.Iface.Rename
(
rnModIface
,
rnModExports
,
tcRnModIface
,
...
...
@@ -23,7 +23,7 @@ import HscTypes
import
Module
import
UniqFM
import
Avail
import
IfaceSyn
import
GHC.
Iface
.
Syn
tax
import
FieldLabel
import
Var
import
ErrUtils
...
...
@@ -35,7 +35,7 @@ import Fingerprint
import
BasicTypes
-- a bit vexing
import
{-#
SOURCE
#-
}
Load
Iface
import
{-#
SOURCE
#-
}
GHC
.
Iface
.
Load
import
DynFlags
import
qualified
Data.Traversable
as
T
...
...
@@ -43,7 +43,7 @@ import qualified Data.Traversable as T
import
Bag
import
Data.IORef
import
NameShape
import
IfaceEnv
import
GHC.
Iface
.
Env
tcRnMsgMaybe
::
IO
(
Either
ErrorMessages
a
)
->
TcM
a
tcRnMsgMaybe
do_this
=
do
...
...
compiler/
iface
/IfaceSyn.hs
→
compiler/
GHC
/Iface
/
Syn
tax
.hs
View file @
99a9f51b
...
...
@@ -6,8 +6,8 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
module
IfaceSyn
(
module
IfaceType
,
module
GHC.
Iface
.
Syn
tax
(
module
GHC
.
Iface
.
Type
,
IfaceDecl
(
..
),
IfaceFamTyConFlav
(
..
),
IfaceClassOp
(
..
),
IfaceAT
(
..
),
IfaceConDecl
(
..
),
IfaceConDecls
(
..
),
IfaceEqSpec
,
...
...
@@ -44,7 +44,7 @@ module IfaceSyn (
import
GhcPrelude
import
IfaceType
import
GHC.
Iface
.
Type
import
BinFingerprint
import
CoreSyn
(
IsOrphan
,
isOrphan
)
import
DynFlags
(
gopt
,
GeneralFlag
(
Opt_PrintAxiomIncomps
)
)
...
...
@@ -90,8 +90,8 @@ infixl 3 &&&
-- | A binding top-level 'Name' in an interface file (e.g. the name of an
-- 'IfaceDecl').
type
IfaceTopBndr
=
Name
-- It's convenient to have a Name in the Iface
Syn
, although in each
-- case the namespace is implied by the context. However, having a
n
-- It's convenient to have a Name in the Iface
syntax
, although in each
-- case the namespace is implied by the context. However, having a
-- Name makes things like ifaceDeclImplicitBndrs and ifaceDeclFingerprints
-- very convenient. Moreover, having the key of the binder means that
-- we can encode known-key things cleverly in the symbol table. See Note
...
...
@@ -187,8 +187,8 @@ data IfaceTyConParent
=
IfNoParent
|
IfDataInstance
IfExtName
-- Axiom name
IfaceTyCon
-- Family TyCon (pretty-printing only, not used in
TcIfac
e)
-- see Note [Pretty printing via Iface
Syn
] in PprTyThing
IfaceTyCon
-- Family TyCon (pretty-printing only, not used in
GHC.IfaceToCor
e)
-- see Note [Pretty printing via Iface
syntax
] in PprTyThing
IfaceAppArgs
-- Arguments of the family TyCon
data
IfaceFamTyConFlav
...
...
@@ -197,7 +197,7 @@ data IfaceFamTyConFlav
|
IfaceClosedSynFamilyTyCon
(
Maybe
(
IfExtName
,
[
IfaceAxBranch
]))
-- ^ Name of associated axiom and branches for pretty printing purposes,
-- or 'Nothing' for an empty closed family without an axiom
-- See Note [Pretty printing via Iface
Syn
] in PprTyThing
-- See Note [Pretty printing via Iface
syntax
] in PprTyThing
|
IfaceAbstractClosedSynFamilyTyCon
|
IfaceBuiltInSynFamTyCon
-- for pretty printing purposes only
...
...
@@ -405,7 +405,7 @@ ifaceDeclImplicitBndrs :: IfaceDecl -> [OccName]
-- N.B. the set of names returned here *must* match the set of
-- TyThings returned by HscTypes.implicitTyThings, in the sense that
-- TyThing.getOccName should define a bijection between the two lists.
-- This invariant is used in
Load
Iface.loadDecl (see note [Tricky iface loop])
-- This invariant is used in
GHC.
Iface.
Load.
loadDecl (see note [Tricky iface loop])
-- The order of the list does not matter.
ifaceDeclImplicitBndrs
(
IfaceData
{
ifName
=
tc_name
,
ifCons
=
cons
})
...
...
@@ -528,9 +528,9 @@ data IfaceJoinInfo = IfaceNotJoinPoint
{-
Note [Empty case alternatives]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
In Iface
Syn
an IfaceCase does not record the types of the alternatives,
unlike Cor
Syn
Case.
But we need this type if the alternatives are empty.
Hence IfaceECase.
See Note [Empty case alternatives] in CoreSyn.
In Iface
syntax
an IfaceCase does not record the types of the alternatives,
unlike Cor
e syntax
Case. But we need this type if the alternatives are empty.
Hence IfaceECase. See Note [Empty case alternatives] in CoreSyn.
Note [Expose recursive functions]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
...
...
@@ -599,7 +599,7 @@ pprAxBranch pp_tc idx (IfaceAxBranch { ifaxbTyVars = tvs
$+$
nest
4
maybe_incomps
where
-- See Note [Printing foralls in type family instances] in IfaceType
-- See Note [Printing foralls in type family instances] in
GHC.
Iface
.
Type
ppr_binders
=
maybe_index
<+>
pprUserIfaceForAll
(
map
(
mkIfaceForAllTvBndr
Specified
)
tvs
)
pp_lhs
=
hang
pp_tc
2
(
pprParendIfaceAppArgs
pat_tys
)
...
...
@@ -763,7 +763,7 @@ pprIfaceDecl ss (IfaceData { ifName = tycon, ifCType = ctype,
,
nest
2
$
ppShowIface
ss
pp_extra
]
where
is_data_instance
=
isIfaceDataInstance
parent
-- See Note [Printing foralls in type family instances] in IfaceType
-- See Note [Printing foralls in type family instances] in
GHC.
Iface
.
Type
pp_data_inst_forall
::
SDoc
pp_data_inst_forall
=
pprUserIfaceForAll
forall_bndrs
...
...
@@ -807,7 +807,7 @@ pprIfaceDecl ss (IfaceData { ifName = tycon, ifCType = ctype,
pp_ki_sig
=
ppWhen
ki_sig_printable
$
pprStandaloneKindSig
name_doc
(
mkIfaceTyConKind
binders
kind
)
-- See Note [Suppressing binder signatures] in IfaceType
-- See Note [Suppressing binder signatures] in
GHC.
Iface
.
Type
suppress_bndr_sig
=
SuppressBndrSig
ki_sig_printable
name_doc
=
pprPrefixIfDeclBndr
(
ss_how_much
ss
)
(
occName
tycon
)
...
...
@@ -837,7 +837,7 @@ pprIfaceDecl ss (IfaceClass { ifName = clas
,
pprClassStandaloneKindSig
ss
clas
(
mkIfaceTyConKind
binders
constraintIfaceKind
)
,
text
"class"
<+>
pprIfaceDeclHead
suppress_bndr_sig
[]
ss
clas
binders
<+>
pprFundeps
fds
]
where
-- See Note [Suppressing binder signatures] in IfaceType
-- See Note [Suppressing binder signatures] in
GHC.
Iface
.
Type
suppress_bndr_sig
=
SuppressBndrSig
True
pprIfaceDecl
ss
(
IfaceClass
{
ifName
=
clas
...
...
@@ -878,7 +878,7 @@ pprIfaceDecl ss (IfaceClass { ifName = clas
(
\
_
def
->
cparen
(
isLexSym
def
)
(
ppr
def
))
0
minDef
<+>
text
"#-}"
-- See Note [Suppressing binder signatures] in IfaceType
-- See Note [Suppressing binder signatures] in
GHC.
Iface
.
Type
suppress_bndr_sig
=
SuppressBndrSig
True
pprIfaceDecl
ss
(
IfaceSynonym
{
ifName
=
tc
...
...
@@ -894,7 +894,7 @@ pprIfaceDecl ss (IfaceSynonym { ifName = tc
(
tvs
,
theta
,
tau
)
=
splitIfaceSigmaTy
mono_ty
name_doc
=
pprPrefixIfDeclBndr
(
ss_how_much
ss
)
(
occName
tc
)
-- See Note [Suppressing binder signatures] in IfaceType
-- See Note [Suppressing binder signatures] in
GHC.
Iface
.
Type
suppress_bndr_sig
=
SuppressBndrSig
True
pprIfaceDecl
ss
(
IfaceFamily
{
ifName
=
tycon
...
...
@@ -951,7 +951,7 @@ pprIfaceDecl ss (IfaceFamily { ifName = tycon
$$
ppShowIface
ss
(
text
"axiom"
<+>
ppr
ax
)
pp_branches
_
=
Outputable
.
empty
-- See Note [Suppressing binder signatures] in IfaceType
-- See Note [Suppressing binder signatures] in
GHC.
Iface
.
Type
suppress_bndr_sig
=
SuppressBndrSig
True
pprIfaceDecl
_
(
IfacePatSyn
{
ifName
=
name
,
...
...
@@ -1417,11 +1417,11 @@ instance Outputable IfaceUnfolding where
{-
************************************************************************
* *
Finding the Names in Iface
Syn
Finding the Names in Iface
syntax
* *
************************************************************************
This is used for dependency analysis in
Mk
Iface, so that we
This is used for dependency analysis in
GHC.
Iface
.Utils
, so that we
fingerprint a declaration before the things that depend on it. It
is specific to interface-file fingerprinting in the sense that we
don't collect *all* Names: for example, the DFun of an instance is
...
...
@@ -1945,7 +1945,7 @@ knot in the type checker. It saved ~1% of the total build time of GHC.
When we read an interface file, we extend the PTE, a mapping of Names
to TyThings, with the declarations we have read. The extension of the
PTE is strict in the Names, but not in the TyThings themselves.
Load
Iface.loadDecl calculates the list of (Name, TyThing) bindings to
GHC.
Iface.
Load.
loadDecl calculates the list of (Name, TyThing) bindings to
add to the PTE. For an IfaceId, there's just one binding to add; and
the ty, details, and idinfo fields of an IfaceId are used only in the
TyThing. So by reading those fields lazily we may be able to save the
...
...
@@ -2423,7 +2423,7 @@ instance Binary IfaceCompleteMatch where
************************************************************************
* *
NFData instances
See Note [Avoiding space leaks in toIface*] in ToIface
See Note [Avoiding space leaks in toIface*] in
GHC.Core
ToIface
* *
************************************************************************
-}
...
...
compiler/
main
/Tidy
Pgm
.hs
→
compiler/
GHC/Iface
/Tidy.hs
View file @
99a9f51b
...
...
@@ -6,7 +6,7 @@