ghc-7.6.3: The GHC API

Safe HaskellNone

HsDecls

Contents

Description

Abstract syntax of global declarations.

Definitions for: TyDecl and ConDecl, ClassDecl, InstDecl, DefaultDecl and ForeignDecl.

Synopsis

Toplevel declarations

data HsDecl id

A Haskell Declaration

Constructors

TyClD (TyClDecl id)

A type or class declaration.

InstD (InstDecl id)

An instance declaration.

DerivD (DerivDecl id) 
ValD (HsBind id) 
SigD (Sig id) 
DefD (DefaultDecl id) 
ForD (ForeignDecl id) 
WarningD (WarnDecl id) 
AnnD (AnnDecl id) 
RuleD (RuleDecl id) 
VectD (VectDecl id) 
SpliceD (SpliceDecl id) 
DocD DocDecl 
QuasiQuoteD (HsQuasiQuote id) 

Instances

type LHsDecl id = Located (HsDecl id)

data HsTyDefn name

Constructors

TySynonym

Synonym expansion

Fields

td_synRhs :: LHsType name
 
TyData

Declares a data type or newtype, giving its construcors data/newtype T a = constrs data/newtype instance T [a] = constrs

Fields

td_ND :: NewOrData
 
td_ctxt :: LHsContext name

Context

td_cType :: Maybe CType
 
td_kindSig :: Maybe (LHsKind name)

Optional kind signature.

(Just k) for a GADT-style data, or data instance decl, with explicit kind sig

Always Nothing for H98-syntax decls

td_cons :: [LConDecl name]

Data constructors

For data T a = T1 | T2 a the LConDecls all have ResTyH98. For data T a where { T1 :: T a } the LConDecls all have ResTyGADT.

td_derivs :: Maybe [LHsType name]

Derivings; Nothing => not specified, Just [] => derive exactly what is asked

These types must be of form forall ab. C ty1 ty2 Typically the foralls and ty args are empty, but they are non-empty for the newtype-deriving case

Instances

Class or type declarations

data TyClDecl name

A type or class declaration.

Constructors

ForeignType 

Fields

tcdLName :: Located name

Name of the class

Type constructor

tcdExtName :: Maybe FastString
 
TyFamily
type/data family T :: *->*

Fields

tcdFlavour :: FamilyFlavour
 
tcdLName :: Located name

Name of the class

Type constructor

tcdTyVars :: LHsTyVarBndrs name

Class type variables

Type variables; for an associated type these include outer binders Eg class T a where type F a :: * type F a = a -> a Here the type decl for f includes a in its tcdTyVars

tcdKindSig :: Maybe (LHsKind name)
 
TyDecl 

Fields

tcdLName :: Located name

Name of the class

Type constructor

tcdTyVars :: LHsTyVarBndrs name

Class type variables

Type variables; for an associated type these include outer binders Eg class T a where type F a :: * type F a = a -> a Here the type decl for f includes a in its tcdTyVars

tcdTyDefn :: HsTyDefn name
 
tcdFVs :: NameSet
 
ClassDecl 

Fields

tcdCtxt :: LHsContext name

Context...

tcdLName :: Located name

Name of the class

Type constructor

tcdTyVars :: LHsTyVarBndrs name

Class type variables

Type variables; for an associated type these include outer binders Eg class T a where type F a :: * type F a = a -> a Here the type decl for f includes a in its tcdTyVars

tcdFDs :: [Located (FunDep name)]

Functional deps

tcdSigs :: [LSig name]

Methods' signatures

tcdMeths :: LHsBinds name

Default methods

tcdATs :: [LTyClDecl name]

Associated types; ie only TyFamily

tcdATDefs :: [LFamInstDecl name]

Associated type defaults; ie only TySynonym

tcdDocs :: [LDocDecl]

Haddock docs

tcdFVs :: NameSet
 

Instances

type LTyClDecl name = Located (TyClDecl name)

type TyClGroup name = [LTyClDecl name]

isClassDecl :: TyClDecl name -> Bool

type class

isDataDecl :: TyClDecl name -> Bool

True = argument is a data/newtype declaration.

