Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
GHC
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Locked Files
Issues
4,249
Issues
4,249
List
Boards
Labels
Service Desk
Milestones
Iterations
Merge Requests
391
Merge Requests
391
Requirements
Requirements
List
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Security & Compliance
Security & Compliance
Dependency List
License Compliance
Operations
Operations
Incidents
Environments
Analytics
Analytics
CI / CD
Code Review
Insights
Issue
Repository
Value Stream
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
5aba5d32
Commit
5aba5d32
authored
Nov 20, 2019
by
Vladislav Zavialov
Committed by
Marge Bot
Nov 30, 2019
2
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Remove HasSrcSpan (
#17494
)
Metric Decrease: haddock.compiler
parent
316f2431
Pipeline
#13331
failed with stages
in 44 seconds
Changes
52
Pipelines
1
Expand all
Hide whitespace changes
Inline
Side-by-side
Showing
52 changed files
with
1441 additions
and
1600 deletions
+1441
-1600
compiler/GHC/Hs/Expr.hs
compiler/GHC/Hs/Expr.hs
+1
-1
compiler/GHC/Hs/Pat.hs
compiler/GHC/Hs/Pat.hs
+4
-5
compiler/GHC/Hs/Types.hs
compiler/GHC/Hs/Types.hs
+2
-2
compiler/GHC/Hs/Utils.hs
compiler/GHC/Hs/Utils.hs
+62
-65
compiler/GHC/HsToCore/PmCheck.hs
compiler/GHC/HsToCore/PmCheck.hs
+14
-14
compiler/GHC/ThToHs.hs
compiler/GHC/ThToHs.hs
+49
-50
compiler/basicTypes/Name.hs
compiler/basicTypes/Name.hs
+0
-6
compiler/basicTypes/SrcLoc.hs
compiler/basicTypes/SrcLoc.hs
+18
-101
compiler/deSugar/Coverage.hs
compiler/deSugar/Coverage.hs
+66
-70
compiler/deSugar/Desugar.hs
compiler/deSugar/Desugar.hs
+7
-8
compiler/deSugar/DsArrows.hs
compiler/deSugar/DsArrows.hs
+20
-20
compiler/deSugar/DsBinds.hs
compiler/deSugar/DsBinds.hs
+5
-5
compiler/deSugar/DsExpr.hs
compiler/deSugar/DsExpr.hs
+27
-27
compiler/deSugar/DsForeign.hs
compiler/deSugar/DsForeign.hs
+3
-3
compiler/deSugar/DsGRHSs.hs
compiler/deSugar/DsGRHSs.hs
+2
-3
compiler/deSugar/DsListComp.hs
compiler/deSugar/DsListComp.hs
+3
-3
compiler/deSugar/DsMeta.hs
compiler/deSugar/DsMeta.hs
+139
-148
compiler/deSugar/DsUtils.hs
compiler/deSugar/DsUtils.hs
+19
-19
compiler/deSugar/ExtractDocs.hs
compiler/deSugar/ExtractDocs.hs
+16
-14
compiler/deSugar/Match.hs
compiler/deSugar/Match.hs
+27
-28
compiler/deSugar/MatchCon.hs
compiler/deSugar/MatchCon.hs
+3
-3
compiler/deSugar/MatchLit.hs
compiler/deSugar/MatchLit.hs
+8
-8
compiler/hieFile/HieAst.hs
compiler/hieFile/HieAst.hs
+7
-7
compiler/main/GHC.hs
compiler/main/GHC.hs
+2
-5
compiler/main/HeaderInfo.hs
compiler/main/HeaderInfo.hs
+31
-32
compiler/main/HscStats.hs
compiler/main/HscStats.hs
+7
-9
compiler/main/HscTypes.hs
compiler/main/HscTypes.hs
+1
-1
compiler/parser/Parser.y
compiler/parser/Parser.y
+159
-162
compiler/parser/RdrHsSyn.hs
compiler/parser/RdrHsSyn.hs
+262
-271
compiler/rename/RnExpr.hs
compiler/rename/RnExpr.hs
+1
-1
compiler/rename/RnHsDoc.hs
compiler/rename/RnHsDoc.hs
+2
-2
compiler/rename/RnPat.hs
compiler/rename/RnPat.hs
+48
-51
compiler/rename/RnSource.hs
compiler/rename/RnSource.hs
+74
-78
compiler/rename/RnSplice.hs
compiler/rename/RnSplice.hs
+14
-14
compiler/rename/RnTypes.hs
compiler/rename/RnTypes.hs
+60
-64
compiler/rename/RnUtils.hs
compiler/rename/RnUtils.hs
+2
-2
compiler/typecheck/TcBinds.hs
compiler/typecheck/TcBinds.hs
+26
-26
compiler/typecheck/TcErrors.hs
compiler/typecheck/TcErrors.hs
+2
-2
compiler/typecheck/TcHsSyn.hs
compiler/typecheck/TcHsSyn.hs
+59
-65
compiler/typecheck/TcHsType.hs
compiler/typecheck/TcHsType.hs
+2
-2
compiler/typecheck/TcPat.hs
compiler/typecheck/TcPat.hs
+19
-22
compiler/typecheck/TcPatSyn.hs
compiler/typecheck/TcPatSyn.hs
+27
-28
compiler/typecheck/TcRnDriver.hs
compiler/typecheck/TcRnDriver.hs
+27
-27
compiler/typecheck/TcRnExports.hs
compiler/typecheck/TcRnExports.hs
+17
-17
compiler/typecheck/TcRnMonad.hs
compiler/typecheck/TcRnMonad.hs
+14
-17
compiler/typecheck/TcTyClsDecls.hs
compiler/typecheck/TcTyClsDecls.hs
+52
-57
compiler/typecheck/TcTyDecls.hs
compiler/typecheck/TcTyDecls.hs
+17
-17
ghc/GHCi/UI/Info.hs
ghc/GHCi/UI/Info.hs
+7
-7
testsuite/tests/ghc-api/T6145.hs
testsuite/tests/ghc-api/T6145.hs
+5
-5
testsuite/tests/pmcheck/should_compile/pmc009.hs
testsuite/tests/pmcheck/should_compile/pmc009.hs
+0
-4
testsuite/tests/pmcheck/should_compile/pmc009.stderr
testsuite/tests/pmcheck/should_compile/pmc009.stderr
+1
-1
utils/haddock
utils/haddock
+1
-1
No files found.
compiler/GHC/Hs/Expr.hs
View file @
5aba5d32
...
...
@@ -920,7 +920,7 @@ ppr_expr (SectionR _ op expr)
ppr_expr
(
ExplicitTuple
_
exprs
boxity
)
-- Special-case unary boxed tuples so that they are pretty-printed as
-- `Unit x`, not `(x)`
|
[
dL
->
L
_
(
Present
_
expr
)]
<-
exprs
|
[
L
_
(
Present
_
expr
)]
<-
exprs
,
Boxed
<-
boxity
=
hsep
[
text
(
mkTupleStr
Boxed
1
),
ppr
expr
]
|
otherwise
...
...
compiler/GHC/Hs/Pat.hs
View file @
5aba5d32
...
...
@@ -710,7 +710,7 @@ isIrrefutableHsPat
go
(
ConPatIn
{})
=
False
-- Conservative
go
(
ConPatOut
{
pat_con
=
(
dL
->
L
_
(
RealDataCon
con
)
)
{
pat_con
=
L
_
(
RealDataCon
con
)
,
pat_args
=
details
})
=
isJust
(
tyConSingleDataCon_maybe
(
dataConTyCon
con
))
...
...
@@ -718,9 +718,8 @@ isIrrefutableHsPat
-- the latter is false of existentials. See #4439
&&
all
goL
(
hsConPatArgs
details
)
go
(
ConPatOut
{
pat_con
=
(
dL
->
L
_
(
PatSynCon
_pat
)
)
})
{
pat_con
=
L
_
(
PatSynCon
_pat
)
})
=
False
-- Conservative
go
(
ConPatOut
{})
=
panic
"ConPatOut:Impossible Match"
-- due to #15884
go
(
LitPat
{})
=
False
go
(
NPat
{})
=
False
go
(
NPlusKPat
{})
=
False
...
...
@@ -790,8 +789,8 @@ conPatNeedsParens p = go
-- | @'parenthesizePat' p pat@ checks if @'patNeedsParens' p pat@ is true, and
-- if so, surrounds @pat@ with a 'ParPat'. Otherwise, it simply returns @pat@.
parenthesizePat
::
PprPrec
->
LPat
(
GhcPass
p
)
->
LPat
(
GhcPass
p
)
parenthesizePat
p
lpat
@
(
dL
->
L
loc
pat
)
|
patNeedsParens
p
pat
=
c
L
loc
(
ParPat
noExtField
lpat
)
parenthesizePat
p
lpat
@
(
L
loc
pat
)
|
patNeedsParens
p
pat
=
L
loc
(
ParPat
noExtField
lpat
)
|
otherwise
=
lpat
{-
...
...
compiler/GHC/Hs/Types.hs
View file @
5aba5d32
...
...
@@ -1063,14 +1063,14 @@ hsAllLTyVarNames (HsQTvs { hsq_ext = kvs
hsAllLTyVarNames
(
XLHsQTyVars
nec
)
=
noExtCon
nec
hsLTyVarLocName
::
LHsTyVarBndr
(
GhcPass
p
)
->
Located
(
IdP
(
GhcPass
p
))
hsLTyVarLocName
=
onHasSrcSpan
hsTyVarName
hsLTyVarLocName
=
mapLoc
hsTyVarName
hsLTyVarLocNames
::
LHsQTyVars
(
GhcPass
p
)
->
[
Located
(
IdP
(
GhcPass
p
))]
hsLTyVarLocNames
qtvs
=
map
hsLTyVarLocName
(
hsQTvExplicit
qtvs
)
-- | Convert a LHsTyVarBndr to an equivalent LHsType.
hsLTyVarBndrToType
::
LHsTyVarBndr
(
GhcPass
p
)
->
LHsType
(
GhcPass
p
)
hsLTyVarBndrToType
=
onHasSrcSpan
cvt
hsLTyVarBndrToType
=
mapLoc
cvt
where
cvt
(
UserTyVar
_
n
)
=
HsTyVar
noExtField
NotPromoted
n
cvt
(
KindedTyVar
_
(
L
name_loc
n
)
kind
)
=
HsKindSig
noExtField
...
...
compiler/GHC/Hs/Utils.hs
View file @
5aba5d32
...
...
@@ -147,13 +147,13 @@ just attach 'noSrcSpan' to everything.
-- | e => (e)
mkHsPar
::
LHsExpr
(
GhcPass
id
)
->
LHsExpr
(
GhcPass
id
)
mkHsPar
e
=
c
L
(
getLoc
e
)
(
HsPar
noExtField
e
)
mkHsPar
e
=
L
(
getLoc
e
)
(
HsPar
noExtField
e
)
mkSimpleMatch
::
HsMatchContext
(
NameOrRdrName
(
IdP
(
GhcPass
p
)))
->
[
LPat
(
GhcPass
p
)]
->
Located
(
body
(
GhcPass
p
))
->
LMatch
(
GhcPass
p
)
(
Located
(
body
(
GhcPass
p
)))
mkSimpleMatch
ctxt
pats
rhs
=
c
L
loc
$
=
L
loc
$
Match
{
m_ext
=
noExtField
,
m_ctxt
=
ctxt
,
m_pats
=
pats
,
m_grhss
=
unguardedGRHSs
rhs
}
where
...
...
@@ -163,12 +163,12 @@ mkSimpleMatch ctxt pats rhs
unguardedGRHSs
::
Located
(
body
(
GhcPass
p
))
->
GRHSs
(
GhcPass
p
)
(
Located
(
body
(
GhcPass
p
)))
unguardedGRHSs
rhs
@
(
dL
->
L
loc
_
)
unguardedGRHSs
rhs
@
(
L
loc
_
)
=
GRHSs
noExtField
(
unguardedRHS
loc
rhs
)
(
noLoc
emptyLocalBinds
)
unguardedRHS
::
SrcSpan
->
Located
(
body
(
GhcPass
p
))
->
[
LGRHS
(
GhcPass
p
)
(
Located
(
body
(
GhcPass
p
)))]
unguardedRHS
loc
rhs
=
[
c
L
loc
(
GRHS
noExtField
[]
rhs
)]
unguardedRHS
loc
rhs
=
[
L
loc
(
GRHS
noExtField
[]
rhs
)]
mkMatchGroup
::
(
XMG
name
(
Located
(
body
name
))
~
NoExtField
)
=>
Origin
->
[
LMatch
name
(
Located
(
body
name
))]
...
...
@@ -179,7 +179,7 @@ mkMatchGroup origin matches = MG { mg_ext = noExtField
mkLocatedList
::
[
Located
a
]
->
Located
[
Located
a
]
mkLocatedList
[]
=
noLoc
[]
mkLocatedList
ms
=
c
L
(
combineLocs
(
head
ms
)
(
last
ms
))
ms
mkLocatedList
ms
=
L
(
combineLocs
(
head
ms
)
(
last
ms
))
ms
mkHsApp
::
LHsExpr
(
GhcPass
id
)
->
LHsExpr
(
GhcPass
id
)
->
LHsExpr
(
GhcPass
id
)
mkHsApp
e1
e2
=
addCLoc
e1
e2
(
HsApp
noExtField
e1
e2
)
...
...
@@ -196,7 +196,7 @@ mkHsAppTypes = foldl' mkHsAppType
mkHsLam
::
(
XMG
(
GhcPass
p
)
(
LHsExpr
(
GhcPass
p
))
~
NoExtField
)
=>
[
LPat
(
GhcPass
p
)]
->
LHsExpr
(
GhcPass
p
)
->
LHsExpr
(
GhcPass
p
)
mkHsLam
pats
body
=
mkHsPar
(
c
L
(
getLoc
body
)
(
HsLam
noExtField
matches
))
mkHsLam
pats
body
=
mkHsPar
(
L
(
getLoc
body
)
(
HsLam
noExtField
matches
))
where
matches
=
mkMatchGroup
Generated
[
mkSimpleMatch
LambdaExpr
pats'
body
]
...
...
@@ -225,13 +225,13 @@ nlHsTyApps fun_id tys xs = foldl' nlHsApp (nlHsTyApp fun_id tys) xs
-- | Wrap in parens if (hsExprNeedsParens appPrec) says it needs them
-- So 'f x' becomes '(f x)', but '3' stays as '3'
mkLHsPar
::
LHsExpr
(
GhcPass
id
)
->
LHsExpr
(
GhcPass
id
)
mkLHsPar
le
@
(
dL
->
L
loc
e
)
|
hsExprNeedsParens
appPrec
e
=
c
L
loc
(
HsPar
noExtField
le
)
mkLHsPar
le
@
(
L
loc
e
)
|
hsExprNeedsParens
appPrec
e
=
L
loc
(
HsPar
noExtField
le
)
|
otherwise
=
le
mkParPat
::
LPat
(
GhcPass
name
)
->
LPat
(
GhcPass
name
)
mkParPat
lp
@
(
dL
->
L
loc
p
)
|
patNeedsParens
appPrec
p
=
c
L
loc
(
ParPat
noExtField
lp
)
mkParPat
lp
@
(
L
loc
p
)
|
patNeedsParens
appPrec
p
=
L
loc
(
ParPat
noExtField
lp
)
|
otherwise
=
lp
nlParPat
::
LPat
(
GhcPass
name
)
->
LPat
(
GhcPass
name
)
...
...
@@ -277,7 +277,7 @@ mkHsIsString src s = OverLit noExtField (HsIsString src s) noExpr
mkHsDo
ctxt
stmts
=
HsDo
noExtField
ctxt
(
mkLocatedList
stmts
)
mkHsComp
ctxt
stmts
expr
=
mkHsDo
ctxt
(
stmts
++
[
last_stmt
])
where
last_stmt
=
c
L
(
getLoc
expr
)
$
mkLastStmt
expr
last_stmt
=
L
(
getLoc
expr
)
$
mkLastStmt
expr
mkHsIf
::
LHsExpr
(
GhcPass
p
)
->
LHsExpr
(
GhcPass
p
)
->
LHsExpr
(
GhcPass
p
)
->
HsExpr
(
GhcPass
p
)
...
...
@@ -531,7 +531,7 @@ missingTupArg = Missing noExtField
mkLHsPatTup
::
[
LPat
GhcRn
]
->
LPat
GhcRn
mkLHsPatTup
[]
=
noLoc
$
TuplePat
noExtField
[]
Boxed
mkLHsPatTup
[
lpat
]
=
lpat
mkLHsPatTup
lpats
=
c
L
(
getLoc
(
head
lpats
))
$
TuplePat
noExtField
lpats
Boxed
mkLHsPatTup
lpats
=
L
(
getLoc
(
head
lpats
))
$
TuplePat
noExtField
lpats
Boxed
-- | The Big equivalents for the source tuple expressions
mkBigLHsVarTup
::
[
IdP
(
GhcPass
id
)]
->
LHsExpr
(
GhcPass
id
)
...
...
@@ -620,12 +620,12 @@ mkHsSigEnv get_info sigs
-- of which use this function
where
(
gen_dm_sigs
,
ordinary_sigs
)
=
partition
is_gen_dm_sig
sigs
is_gen_dm_sig
(
dL
->
L
_
(
ClassOpSig
_
True
_
_
))
=
True
is_gen_dm_sig
_
=
False
is_gen_dm_sig
(
L
_
(
ClassOpSig
_
True
_
_
))
=
True
is_gen_dm_sig
_
=
False
mk_pairs
::
[
LSig
GhcRn
]
->
[(
Name
,
a
)]
mk_pairs
sigs
=
[
(
n
,
a
)
|
Just
(
ns
,
a
)
<-
map
get_info
sigs
,
(
dL
->
L
_
n
)
<-
ns
]
,
L
_
n
<-
ns
]
mkClassOpSigs
::
[
LSig
GhcPs
]
->
[
LSig
GhcPs
]
-- ^ Convert TypeSig to ClassOpSig
...
...
@@ -634,8 +634,8 @@ mkClassOpSigs :: [LSig GhcPs] -> [LSig GhcPs]
mkClassOpSigs
sigs
=
map
fiddle
sigs
where
fiddle
(
dL
->
L
loc
(
TypeSig
_
nms
ty
))
=
c
L
loc
(
ClassOpSig
noExtField
False
nms
(
dropWildCards
ty
))
fiddle
(
L
loc
(
TypeSig
_
nms
ty
))
=
L
loc
(
ClassOpSig
noExtField
False
nms
(
dropWildCards
ty
))
fiddle
sig
=
sig
typeToLHsType
::
Type
->
LHsType
GhcPs
...
...
@@ -753,7 +753,7 @@ positions in the kind of the tycon.
********************************************************************* -}
mkLHsWrap
::
HsWrapper
->
LHsExpr
(
GhcPass
id
)
->
LHsExpr
(
GhcPass
id
)
mkLHsWrap
co_fn
(
dL
->
L
loc
e
)
=
c
L
loc
(
mkHsWrap
co_fn
e
)
mkLHsWrap
co_fn
(
L
loc
e
)
=
L
loc
(
mkHsWrap
co_fn
e
)
-- | Avoid (HsWrap co (HsWrap co' _)).
-- See Note [Detecting forced eta expansion] in DsExpr
...
...
@@ -771,14 +771,14 @@ mkHsWrapCoR :: TcCoercionR -- A Representational coercion a ~R b
mkHsWrapCoR
co
e
=
mkHsWrap
(
mkWpCastR
co
)
e
mkLHsWrapCo
::
TcCoercionN
->
LHsExpr
(
GhcPass
id
)
->
LHsExpr
(
GhcPass
id
)
mkLHsWrapCo
co
(
dL
->
L
loc
e
)
=
c
L
loc
(
mkHsWrapCo
co
e
)
mkLHsWrapCo
co
(
L
loc
e
)
=
L
loc
(
mkHsWrapCo
co
e
)
mkHsCmdWrap
::
HsWrapper
->
HsCmd
(
GhcPass
p
)
->
HsCmd
(
GhcPass
p
)
mkHsCmdWrap
w
cmd
|
isIdHsWrapper
w
=
cmd
|
otherwise
=
HsCmdWrap
noExtField
w
cmd
mkLHsCmdWrap
::
HsWrapper
->
LHsCmd
(
GhcPass
p
)
->
LHsCmd
(
GhcPass
p
)
mkLHsCmdWrap
w
(
dL
->
L
loc
c
)
=
c
L
loc
(
mkHsCmdWrap
w
c
)
mkLHsCmdWrap
w
(
L
loc
c
)
=
L
loc
(
mkHsCmdWrap
w
c
)
mkHsWrapPat
::
HsWrapper
->
Pat
(
GhcPass
id
)
->
Type
->
Pat
(
GhcPass
id
)
mkHsWrapPat
co_fn
p
ty
|
isIdHsWrapper
co_fn
=
p
...
...
@@ -824,7 +824,7 @@ mkHsVarBind :: SrcSpan -> RdrName -> LHsExpr GhcPs -> LHsBind GhcPs
mkHsVarBind
loc
var
rhs
=
mkSimpleGeneratedFunBind
loc
var
[]
rhs
mkVarBind
::
IdP
(
GhcPass
p
)
->
LHsExpr
(
GhcPass
p
)
->
LHsBind
(
GhcPass
p
)
mkVarBind
var
rhs
=
c
L
(
getLoc
rhs
)
$
mkVarBind
var
rhs
=
L
(
getLoc
rhs
)
$
VarBind
{
var_ext
=
noExtField
,
var_id
=
var
,
var_rhs
=
rhs
,
var_inline
=
False
}
...
...
@@ -852,8 +852,8 @@ isInfixFunBind _ = False
mkSimpleGeneratedFunBind
::
SrcSpan
->
RdrName
->
[
LPat
GhcPs
]
->
LHsExpr
GhcPs
->
LHsBind
GhcPs
mkSimpleGeneratedFunBind
loc
fun
pats
expr
=
cL
loc
$
mkFunBind
Generated
(
c
L
loc
fun
)
[
mkMatch
(
mkPrefixFunRhs
(
c
L
loc
fun
))
pats
expr
=
L
loc
$
mkFunBind
Generated
(
L
loc
fun
)
[
mkMatch
(
mkPrefixFunRhs
(
L
loc
fun
))
pats
expr
(
noLoc
emptyLocalBinds
)]
-- | Make a prefix, non-strict function 'HsMatchContext'
...
...
@@ -873,8 +873,8 @@ mkMatch ctxt pats expr lbinds
,
m_pats
=
map
paren
pats
,
m_grhss
=
GRHSs
noExtField
(
unguardedRHS
noSrcSpan
expr
)
lbinds
})
where
paren
lp
@
(
dL
->
L
l
p
)
|
patNeedsParens
appPrec
p
=
c
L
l
(
ParPat
noExtField
lp
)
paren
lp
@
(
L
l
p
)
|
patNeedsParens
appPrec
p
=
L
l
(
ParPat
noExtField
lp
)
|
otherwise
=
lp
{-
...
...
@@ -954,7 +954,7 @@ isBangedHsBind :: HsBind GhcTc -> Bool
isBangedHsBind
(
AbsBinds
{
abs_binds
=
binds
})
=
anyBag
(
isBangedHsBind
.
unLoc
)
binds
isBangedHsBind
(
FunBind
{
fun_matches
=
matches
})
|
[
dL
->
L
_
match
]
<-
unLoc
$
mg_alts
matches
|
[
L
_
match
]
<-
unLoc
$
mg_alts
matches
,
FunRhs
{
mc_strictness
=
SrcStrict
}
<-
m_ctxt
match
=
True
isBangedHsBind
(
PatBind
{
pat_lhs
=
pat
})
...
...
@@ -976,8 +976,8 @@ collectHsIdBinders, collectHsValBinders
collectHsIdBinders
=
collect_hs_val_binders
True
collectHsValBinders
=
collect_hs_val_binders
False
collectHsBindBinders
::
(
SrcSpanLess
(
LPat
p
)
~
Pat
p
,
HasSrcSpan
(
LPat
p
))
=>
HsBindLR
p
idR
->
[
IdP
p
]
collectHsBindBinders
::
XRec
pass
Pat
~
Located
(
Pat
pass
)
=>
HsBindLR
p
ass
idR
->
[
IdP
pass
]
-- ^ Collect both Ids and pattern-synonym binders
collectHsBindBinders
b
=
collect_bind
False
b
[]
...
...
@@ -1003,16 +1003,17 @@ collect_binds :: Bool -> LHsBindsLR (GhcPass p) idR ->
-- ^ Collect Ids, or Ids + pattern synonyms, depending on boolean flag
collect_binds
ps
binds
acc
=
foldr
(
collect_bind
ps
.
unLoc
)
acc
binds
collect_bind
::
(
SrcSpanLess
(
LPat
p
)
~
Pat
p
,
HasSrcSpan
(
LPat
p
))
=>
Bool
->
HsBindLR
p
idR
->
[
IdP
p
]
->
[
IdP
p
]
collect_bind
::
XRec
pass
Pat
~
Located
(
Pat
pass
)
=>
Bool
->
HsBindLR
pass
idR
->
[
IdP
pass
]
->
[
IdP
pass
]
collect_bind
_
(
PatBind
{
pat_lhs
=
p
})
acc
=
collect_lpat
p
acc
collect_bind
_
(
FunBind
{
fun_id
=
(
dL
->
L
_
f
)
})
acc
=
f
:
acc
collect_bind
_
(
FunBind
{
fun_id
=
L
_
f
})
acc
=
f
:
acc
collect_bind
_
(
VarBind
{
var_id
=
f
})
acc
=
f
:
acc
collect_bind
_
(
AbsBinds
{
abs_exports
=
dbinds
})
acc
=
map
abe_poly
dbinds
++
acc
-- I don't think we want the binders from the abe_binds
-- binding (hence see AbsBinds) is in zonking in TcHsSyn
collect_bind
omitPatSyn
(
PatSynBind
_
(
PSB
{
psb_id
=
(
dL
->
L
_
ps
)
}))
acc
collect_bind
omitPatSyn
(
PatSynBind
_
(
PSB
{
psb_id
=
L
_
ps
}))
acc
|
omitPatSyn
=
acc
|
otherwise
=
ps
:
acc
collect_bind
_
(
PatSynBind
_
(
XPatSynBind
_
))
acc
=
acc
...
...
@@ -1066,8 +1067,8 @@ collectPatsBinders :: [LPat (GhcPass p)] -> [IdP (GhcPass p)]
collectPatsBinders
pats
=
foldr
collect_lpat
[]
pats
-------------
collect_lpat
::
(
SrcSpanLess
(
LPat
p
)
~
Pat
p
,
HasSrcSpan
(
LPat
p
)
)
=>
LPat
p
->
[
IdP
p
]
->
[
IdP
p
]
collect_lpat
::
XRec
pass
Pat
~
Located
(
Pat
pass
)
=>
LPat
pass
->
[
IdP
pass
]
->
[
IdP
pass
]
collect_lpat
p
bndrs
=
go
(
unLoc
p
)
where
...
...
@@ -1160,39 +1161,37 @@ hsLTyClDeclBinders :: Located (TyClDecl (GhcPass p))
-- Each returned (Located name) has a SrcSpan for the /whole/ declaration.
-- See Note [SrcSpan for binders]
hsLTyClDeclBinders
(
dL
->
L
loc
(
FamDecl
{
tcdFam
=
FamilyDecl
{
fdLName
=
(
dL
->
L
_
name
)
}
}))
=
([
c
L
loc
name
],
[]
)
hsLTyClDeclBinders
(
dL
->
L
_
(
FamDecl
{
tcdFam
=
XFamilyDecl
nec
}))
hsLTyClDeclBinders
(
L
loc
(
FamDecl
{
tcdFam
=
FamilyDecl
{
fdLName
=
(
L
_
name
)
}
}))
=
([
L
loc
name
],
[]
)
hsLTyClDeclBinders
(
L
_
(
FamDecl
{
tcdFam
=
XFamilyDecl
nec
}))
=
noExtCon
nec
hsLTyClDeclBinders
(
dL
->
L
loc
(
SynDecl
{
tcdLName
=
(
dL
->
L
_
name
)
}))
=
([
c
L
loc
name
],
[]
)
hsLTyClDeclBinders
(
dL
->
L
loc
(
ClassDecl
{
tcdLName
=
(
dL
->
L
_
cls_name
)
hsLTyClDeclBinders
(
L
loc
(
SynDecl
{
tcdLName
=
(
L
_
name
)
}))
=
([
L
loc
name
],
[]
)
hsLTyClDeclBinders
(
L
loc
(
ClassDecl
{
tcdLName
=
(
L
_
cls_name
)
,
tcdSigs
=
sigs
,
tcdATs
=
ats
}))
=
(
c
L
loc
cls_name
:
[
cL
fam_loc
fam_name
|
(
dL
->
L
fam_loc
(
FamilyDecl
=
(
L
loc
cls_name
:
[
L
fam_loc
fam_name
|
(
L
fam_loc
(
FamilyDecl
{
fdLName
=
L
_
fam_name
}))
<-
ats
]
++
[
cL
mem_loc
mem_name
|
(
dL
->
L
mem_loc
(
ClassOpSig
_
False
ns
_
))
<-
sigs
,
(
dL
->
L
_
mem_name
)
<-
ns
]
[
L
mem_loc
mem_name
|
(
L
mem_loc
(
ClassOpSig
_
False
ns
_
))
<-
sigs
,
(
L
_
mem_name
)
<-
ns
]
,
[]
)
hsLTyClDeclBinders
(
dL
->
L
loc
(
DataDecl
{
tcdLName
=
(
dL
->
L
_
name
)
,
tcdDataDefn
=
defn
}))
=
(
\
(
xs
,
ys
)
->
(
cL
loc
name
:
xs
,
ys
))
$
hsDataDefnBinders
defn
hsLTyClDeclBinders
(
dL
->
L
_
(
XTyClDecl
nec
))
=
noExtCon
nec
hsLTyClDeclBinders
_
=
panic
"hsLTyClDeclBinders: Impossible Match"
-- due to #15884
hsLTyClDeclBinders
(
L
loc
(
DataDecl
{
tcdLName
=
(
L
_
name
)
,
tcdDataDefn
=
defn
}))
=
(
\
(
xs
,
ys
)
->
(
L
loc
name
:
xs
,
ys
))
$
hsDataDefnBinders
defn
hsLTyClDeclBinders
(
L
_
(
XTyClDecl
nec
))
=
noExtCon
nec
-------------------
hsForeignDeclsBinders
::
[
LForeignDecl
pass
]
->
[
Located
(
IdP
pass
)]
-- ^ See Note [SrcSpan for binders]
hsForeignDeclsBinders
foreign_decls
=
[
c
L
decl_loc
n
|
(
dL
->
L
decl_loc
(
ForeignImport
{
fd_name
=
(
dL
->
L
_
n
)
})
)
=
[
L
decl_loc
n
|
L
decl_loc
(
ForeignImport
{
fd_name
=
L
_
n
}
)
<-
foreign_decls
]
...
...
@@ -1213,24 +1212,22 @@ addPatSynSelector bind sels
getPatSynBinds
::
[(
RecFlag
,
LHsBinds
id
)]
->
[
PatSynBind
id
id
]
getPatSynBinds
binds
=
[
psb
|
(
_
,
lbinds
)
<-
binds
,
(
dL
->
L
_
(
PatSynBind
_
psb
)
)
<-
bagToList
lbinds
]
,
L
_
(
PatSynBind
_
psb
)
<-
bagToList
lbinds
]
-------------------
hsLInstDeclBinders
::
LInstDecl
(
GhcPass
p
)
->
([
Located
(
IdP
(
GhcPass
p
))],
[
LFieldOcc
(
GhcPass
p
)])
hsLInstDeclBinders
(
dL
->
L
_
(
ClsInstD
hsLInstDeclBinders
(
L
_
(
ClsInstD
{
cid_inst
=
ClsInstDecl
{
cid_datafam_insts
=
dfis
}}))
=
foldMap
(
hsDataFamInstBinders
.
unLoc
)
dfis
hsLInstDeclBinders
(
dL
->
L
_
(
DataFamInstD
{
dfid_inst
=
fi
}))
hsLInstDeclBinders
(
L
_
(
DataFamInstD
{
dfid_inst
=
fi
}))
=
hsDataFamInstBinders
fi
hsLInstDeclBinders
(
dL
->
L
_
(
TyFamInstD
{}))
=
mempty
hsLInstDeclBinders
(
dL
->
L
_
(
ClsInstD
_
(
XClsInstDecl
nec
)))
hsLInstDeclBinders
(
L
_
(
TyFamInstD
{}))
=
mempty
hsLInstDeclBinders
(
L
_
(
ClsInstD
_
(
XClsInstDecl
nec
)))
=
noExtCon
nec
hsLInstDeclBinders
(
dL
->
L
_
(
XInstDecl
nec
))
hsLInstDeclBinders
(
L
_
(
XInstDecl
nec
))
=
noExtCon
nec
hsLInstDeclBinders
_
=
panic
"hsLInstDeclBinders: Impossible Match"
-- due to #15884
-------------------
-- | the SrcLoc returned are for the whole declarations, not just the names
...
...
@@ -1278,13 +1275,13 @@ hsConDeclsBinders cons
-- remove only the first occurrence of any seen field in order to
-- avoid circumventing detection of duplicate fields (#9156)
ConDeclGADT
{
con_names
=
names
,
con_args
=
args
}
->
(
map
(
c
L
loc
.
unLoc
)
names
++
ns
,
flds
++
fs
)
->
(
map
(
L
loc
.
unLoc
)
names
++
ns
,
flds
++
fs
)
where
(
remSeen'
,
flds
)
=
get_flds
remSeen
args
(
ns
,
fs
)
=
go
remSeen'
rs
ConDeclH98
{
con_name
=
name
,
con_args
=
args
}
->
([
c
L
loc
(
unLoc
name
)]
++
ns
,
flds
++
fs
)
->
([
L
loc
(
unLoc
name
)]
++
ns
,
flds
++
fs
)
where
(
remSeen'
,
flds
)
=
get_flds
remSeen
args
(
ns
,
fs
)
=
go
remSeen'
rs
...
...
compiler/GHC/HsToCore/PmCheck.hs
View file @
5aba5d32
...
...
@@ -282,7 +282,7 @@ checkSingle' locn var p = do
(
Covered
,
_
)
->
plain
-- useful
(
NotCovered
,
NotDiverged
)
->
plain
{
pmresultRedundant
=
m
}
-- redundant
(
NotCovered
,
Diverged
)
->
plain
{
pmresultInaccessible
=
m
}
-- inaccessible rhs
where
m
=
[
cL
locn
[
c
L
locn
p
]]
where
m
=
[
L
locn
[
L
locn
p
]]
-- | Exhaustive for guard matches, is used for guards in pattern bindings and
-- in @MultiIf@ expressions.
...
...
@@ -293,7 +293,7 @@ checkGuardMatches hs_ctx guards@(GRHSs _ grhss _) = do
dflags
<-
getDynFlags
let
combinedLoc
=
foldl1
combineSrcSpans
(
map
getLoc
grhss
)
dsMatchContext
=
DsMatchContext
hs_ctx
combinedLoc
match
=
c
L
combinedLoc
$
match
=
L
combinedLoc
$
Match
{
m_ext
=
noExtField
,
m_ctxt
=
hs_ctx
,
m_pats
=
[]
...
...
@@ -360,8 +360,8 @@ checkMatches' vars matches = do
(
NotCovered
,
Diverged
)
->
(
rs
,
final_u
,
m
:
is
,
pc1
Semi
.<>
pc2
)
hsLMatchToLPats
::
LMatch
id
body
->
Located
[
LPat
id
]
hsLMatchToLPats
(
dL
->
L
l
(
Match
{
m_pats
=
pats
}))
=
c
L
l
pats
hsLMatchToLPats
_
=
panic
"checkMatches'"
hsLMatchToLPats
(
L
l
(
Match
{
m_pats
=
pats
}))
=
L
l
pats
hsLMatchToLPats
_
=
panic
"checkMatches'"
getNFirstUncovered
::
[
Id
]
->
Int
->
[
Delta
]
->
DsM
[
Delta
]
getNFirstUncovered
_
0
_
=
pure
[]
...
...
@@ -465,7 +465,7 @@ translatePat fam_insts x pat = case pat of
-- (x@pat) ==> Translate pat with x as match var and handle impedance
-- mismatch with incoming match var
AsPat
_
(
dL
->
L
_
y
)
p
->
(
mkPmLetVar
y
x
++
)
<$>
translateLPat
fam_insts
y
p
AsPat
_
(
L
_
y
)
p
->
(
mkPmLetVar
y
x
++
)
<$>
translateLPat
fam_insts
y
p
SigPat
_
p
_ty
->
translateLPat
fam_insts
x
p
...
...
@@ -481,7 +481,7 @@ translatePat fam_insts x pat = case pat of
pure
(
PmLet
y
(
wrap_rhs_y
(
Var
x
))
:
grds
)
-- (n + k) ===> let b = x >= k, True <- b, let n = x-k
NPlusKPat
_pat_ty
(
dL
->
L
_
n
)
k1
k2
ge
minus
->
do
NPlusKPat
_pat_ty
(
L
_
n
)
k1
k2
ge
minus
->
do
b
<-
mkPmId
boolTy
let
grd_b
=
vanillaConGrd
b
trueDataCon
[]
[
ke1
,
ke2
]
<-
traverse
dsOverLit
[
unLoc
k1
,
k2
]
...
...
@@ -527,14 +527,14 @@ translatePat fam_insts x pat = case pat of
--
-- See #14547, especially comment#9 and comment#10.
ConPatOut
{
pat_con
=
(
dL
->
L
_
con
)
ConPatOut
{
pat_con
=
L
_
con
,
pat_arg_tys
=
arg_tys
,
pat_tvs
=
ex_tvs
,
pat_dicts
=
dicts
,
pat_args
=
ps
}
->
do
translateConPatOut
fam_insts
x
con
arg_tys
ex_tvs
dicts
ps
NPat
ty
(
dL
->
L
_
olit
)
mb_neg
_
->
do
NPat
ty
(
L
_
olit
)
mb_neg
_
->
do
-- See Note [Literal short cut] in MatchLit.hs
-- We inline the Literal short cut for @ty@ here, because @ty@ is more
-- precise than the field of OverLitTc, which is all that dsOverLit (which
...
...
@@ -657,7 +657,7 @@ translateConPatOut fam_insts x con univ_tys ex_tvs dicts = \case
-- Translate a single match
translateMatch
::
FamInstEnvs
->
[
Id
]
->
LMatch
GhcTc
(
LHsExpr
GhcTc
)
->
DsM
(
GrdVec
,
[
GrdVec
])
translateMatch
fam_insts
vars
(
dL
->
L
_
(
Match
{
m_pats
=
pats
,
m_grhss
=
grhss
}))
translateMatch
fam_insts
vars
(
L
_
(
Match
{
m_pats
=
pats
,
m_grhss
=
grhss
}))
=
do
pats'
<-
concat
<$>
zipWithM
(
translateLPat
fam_insts
)
vars
pats
guards'
<-
mapM
(
translateGuards
fam_insts
)
guards
...
...
@@ -665,8 +665,8 @@ translateMatch fam_insts vars (dL->L _ (Match { m_pats = pats, m_grhss = grhss }
return
(
pats'
,
guards'
)
where
extractGuards
::
LGRHS
GhcTc
(
LHsExpr
GhcTc
)
->
[
GuardStmt
GhcTc
]
extractGuards
(
dL
->
L
_
(
GRHS
_
gs
_
))
=
map
unLoc
gs
extractGuards
_
=
panic
"translateMatch"
extractGuards
(
L
_
(
GRHS
_
gs
_
))
=
map
unLoc
gs
extractGuards
_
=
panic
"translateMatch"
guards
=
map
extractGuards
(
grhssGRHSs
grhss
)
translateMatch
_
_
_
=
panic
"translateMatch"
...
...
@@ -1247,10 +1247,10 @@ dsPmWarn dflags ctx@(DsMatchContext kind loc) vars pm_result
when
(
approx
&&
(
exists_u
||
exists_i
))
$
putSrcSpanDs
loc
(
warnDs
NoReason
approx_msg
)
when
exists_r
$
forM_
redundant
$
\
(
dL
->
L
l
q
)
->
do
when
exists_r
$
forM_
redundant
$
\
(
L
l
q
)
->
do
putSrcSpanDs
l
(
warnDs
(
Reason
Opt_WarnOverlappingPatterns
)
(
pprEqn
q
"is redundant"
))
when
exists_i
$
forM_
inaccessible
$
\
(
dL
->
L
l
q
)
->
do
when
exists_i
$
forM_
inaccessible
$
\
(
L
l
q
)
->
do
putSrcSpanDs
l
(
warnDs
(
Reason
Opt_WarnOverlappingPatterns
)
(
pprEqn
q
"has inaccessible right hand side"
))
when
exists_u
$
putSrcSpanDs
loc
$
warnDs
flag_u_reason
$
...
...
@@ -1366,7 +1366,7 @@ pprContext singular (DsMatchContext kind _loc) msg rest_of_msg_fun
(
ppr_match
,
pref
)
=
case
kind
of
FunRhs
{
mc_fun
=
(
dL
->
L
_
fun
)
}
FunRhs
{
mc_fun
=
L
_
fun
}
->
(
pprMatchContext
kind
,
\
pp
->
ppr
fun
<+>
pp
)
_
->
(
pprMatchContext
kind
,
\
pp
->
pp
)
...
...
compiler/GHC/ThToHs.hs
View file @
5aba5d32
...
...
@@ -118,15 +118,14 @@ getL = CvtM (\_ loc -> Right (loc,loc))
setL
::
SrcSpan
->
CvtM
()
setL
loc
=
CvtM
(
\
_
_
->
Right
(
loc
,
()
))
returnL
::
HasSrcSpan
a
=>
SrcSpanLess
a
->
CvtM
a
returnL
x
=
CvtM
(
\
_
loc
->
Right
(
loc
,
c
L
loc
x
))
returnL
::
a
->
CvtM
(
Located
a
)
returnL
x
=
CvtM
(
\
_
loc
->
Right
(
loc
,
L
loc
x
))
returnJustL
::
HasSrcSpan
a
=>
SrcSpanLess
a
->
CvtM
(
Maybe
a
)
returnJustL
::
a
->
CvtM
(
Maybe
(
Located
a
)
)
returnJustL
=
fmap
Just
.
returnL
wrapParL
::
HasSrcSpan
a
=>
(
a
->
SrcSpanLess
a
)
->
SrcSpanLess
a
->
CvtM
(
SrcSpanLess
a
)
wrapParL
add_par
x
=
CvtM
(
\
_
loc
->
Right
(
loc
,
add_par
(
cL
loc
x
)))
wrapParL
::
(
Located
a
->
a
)
->
a
->
CvtM
a
wrapParL
add_par
x
=
CvtM
(
\
_
loc
->
Right
(
loc
,
add_par
(
L
loc
x
)))
wrapMsg
::
(
Show
a
,
TH
.
Ppr
a
)
=>
String
->
a
->
CvtM
b
->
CvtM
b
-- E.g wrapMsg "declaration" dec thing
...
...
@@ -142,10 +141,10 @@ wrapMsg what item (CvtM m)
then
text
(
show
item
)
else
text
(
pprint
item
))
wrapL
::
HasSrcSpan
a
=>
CvtM
(
SrcSpanLess
a
)
->
CvtM
a
wrapL
::
CvtM
a
->
CvtM
(
Located
a
)
wrapL
(
CvtM
m
)
=
CvtM
$
\
origin
loc
->
case
m
origin
loc
of
Left
err
->
Left
err
Right
(
loc'
,
v
)
->
Right
(
loc'
,
c
L
loc
v
)
Right
(
loc'
,
v
)
->
Right
(
loc'
,
L
loc
v
)
-------------------------------------------------------------------
cvtDecs
::
[
TH
.
Dec
]
->
CvtM
[
LHsDecl
GhcPs
]
...
...
@@ -279,14 +278,14 @@ cvtDec (InstanceD o ctxt ty decs)
;
(
binds'
,
sigs'
,
fams'
,
ats'
,
adts'
)
<-
cvt_ci_decs
doc
decs
;
unless
(
null
fams'
)
(
failWith
(
mkBadDecMsg
doc
fams'
))
;
ctxt'
<-
cvtContext
funPrec
ctxt
;
(
dL
->
L
loc
ty'
)
<-
cvtType
ty
;
let
inst_ty'
=
mkHsQualTy
ctxt
loc
ctxt'
$
c
L
loc
ty'
;
(
L
loc
ty'
)
<-
cvtType
ty
;
let
inst_ty'
=
mkHsQualTy
ctxt
loc
ctxt'
$
L
loc
ty'
;
returnJustL
$
InstD
noExtField
$
ClsInstD
noExtField
$
ClsInstDecl
{
cid_ext
=
noExtField
,
cid_poly_ty
=
mkLHsSigType
inst_ty'
,
cid_binds
=
binds'
,
cid_sigs
=
Hs
.
mkClassOpSigs
sigs'
,
cid_tyfam_insts
=
ats'
,
cid_datafam_insts
=
adts'
,
cid_overlap_mode
=
fmap
(
c
L
loc
.
overlap
)
o
}
}
,
cid_overlap_mode
=
fmap
(
L
loc
.
overlap
)
o
}
}
where
overlap
pragma
=
case
pragma
of
...
...
@@ -350,7 +349,7 @@ cvtDec (NewtypeInstD ctxt bndrs tys ksig constr derivs)
,
feqn_fixity
=
Prefix
}
}}}
cvtDec
(
TySynInstD
eqn
)
=
do
{
(
dL
->
L
_
eqn'
)
<-
cvtTySynEqn
eqn
=
do
{
(
L
_
eqn'
)
<-
cvtTySynEqn
eqn
;
returnJustL
$
InstD
noExtField
$
TyFamInstD
{
tfid_ext
=
noExtField
,
tfid_inst
=
TyFamInstDecl
{
tfid_eqn
=
eqn'
}
}
}
...
...
@@ -376,8 +375,8 @@ cvtDec (TH.RoleAnnotD tc roles)
cvtDec
(
TH
.
StandaloneDerivD
ds
cxt
ty
)
=
do
{
cxt'
<-
cvtContext
funPrec
cxt
;
ds'
<-
traverse
cvtDerivStrategy
ds
;
(
dL
->
L
loc
ty'
)
<-
cvtType
ty
;
let
inst_ty'
=
mkHsQualTy
cxt
loc
cxt'
$
c
L
loc
ty'
;
(
L
loc
ty'
)
<-
cvtType
ty
;
let
inst_ty'
=
mkHsQualTy
cxt
loc
cxt'
$
L
loc
ty'
;
returnJustL
$
DerivD
noExtField
$
DerivDecl
{
deriv_ext
=
noExtField
,
deriv_strategy
=
ds'
...
...
@@ -523,29 +522,29 @@ cvt_tyfam_head (TypeFamilyHead tc tyvars result injectivity)
-------------------------------------------------------------------
is_fam_decl
::
LHsDecl
GhcPs
->
Either
(
LFamilyDecl
GhcPs
)
(
LHsDecl
GhcPs
)
is_fam_decl
(
dL
->
L
loc
(
TyClD
_
(
FamDecl
{
tcdFam
=
d
})))
=
Left
(
c
L
loc
d
)
is_fam_decl
(
L
loc
(
TyClD
_
(
FamDecl
{
tcdFam
=
d
})))
=
Left
(
L
loc
d
)
is_fam_decl
decl
=
Right
decl
is_tyfam_inst
::
LHsDecl
GhcPs
->
Either
(
LTyFamInstDecl
GhcPs
)
(
LHsDecl
GhcPs
)
is_tyfam_inst
(
dL
->
L
loc
(
Hs
.
InstD
_
(
TyFamInstD
{
tfid_inst
=
d
})))
=
Left
(
c
L
loc
d
)
is_tyfam_inst
(
L
loc
(
Hs
.
InstD
_
(
TyFamInstD
{
tfid_inst
=
d
})))
=
Left
(
L
loc
d
)
is_tyfam_inst
decl
=
Right
decl
is_datafam_inst
::
LHsDecl
GhcPs
->
Either
(
LDataFamInstDecl
GhcPs
)
(
LHsDecl
GhcPs
)
is_datafam_inst
(
dL
->
L
loc
(
Hs
.
InstD
_
(
DataFamInstD
{
dfid_inst
=
d
})))
=
Left
(
c
L
loc
d
)
is_datafam_inst
(
L
loc
(
Hs
.
InstD
_
(
DataFamInstD
{
dfid_inst
=
d
})))
=
Left
(
L
loc
d
)
is_datafam_inst
decl
=
Right
decl
is_sig
::
LHsDecl
GhcPs
->
Either
(
LSig
GhcPs
)
(
LHsDecl
GhcPs
)
is_sig
(
dL
->
L
loc
(
Hs
.
SigD
_
sig
))
=
Left
(
c
L
loc
sig
)
is_sig
decl
=
Right
decl
is_sig
(
L
loc
(
Hs
.
SigD
_
sig
))
=
Left
(
L
loc
sig
)
is_sig
decl
=
Right
<