ghc-7.10.2: The GHC API

Safe HaskellNone
LanguageHaskell2010

HsDecls

Contents

Description

Abstract syntax of global declarations.

Definitions for: SynDecl 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 (WarnDecls id) 
AnnD (AnnDecl id) 
RuleD (RuleDecls id) 
VectD (VectDecl id) 
SpliceD (SpliceDecl id) 
DocD DocDecl 
QuasiQuoteD (HsQuasiQuote id) 
RoleAnnotD (RoleAnnotDecl id) 

Instances

DataId id => Data (HsDecl id) 
OutputableBndr name => Outputable (HsDecl name) 

type LHsDecl id

Arguments

 = Located (HsDecl id)

When in a list this may have

data HsDataDefn name

Constructors

HsDataDefn

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

Fields

dd_ND :: NewOrData
 
dd_ctxt :: LHsContext name

Context

dd_cType :: Maybe (Located CType)
 
dd_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

dd_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.

dd_derivs :: Maybe (Located [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

FamDecl
type/data family T :: *->*

Fields

tcdFam :: FamilyDecl name
 
SynDecl

type declaration

Fields

tcdLName :: Located name

Type constructor

tcdTyVars :: LHsTyVarBndrs name

Type variables; for an associated type these include outer binders

tcdRhs :: LHsType name

RHS of type declaration

tcdFVs :: PostRn name NameSet
 
DataDecl

data declaration

Fields

tcdLName :: Located name

Type constructor

tcdTyVars :: LHsTyVarBndrs name

Type variables; for an associated type these include outer binders

tcdDataDefn :: HsDataDefn name
 
tcdFVs :: PostRn name NameSet
 
ClassDecl

Fields

tcdCtxt :: LHsContext name

Context...

tcdLName :: Located name

Type constructor

tcdTyVars :: LHsTyVarBndrs name

Type variables; for an associated type these include outer binders

tcdFDs :: [Located (FunDep (Located name))]

Functional deps

tcdSigs :: [LSig name]

Methods' signatures

tcdMeths :: LHsBinds name

Default methods

tcdATs :: [LFamilyDecl name]

Associated types;

tcdATDefs :: [LTyFamDefltEqn name]

Associated type defaults

tcdDocs :: [LDocDecl]

Haddock docs

tcdFVs :: PostRn name NameSet
 

Instances

DataId id => Data (TyClDecl id) 
OutputableBndr name => Outputable (TyClDecl name) 

type LTyClDecl name = Located (TyClDecl name)

data TyClGroup name

Constructors

TyClGroup 

Fields

group_tyclds :: [LTyClDecl name]
 
group_roles :: [LRoleAnnotDecl name]
 

Instances

tyClGroupConcat :: [TyClGroup name] -> [LTyClDecl name]

mkTyClGroup :: [LTyClDecl name] -> TyClGroup 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

tcdName :: TyClDecl name -> name

isFamilyDecl :: TyClDecl name -> Bool

type/data family declaration

isTypeFamilyDecl :: TyClDecl name -> Bool

type family declaration

isDataFamilyDecl :: TyClDecl name -> Bool

data family declaration

isOpenTypeFamilyInfo :: FamilyInfo name -> Bool

open type family info

isClosedTypeFamilyInfo :: FamilyInfo name -> Bool

closed type family info

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

hsDeclHasCusk :: TyClDecl name -> Bool

Does this declaration have a complete, user-supplied kind signature? See Note [Complete user-supplied kind signatures]

famDeclHasCusk :: FamilyDecl name -> Bool

Does this family declaration have a complete, user-supplied kind signature?

data FamilyDecl name

Constructors

FamilyDecl 

Fields

fdInfo :: FamilyInfo name
 
fdLName :: Located name
 
fdTyVars :: LHsTyVarBndrs name
 
fdKindSig :: Maybe (LHsKind name)
 

Instances

type LFamilyDecl name = Located (FamilyDecl name)

Instance declarations

data InstDecl name

Constructors

ClsInstD 

Fields

cid_inst :: ClsInstDecl name
 
DataFamInstD 

Fields

dfid_inst :: DataFamInstDecl name
 
TyFamInstD 

Fields

tfid_inst :: TyFamInstDecl name
 

Instances

DataId id => Data (InstDecl id) 
OutputableBndr name => Outputable (InstDecl name) 

type LInstDecl name = Located (InstDecl name)

data NewOrData

Constructors

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

data FamilyInfo name

Instances

DataId name => Data (FamilyInfo name) 
Outputable (FamilyInfo name) 

data TyFamEqn name pats

One equation in a type family instance declaration See Note [Type family instance declarations in HsSyn]

Constructors

TyFamEqn

Fields

tfe_tycon :: Located name
 
tfe_pats :: pats
 
tfe_rhs :: LHsType name
 

Instances

(DataId name, Data pats) => Data (TyFamEqn name pats) 

type TyFamInstEqn name = TyFamEqn name (HsTyPats name)

type LTyFamInstEqn name

Arguments

 = Located (TyFamInstEqn name)

May have AnnKeywordId : AnnSemi when in a list

type TyFamDefltEqn name = TyFamEqn name (LHsTyVarBndrs name)

type HsTyPats name

Arguments

 = HsWithBndrs name [LHsType name]

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

type LClsInstDecl name = Located (ClsInstDecl name)

Standalone deriving declarations

type LDerivDecl name = Located (DerivDecl name)

RULE declarations

type LRuleDecls name = Located (RuleDecls name)

data RuleDecls name

Constructors

HsRules 

Fields

rds_src :: SourceText
 
rds_rules :: [LRuleDecl name]
 

Instances

DataId name => Data (RuleDecls name) 
OutputableBndr name => Outputable (RuleDecls name) 

type LRuleDecl name = Located (RuleDecl name)

data RuleBndr name

Instances

DataId name => Data (RuleBndr name) 
OutputableBndr name => Outputable (RuleBndr name) 

type LRuleBndr name = Located (RuleBndr name)

VECTORISE declarations

type LVectDecl name = Located (VectDecl name)

default declarations

data DefaultDecl name

Instances

DataId name => Data (DefaultDecl name) 
OutputableBndr name => Outputable (DefaultDecl name) 

type LDefaultDecl name = Located (DefaultDecl name)

Template haskell declaration splice

data SpliceDecl id

Instances

type LSpliceDecl name = Located (SpliceDecl name)

Foreign function interface declarations

type LForeignDecl name = Located (ForeignDecl name)

Data-constructor declarations

data ConDecl name

data T b = forall a. Eq a => MkT a b
  MkT :: forall b a. Eq a => MkT a b

data T b where
     MkT1 :: Int -> T Int

data T = Int MkT Int
       | MkT2

data T a where
     Int MkT Int :: T Int

Constructors

ConDecl 

Fields

con_names :: [Located name]

Constructor names. This is used for the DataCon itself, and for the user-callable wrapper Id. It is a list to deal with GADT constructors of the form T1, T2, T3 :: payload

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

DataId name => Data (ConDecl name) 
OutputableBndr name => Outputable (ConDecl name) 

type LConDecl name

Arguments

 = Located (ConDecl name)

May have AnnKeywordId : AnnSemi when in a GADT constructor list

data ResType ty

Constructors

ResTyH98 
ResTyGADT SrcSpan ty 

Instances

Data ty => Data (ResType ty) 
Outputable ty => Outputable (ResType ty) 

Document comments

Deprecations

data WarnDecl name

Constructors

Warning [Located name] WarningTxt 

Instances

Data name => Data (WarnDecl name) 
OutputableBndr name => Outputable (WarnDecl name) 

type LWarnDecl name = Located (WarnDecl name)

data WarnDecls name

Constructors

Warnings 

Fields

wd_src :: SourceText
 
wd_warnings :: [LWarnDecl name]
 

Instances

Data name => Data (WarnDecls name) 
OutputableBndr name => Outputable (WarnDecls name) 

type LWarnDecls name = Located (WarnDecls name)

Annotations

type LAnnDecl name = Located (AnnDecl name)

Role annotations

data RoleAnnotDecl name

Instances

Grouping

data HsGroup id

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

Instances

DataId id => Data (HsGroup id) 
OutputableBndr name => Outputable (HsGroup name)