isSynDecl :: TyClDecl name -> Bool

type or type instance declaration

isFamilyDecl :: TyClDecl name -> Bool

type family declaration

tcdName :: TyClDecl name -> name

countTyClDecls :: [TyClDecl name] -> (Int, Int, Int, Int, Int)

Instance declarations

data InstDecl name

Constructors

ClsInstD 

Fields

cid_poly_ty :: LHsType name
 
cid_binds :: LHsBinds name
 
cid_sigs :: [LSig name]
 
cid_fam_insts :: [LFamInstDecl name]
 
FamInstD 

Fields

lid_inst :: FamInstDecl name
 

Instances

type LInstDecl name = Located (InstDecl name)

data NewOrData

Constructors

NewType
newtype Blah ...
DataType
data Blah ...

data FamilyFlavour

Constructors

TypeFamily
type family ...
DataFamily
data family ...

data FamInstDecl name

Constructors

FamInstDecl 

Fields

fid_tycon :: Located name
 
fid_pats :: HsWithBndrs [LHsType name]

Type patterns (with kind and type bndrs) See Note [Family instance declaration binders]

fid_defn :: HsTyDefn name
 
fid_fvs :: NameSet
 

Instances

type LFamInstDecl name = Located (FamInstDecl name)

Standalone deriving declarations

data DerivDecl name

Constructors

DerivDecl 

Fields

deriv_type :: LHsType name
 

Instances

type LDerivDecl name = Located (DerivDecl name)

RULE declarations

data RuleDecl name

Constructors

HsRule RuleName Activation [RuleBndr name] (Located (HsExpr name)) NameSet (Located (HsExpr name)) NameSet 

Instances

type LRuleDecl name = Located (RuleDecl name)

data RuleBndr name

Constructors

RuleBndr (Located name) 
RuleBndrSig (Located name) (HsWithBndrs (LHsType name)) 

Instances

VECTORISE declarations

type LVectDecl name = Located (VectDecl name)

default declarations

data DefaultDecl name

Constructors

DefaultDecl [LHsType name] 

Instances

type LDefaultDecl name = Located (DefaultDecl name)

Top-level template haskell splice

data SpliceDecl id

Foreign function interface declarations

type LForeignDecl name = Located (ForeignDecl name)

Data-constructor declarations

data ConDecl name

Constructors

ConDecl 

Fields

con_name :: Located name

Constructor name. This is used for the DataCon itself, and for the user-callable wrapper Id.

con_explicit :: HsExplicitFlag

Is there an user-written forall? (cf. HsForAllTy)

con_qvars :: LHsTyVarBndrs name

Type variables. Depending on con_res this describes the following entities

  • ResTyH98: the constructor's *existential* type variables - ResTyGADT: *all* the constructor's quantified type variables

If con_explicit is Implicit, then con_qvars is irrelevant until after renaming.

con_cxt :: LHsContext name

The context. This does not include the "stupid theta" which lives only in the TyData decl.

con_details :: HsConDeclDetails name

The main payload

con_res :: ResType (LHsType name)

Result type of the constructor

con_doc :: Maybe LHsDocString

A possible Haddock comment.

con_old_rec :: Bool

TEMPORARY field; True = user has employed now-deprecated syntax for GADT-style record decl C { blah } :: T a b Remove this when we no longer parse this stuff, and hence do not need to report decprecated use

Instances

type LConDecl name = Located (ConDecl name)

data ResType ty

Constructors

ResTyH98 
ResTyGADT ty 

Instances

Document comments

Deprecations

data WarnDecl name

Constructors

Warning name WarningTxt 

Instances

type LWarnDecl name = Located (WarnDecl name)

Annotations

data AnnDecl name

Constructors

HsAnnotation (AnnProvenance name) (Located (HsExpr name)) 

Instances

type LAnnDecl name = Located (AnnDecl name)

modifyAnnProvenanceNameM :: Monad m => (before -> m after) -> AnnProvenance before -> m (AnnProvenance after)

Grouping

data HsGroup id

A HsDecl is categorised into a HsGroup before being fed to the renamer.

Constructors

HsGroup 

Instances