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
51192964
Commit
51192964
authored
Sep 11, 2019
by
Sylvain Henry
Committed by
Marge Bot
Sep 20, 2019
Browse files
Module hierarchy: Hs (#13009)
Add GHC.Hs module hierarchy replacing hsSyn. Metric Increase: haddock.compiler
parent
4853d962
Pipeline
#10378
failed with stages
in 52 seconds
Changes
136
Pipelines
1
Hide whitespace changes
Inline
Side-by-side
compiler/
hsSyn/HsSyn
.hs
→
compiler/
GHC/Hs
.hs
View file @
51192964
...
...
@@ -13,23 +13,23 @@ therefore, is almost nothing but re-exporting.
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-}
-- Note [Pass sensitive types]
-- in module PlaceHolder
-- in module
GHC.Hs.
PlaceHolder
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleInstances #-}
-- For deriving instance Data
module
HsSyn
(
module
HsBinds
,
module
HsDecls
,
module
HsExpr
,
module
HsImpExp
,
module
HsLit
,
module
HsPat
,
module
HsTypes
,
module
HsUtils
,
module
HsDoc
,
module
PlaceHolder
,
module
HsExtension
,
module
GHC.Hs
(
module
GHC
.
Hs
.
Binds
,
module
GHC
.
Hs
.
Decls
,
module
GHC
.
Hs
.
Expr
,
module
GHC
.
Hs
.
ImpExp
,
module
GHC
.
Hs
.
Lit
,
module
GHC
.
Hs
.
Pat
,
module
GHC
.
Hs
.
Types
,
module
GHC
.
Hs
.
Utils
,
module
GHC
.
Hs
.
Doc
,
module
GHC
.
Hs
.
PlaceHolder
,
module
GHC
.
Hs
.
Extension
,
Fixity
,
HsModule
(
..
),
...
...
@@ -38,19 +38,19 @@ module HsSyn (
-- friends:
import
GhcPrelude
import
HsDecls
import
HsBinds
import
HsExpr
import
HsImpExp
import
HsLit
import
PlaceHolder
import
HsExtension
import
HsPat
import
HsTypes
import
GHC.
Hs
.
Decls
import
GHC.
Hs
.
Binds
import
GHC.
Hs
.
Expr
import
GHC.
Hs
.
ImpExp
import
GHC.
Hs
.
Lit
import
GHC.Hs.
PlaceHolder
import
GHC.
Hs
.
Extension
import
GHC.
Hs
.
Pat
import
GHC.
Hs
.
Types
import
BasicTypes
(
Fixity
,
WarningTxt
)
import
HsUtils
import
HsDoc
import
HsInstances
()
-- For Data instances
import
GHC.
Hs
.
Utils
import
GHC.
Hs
.
Doc
import
GHC.
Hs
.
Instances
()
-- For Data instances
-- others:
import
Outputable
...
...
compiler/
hsSyn
/HsBinds.hs
→
compiler/
GHC
/Hs
/
Binds.hs
View file @
51192964
...
...
@@ -12,22 +12,22 @@ Datatype for: @BindGroup@, @Bind@, @Sig@, @Bind@.
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-}
-- Note [Pass sensitive types]
-- in module PlaceHolder
-- in module
GHC.Hs.
PlaceHolder
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE TypeFamilies #-}
module
HsBinds
where
module
GHC.
Hs
.
Binds
where
import
GhcPrelude
import
{-#
SOURCE
#-
}
HsExpr
(
pprExpr
,
LHsExpr
,
MatchGroup
,
pprFunBind
,
GRHSs
,
pprPatBind
)
import
{-#
SOURCE
#-
}
HsPat
(
LPat
)
import
{-#
SOURCE
#-
}
GHC
.
Hs
.
Expr
(
pprExpr
,
LHsExpr
,
MatchGroup
,
pprFunBind
,
GRHSs
,
pprPatBind
)
import
{-#
SOURCE
#-
}
GHC
.
Hs
.
Pat
(
LPat
)
import
HsExtension
import
HsTypes
import
GHC.
Hs
.
Extension
import
GHC.
Hs
.
Types
import
CoreSyn
import
TcEvidence
import
Type
...
...
@@ -223,7 +223,7 @@ data HsBindLR idL idR
-- free variables of this defn.
-- See Note [Bind free vars]
fun_id
::
Located
(
IdP
idL
),
-- Note [fun_id in Match] in HsExpr
fun_id
::
Located
(
IdP
idL
),
-- Note [fun_id in Match] in
GHC.
Hs
.
Expr
fun_matches
::
MatchGroup
idR
(
LHsExpr
idR
),
-- ^ The payload
...
...
compiler/
hsSyn
/HsDecls.hs
→
compiler/
GHC
/Hs
/
Decls.hs
View file @
51192964
...
...
@@ -8,7 +8,7 @@
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-}
-- Note [Pass sensitive types]
-- in module PlaceHolder
-- in module
GHC.Hs.
PlaceHolder
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE TypeFamilies #-}
...
...
@@ -16,7 +16,7 @@
--
-- Definitions for: @SynDecl@ and @ConDecl@, @ClassDecl@,
-- @InstDecl@, @DefaultDecl@ and @ForeignDecl@.
module
HsDecls
(
module
GHC.
Hs
.
Decls
(
-- * Toplevel declarations
HsDecl
(
..
),
LHsDecl
,
HsDataDefn
(
..
),
HsDeriving
,
LHsFunDep
,
HsDerivingClause
(
..
),
LHsDerivingClause
,
NewOrData
(
..
),
newOrDataToFlavour
,
...
...
@@ -88,18 +88,18 @@ module HsDecls (
-- friends:
import
GhcPrelude
import
{-#
SOURCE
#-
}
HsExpr
(
HsExpr
,
HsSplice
,
pprExpr
,
pprSpliceDecl
)
import
{-#
SOURCE
#-
}
GHC
.
Hs
.
Expr
(
HsExpr
,
HsSplice
,
pprExpr
,
pprSpliceDecl
)
-- Because Expr imports Decls via HsBracket
import
HsBinds
import
HsTypes
import
HsDoc
import
GHC.
Hs
.
Binds
import
GHC.
Hs
.
Types
import
GHC.
Hs
.
Doc
import
TyCon
import
BasicTypes
import
Coercion
import
ForeignCall
import
HsExtension
import
GHC.
Hs
.
Extension
import
NameSet
-- others:
...
...
@@ -388,7 +388,7 @@ Default methods
E.g. $dmmax
- If there is a default method name at all, it's recorded in
the ClassOpSig (in HsBinds), in the DefMethInfo field.
the ClassOpSig (in
GHC.
Hs
.
Binds), in the DefMethInfo field.
(DefMethInfo is defined in Class.hs)
Source-code class decls and interface-code class decls are treated subtly
...
...
@@ -1370,7 +1370,7 @@ There's a wrinkle in ConDeclGADT
con_res_ty = T a
We need the RecCon before the reanmer, so we can find the record field
binders in HsUtils.hsConDeclsBinders.
binders in
GHC.
Hs
.
Utils.hsConDeclsBinders.
* However for a GADT constr declaration which is not a record, it can
be hard parse until we know operator fixities. Consider for example
...
...
compiler/
hsSyn
/HsDoc.hs
→
compiler/
GHC
/Hs
/
Doc.hs
View file @
51192964
...
...
@@ -2,7 +2,7 @@
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module
HsDoc
module
GHC.
Hs
.
Doc
(
HsDocString
,
LHsDocString
,
mkHsDocString
...
...
compiler/
hsSyn
/HsDump
Ast
.hs
→
compiler/
GHC
/Hs
/
Dump.hs
View file @
51192964
...
...
@@ -5,11 +5,11 @@
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
-- | Contains a debug function to dump parts of the
hsSyn
AST. It uses a syb
-- | Contains a debug function to dump parts of the
GHC.Hs
AST. It uses a syb
-- traversal which falls back to displaying based on the constructor name, so
-- can be used to dump anything having a @Data.Data@ instance.
module
HsDump
Ast
(
module
GHC.
Hs
.
Dump
(
-- * Dumping ASTs
showAstData
,
BlankSrcSpan
(
..
),
...
...
@@ -25,7 +25,7 @@ import NameSet
import
Name
import
DataCon
import
SrcLoc
import
HsSyn
import
GHC.Hs
import
OccName
hiding
(
occName
)
import
Var
import
Module
...
...
compiler/
hsSyn
/HsExpr.hs
→
compiler/
GHC
/Hs
/
Expr.hs
View file @
51192964
...
...
@@ -7,27 +7,27 @@
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-}
-- Note [Pass sensitive types]
-- in module PlaceHolder
-- in module
GHC.Hs.
PlaceHolder
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE TypeFamilies #-}
-- | Abstract Haskell syntax for expressions.
module
HsExpr
where
module
GHC.
Hs
.
Expr
where
#
include
"HsVersions.h"
-- friends:
import
GhcPrelude
import
HsDecls
import
HsPat
import
HsLit
import
PlaceHolder
(
NameOrRdrName
)
import
HsExtension
import
HsTypes
import
HsBinds
import
GHC.
Hs
.
Decls
import
GHC.
Hs
.
Pat
import
GHC.
Hs
.
Lit
import
GHC.Hs.
PlaceHolder
(
NameOrRdrName
)
import
GHC.
Hs
.
Extension
import
GHC.
Hs
.
Types
import
GHC.
Hs
.
Binds
-- others:
import
TcEvidence
...
...
@@ -629,7 +629,7 @@ data HsExpr p
-- Finally, HsWrap appears only in typechecker output
-- The contained Expr is *NOT* itself an HsWrap.
-- See Note [Detecting forced eta expansion] in DsExpr. This invariant
-- is maintained by HsUtils.mkHsWrap.
-- is maintained by
GHC.
Hs
.
Utils.mkHsWrap.
|
HsWrap
(
XWrap
p
)
HsWrapper
-- TRANSLATION
...
...
@@ -1630,12 +1630,12 @@ pprMatches MG { mg_alts = matches }
-- Don't print the type; it's only a place-holder before typechecking
pprMatches
(
XMatchGroup
x
)
=
ppr
x
-- Exported to HsBinds, which can't see the defn of HsMatchContext
-- Exported to
GHC.
Hs
.
Binds, which can't see the defn of HsMatchContext
pprFunBind
::
(
OutputableBndrId
(
GhcPass
idR
),
Outputable
body
)
=>
MatchGroup
(
GhcPass
idR
)
body
->
SDoc
pprFunBind
matches
=
pprMatches
matches
-- Exported to HsBinds, which can't see the defn of HsMatchContext
-- Exported to
GHC.
Hs
.
Binds, which can't see the defn of HsMatchContext
pprPatBind
::
forall
bndr
p
body
.
(
OutputableBndrId
(
GhcPass
bndr
),
OutputableBndrId
(
GhcPass
p
),
Outputable
body
)
...
...
compiler/
hsSyn
/HsExpr.hs-boot
→
compiler/
GHC
/Hs
/
Expr.hs-boot
View file @
51192964
{-# LANGUAGE CPP, KindSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-}
-- Note [Pass sensitive types]
-- in module PlaceHolder
-- in module
GHC.Hs.
PlaceHolder
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE RoleAnnotations #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE TypeFamilies #-}
module
HsExpr
where
module
GHC.
Hs
.
Expr
where
import
SrcLoc
(
Located
)
import
Outputable
(
SDoc
,
Outputable
)
import
{-#
SOURCE
#-
}
HsPat
(
LPat
)
import
{-#
SOURCE
#-
}
GHC
.
Hs
.
Pat
(
LPat
)
import
BasicTypes
(
SpliceExplicitFlag
(
..
))
import
HsExtension
(
OutputableBndrId
,
GhcPass
)
import
GHC.
Hs
.
Extension
(
OutputableBndrId
,
GhcPass
)
type
role
HsExpr
nominal
type
role
HsCmd
nominal
...
...
compiler/
hsSyn
/HsExtension.hs
→
compiler/
GHC
/Hs
/
Extension.hs
View file @
51192964
...
...
@@ -11,17 +11,17 @@
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE UndecidableInstances #-}
-- Note [Pass sensitive types]
-- in module PlaceHolder
-- in module
GHC.Hs.
PlaceHolder
module
HsExtension
where
module
GHC.
Hs
.
Extension
where
-- This module captures the type families to precisely identify the extension
-- points for
HsSyn
-- points for
GHC.Hs syntax
import
GhcPrelude
import
Data.Data
hiding
(
Fixity
)
import
PlaceHolder
import
GHC.Hs.
PlaceHolder
import
Name
import
RdrName
import
Var
...
...
@@ -152,7 +152,7 @@ type instance IdP GhcTc = Id
type
LIdP
p
=
Located
(
IdP
p
)
-- | Marks that a field uses the GhcRn variant even when the pass
-- parameter is GhcTc. Useful for storing HsTypes in HsExprs, say, because
-- parameter is GhcTc. Useful for storing HsTypes in
GHC.
Hs
.
Exprs, say, because
-- HsType GhcTc should never occur.
type
family
NoGhcTc
(
p
::
Type
)
where
-- this way, GHC can figure out that the result is a GhcPass
...
...
compiler/
hsSyn
/HsImpExp.hs
→
compiler/
GHC
/Hs
/
ImpExp.hs
View file @
51192964
...
...
@@ -3,7 +3,7 @@
(c) The GRASP/AQUA Project, Glasgow University, 1992-1998
HsImpExp: Abstract syntax: imports, exports, interfaces
GHC.
Hs
.
ImpExp: Abstract syntax: imports, exports, interfaces
-}
{-# LANGUAGE DeriveDataTypeable #-}
...
...
@@ -11,14 +11,14 @@ HsImpExp: Abstract syntax: imports, exports, interfaces
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
-- Note [Pass sensitive types]
-- in module PlaceHolder
-- in module
GHC.Hs.
PlaceHolder
module
HsImpExp
where
module
GHC.
Hs
.
ImpExp
where
import
GhcPrelude
import
Module
(
ModuleName
)
import
HsDoc
(
HsDocString
)
import
GHC.
Hs
.
Doc
(
HsDocString
)
import
OccName
(
HasOccName
(
..
),
isTcOcc
,
isSymOcc
)
import
BasicTypes
(
SourceText
(
..
),
StringLiteral
(
..
),
pprWithSourceText
)
import
FieldLabel
(
FieldLbl
(
..
)
)
...
...
@@ -26,7 +26,7 @@ import FieldLabel ( FieldLbl(..) )
import
Outputable
import
FastString
import
SrcLoc
import
HsExtension
import
GHC.
Hs
.
Extension
import
Data.Data
import
Data.Maybe
...
...
@@ -213,7 +213,7 @@ data IE pass
-- 'ApiAnnotation.AnnType','ApiAnnotation.AnnVal'
-- For details on above see note [Api annotations] in ApiAnnotation
-- See Note [Located RdrNames] in HsExpr
-- See Note [Located RdrNames] in
GHC.
Hs
.
Expr
|
IEThingAll
(
XIEThingAll
pass
)
(
LIEWrappedName
(
IdP
pass
))
-- ^ Imported or exported Thing with All imported or exported
--
...
...
@@ -224,7 +224,7 @@ data IE pass
-- 'ApiAnnotation.AnnType'
-- For details on above see note [Api annotations] in ApiAnnotation
-- See Note [Located RdrNames] in HsExpr
-- See Note [Located RdrNames] in
GHC.
Hs
.
Expr
|
IEThingWith
(
XIEThingWith
pass
)
(
LIEWrappedName
(
IdP
pass
))
...
...
compiler/
hsSyn
/HsInstances.hs
→
compiler/
GHC
/Hs
/
Instances.hs
View file @
51192964
...
...
@@ -5,7 +5,7 @@
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module
HsInstances
where
module
GHC.
Hs
.
Instances
where
-- This module defines the Data instances for the hsSyn AST.
...
...
@@ -17,20 +17,20 @@ module HsInstances where
import
Data.Data
hiding
(
Fixity
)
import
GhcPrelude
import
HsExtension
import
HsBinds
import
HsDecls
import
HsExpr
import
HsLit
import
HsTypes
import
HsPat
import
HsImpExp
import
GHC.
Hs
.
Extension
import
GHC.
Hs
.
Binds
import
GHC.
Hs
.
Decls
import
GHC.
Hs
.
Expr
import
GHC.
Hs
.
Lit
import
GHC.
Hs
.
Types
import
GHC.
Hs
.
Pat
import
GHC.
Hs
.
ImpExp
-- ---------------------------------------------------------------------
-- Data derivations from
HsSyn
-----------------------------------------
-- Data derivations from
GHC.Hs
-----------------------------------------
-- ---------------------------------------------------------------------
-- Data derivations from HsBinds ----------------------------------
-----
-- Data derivations from
GHC.
Hs
.
Binds ----------------------------------
-- deriving instance (DataIdLR pL pR) => Data (HsLocalBindsLR pL pR)
deriving
instance
Data
(
HsLocalBindsLR
GhcPs
GhcPs
)
...
...
@@ -92,7 +92,7 @@ deriving instance Data (HsPatSynDir GhcRn)
deriving
instance
Data
(
HsPatSynDir
GhcTc
)
-- ---------------------------------------------------------------------
-- Data derivations from HsDecls ----------------------------------
-----
-- Data derivations from
GHC.
Hs
.
Decls ----------------------------------
-- deriving instance (DataIdLR p p) => Data (HsDecl p)
deriving
instance
Data
(
HsDecl
GhcPs
)
...
...
@@ -235,7 +235,7 @@ deriving instance Data (RoleAnnotDecl GhcRn)
deriving
instance
Data
(
RoleAnnotDecl
GhcTc
)
-- ---------------------------------------------------------------------
-- Data derivations from HsExpr -----------------------------------
-----
-- Data derivations from
GHC.
Hs
.
Expr -----------------------------------
-- deriving instance (DataIdLR p p) => Data (SyntaxExpr p)
deriving
instance
Data
(
SyntaxExpr
GhcPs
)
...
...
@@ -327,7 +327,7 @@ deriving instance Data PendingRnSplice
deriving
instance
Data
PendingTcSplice
-- ---------------------------------------------------------------------
-- Data derivations from HsLit ------------------------------------
----
-- Data derivations from
GHC.
Hs
.
Lit ------------------------------------
-- deriving instance (DataId p) => Data (HsLit p)
deriving
instance
Data
(
HsLit
GhcPs
)
...
...
@@ -340,7 +340,7 @@ deriving instance Data (HsOverLit GhcRn)
deriving
instance
Data
(
HsOverLit
GhcTc
)
-- ---------------------------------------------------------------------
-- Data derivations from HsPat ------------------------------------
-----
-- Data derivations from
GHC.
Hs
.
Pat ------------------------------------
-- deriving instance (DataIdLR p p) => Data (Pat p)
deriving
instance
Data
(
Pat
GhcPs
)
...
...
@@ -355,7 +355,7 @@ deriving instance (Data body) => Data (HsRecFields GhcRn body)
deriving
instance
(
Data
body
)
=>
Data
(
HsRecFields
GhcTc
body
)
-- ---------------------------------------------------------------------
-- Data derivations from HsTypes ----------------------------------
-----
-- Data derivations from
GHC.
Hs
.
Types ----------------------------------
-- deriving instance (DataIdLR p p) => Data (LHsQTyVars p)
deriving
instance
Data
(
LHsQTyVars
GhcPs
)
...
...
compiler/
hsSyn
/HsLit.hs
→
compiler/
GHC
/Hs
/
Lit.hs
View file @
51192964
...
...
@@ -10,23 +10,23 @@
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-}
-- Note [Pass sensitive types]
-- in module PlaceHolder
-- in module
GHC.Hs.
PlaceHolder
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE TypeFamilies #-}
module
HsLit
where
module
GHC.
Hs
.
Lit
where
#
include
"HsVersions.h"
import
GhcPrelude
import
{-#
SOURCE
#-
}
HsExpr
(
HsExpr
,
pprExpr
)
import
{-#
SOURCE
#-
}
GHC
.
Hs
.
Expr
(
HsExpr
,
pprExpr
)
import
BasicTypes
(
IntegralLit
(
..
),
FractionalLit
(
..
),
negateIntegralLit
,
negateFractionalLit
,
SourceText
(
..
),
pprWithSourceText
)
import
Type
import
Outputable
import
FastString
import
HsExtension
import
GHC.
Hs
.
Extension
import
Data.ByteString
(
ByteString
)
import
Data.Data
hiding
(
Fixity
)
...
...
@@ -41,7 +41,7 @@ import Data.Data hiding ( Fixity )
-- Note [Literal source text] in BasicTypes for SourceText fields in
-- the following
-- Note [Trees that grow] in HsExtension for the Xxxxx fields in the following
-- Note [Trees that grow] in
GHC.
Hs
.
Extension for the Xxxxx fields in the following
-- | Haskell Literal
data
HsLit
x
=
HsChar
(
XHsChar
x
)
{- SourceText -}
Char
...
...
compiler/
hsSyn
/HsPat.hs
→
compiler/
GHC
/Hs
/
Pat.hs
View file @
51192964
...
...
@@ -12,13 +12,13 @@
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-}
-- Note [Pass sensitive types]
-- in module PlaceHolder
-- in module
GHC.Hs.
PlaceHolder
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE FlexibleInstances #-}
module
HsPat
(
module
GHC.
Hs
.
Pat
(
Pat
(
..
),
InPat
,
OutPat
,
LPat
,
ListPatTc
(
..
),
...
...
@@ -43,13 +43,13 @@ module HsPat (
import
GhcPrelude
import
{-#
SOURCE
#-
}
HsExpr
(
SyntaxExpr
,
LHsExpr
,
HsSplice
,
pprLExpr
,
pprSplice
)
import
{-#
SOURCE
#-
}
GHC
.
Hs
.
Expr
(
SyntaxExpr
,
LHsExpr
,
HsSplice
,
pprLExpr
,
pprSplice
)
-- friends:
import
HsBinds
import
HsLit
import
HsExtension
import
HsTypes
import
GHC.
Hs
.
Binds
import
GHC.
Hs
.
Lit
import
GHC.
Hs
.
Extension
import
GHC.
Hs
.
Types
import
TcEvidence
import
BasicTypes
-- others:
...
...
@@ -89,7 +89,7 @@ data Pat p
|
VarPat
(
XVarPat
p
)
(
Located
(
IdP
p
))
-- ^ Variable Pattern
-- See Note [Located RdrNames] in HsExpr
-- See Note [Located RdrNames] in
GHC.
Hs
.
Expr
|
LazyPat
(
XLazyPat
p
)
(
LPat
p
)
-- ^ Lazy Pattern
-- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnTilde'
...
...
@@ -104,7 +104,7 @@ data Pat p
|
ParPat
(
XParPat
p
)
(
LPat
p
)
-- ^ Parenthesised pattern
-- See Note [Parens in HsSyn] in HsExpr
-- See Note [Parens in HsSyn] in
GHC.
Hs
.
Expr
-- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'('@,
-- 'ApiAnnotation.AnnClose' @')'@
...
...
@@ -155,7 +155,7 @@ data Pat p
-- 'ApiAnnotation.AnnOpen' @'('@ or @'(#'@,
-- 'ApiAnnotation.AnnClose' @')'@ or @'#)'@
|
SumPat
(
XSumPat
p
)
-- PlaceHolder before typechecker, filled in
|
SumPat
(
XSumPat
p
)
--
GHC.Hs.
PlaceHolder before typechecker, filled in
-- afterwards with the types of the
-- alternative
(
LPat
p
)
-- Sum sub-pattern
...
...
compiler/
hsSyn
/HsPat.hs-boot
→
compiler/
GHC
/Hs
/
Pat.hs-boot
View file @
51192964
{-# LANGUAGE CPP, KindSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-}
-- Note [Pass sensitive types]
-- in module PlaceHolder
-- in module
GHC.Hs.
PlaceHolder
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE RoleAnnotations #-}
{-# LANGUAGE TypeFamilies #-}
module
HsPat
where
module
GHC.
Hs
.
Pat
where
import
Outputable
import
HsExtension
(
OutputableBndrId
,
GhcPass
)
import
GHC.
Hs
.
Extension
(
OutputableBndrId
,
GhcPass
)
type
role
Pat
nominal
data
Pat
(
i
::
*
)
...
...
compiler/
hsSyn
/PlaceHolder.hs
→
compiler/
GHC/Hs
/PlaceHolder.hs
View file @
51192964
...
...
@@ -4,7 +4,7 @@
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE StandaloneDeriving #-}
module
PlaceHolder
where
module
GHC.Hs.
PlaceHolder
where
import
Name
import
NameSet
...
...
compiler/
hsSyn
/HsTypes.hs
→
compiler/
GHC
/Hs
/
Types.hs
View file @
51192964
...
...
@@ -3,7 +3,7 @@
(c) The GRASP/AQUA Project, Glasgow University, 1992-1998
HsTypes: Abstract syntax: user-defined types
GHC.
Hs
.
Types: Abstract syntax: user-defined types
-}
{-# LANGUAGE DeriveDataTypeable #-}
...
...
@@ -12,12 +12,12 @@ HsTypes: Abstract syntax: user-defined types
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE UndecidableInstances #-}
-- Note [Pass sensitive types]
-- in module PlaceHolder
-- in module
GHC.Hs.
PlaceHolder
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE TypeFamilies #-}
module
HsTypes
(
module
GHC.
Hs
.
Types
(
HsType
(
..
),
NewHsTypeX
(
..
),
LHsType
,
HsKind
,
LHsKind
,
HsTyVarBndr
(
..
),
LHsTyVarBndr
,
ForallVisFlag
(
..
),
LHsQTyVars
(
..
),
...
...
@@ -74,9 +74,9 @@ module HsTypes (
import
GhcPrelude
import
{-#
SOURCE
#-
}
HsExpr
(
HsSplice
,
pprSplice
)
import
{-#
SOURCE
#-
}
GHC
.
Hs
.
Expr
(
HsSplice
,
pprSplice
)
import
HsExtension
import
GHC.
Hs
.
Extension
import
Id
(
Id
)
import
Name
(
Name
)
...
...
@@ -85,7 +85,7 @@ import DataCon( HsSrcBang(..), HsImplBang(..),
SrcStrictness
(
..
),
SrcUnpackedness
(
..
)
)
import
TysPrim
(
funTyConName
)
import
Type
import
HsDoc
import
GHC.
Hs
.
Doc
import
BasicTypes
import
SrcLoc
import
Outputable
...
...
@@ -489,7 +489,7 @@ data HsTyVarBndr pass
=
UserTyVar
-- no explicit kinding