ddc-source-tetra-0.4.3.1: Disciplined Disciple Compiler source language.

Safe HaskellSafe
LanguageHaskell98

DDC.Source.Tetra.Exp.Generic

Contents

Description

Abstract syntax for Tetra Source expressions.

Synopsis

Classes

class HasAnonBind l where Source #

Minimal complete definition

isAnon

Methods

isAnon :: l -> GXBindVar l -> Bool Source #

class Anon l where #

Class of languages that support anonymous binding.

Minimal complete definition

withBindings

Instances

Types

Type Functions

type family GTAnnot l :: * #

Yield the type of annotations.

Instances

type family GTBindVar l :: * #

Yield the type of binding occurrences of variables.

Instances

type family GTBoundVar l :: * #

Yield the type of bound occurrences of variables.

Instances

type family GTBindCon l :: * #

Yield the type of binding occurrences of constructors.

Instances

type family GTBoundCon l :: * #

Yield the type of bound occurrences of constructors.

type family GTPrim l :: * #

Yield the type of primitive type names.

Instances

Syntax

data GType l :: * -> * #

Generic type expression representation.

Constructors

TAnnot ~(GTAnnot l) (GType l)

An annotated type.

TCon ~(GTyCon l)

Type constructor or literal.

TVar ~(GTBoundVar l)

Type variable.

TAbs ~(GTBindVar l) (GType l) (GType l)

Type abstracton.

TApp ~(GType l) (GType l)

Type application.

Instances

(Eq (GTAnnot l), Eq (GTyCon l), Eq (GTBindVar l), Eq (GTBoundVar l)) => Eq (GType l) 

Methods

(==) :: GType l -> GType l -> Bool #

(/=) :: GType l -> GType l -> Bool #

ShowGType l => Show (GType l) 

Methods

showsPrec :: Int -> GType l -> ShowS #

show :: GType l -> String #

showList :: [GType l] -> ShowS #

data GTyCon l :: * -> * #

Wrapper for primitive constructors that adds the ones common to SystemFω based languages.

Constructors

TyConVoid

The void constructor.

TyConUnit

The unit constructor.

TyConFun

The function constructor.

TyConUnion ~(GType l)

Take the least upper bound at the given kind.

TyConBot ~(GType l)

The least element of the given kind.

TyConForall ~(GType l)

The universal quantifier with a parameter of the given kind.

TyConExists ~(GType l)

The existential quantifier with a parameter of the given kind.

TyConPrim ~(GTPrim l)

Primitive constructor.

TyConBound ~(GTBoundCon l)

Bound constructor.

Instances

(Eq (GType l), Eq (GTPrim l), Eq (GTBoundCon l)) => Eq (GTyCon l) 

Methods

(==) :: GTyCon l -> GTyCon l -> Bool #

(/=) :: GTyCon l -> GTyCon l -> Bool #

ShowGType l => Show (GTyCon l) 

Methods

showsPrec :: Int -> GTyCon l -> ShowS #

show :: GTyCon l -> String #

showList :: [GTyCon l] -> ShowS #

pattern TApp2 :: forall t. GType t -> GType t -> GType t -> GType t #

Applcation of a type to two arguments.

pattern TApp3 :: forall t. GType t -> GType t -> GType t -> GType t -> GType t #

Applcation of a type to three arguments.

pattern TApp4 :: forall t. GType t -> GType t -> GType t -> GType t -> GType t -> GType t #

Applcation of a type to four arguments.

pattern TApp5 :: forall t. GType t -> GType t -> GType t -> GType t -> GType t -> GType t -> GType t #

Applcation of a type to five arguments.

pattern TVoid :: forall t. GType t #

Representation of the void type.

pattern TUnit :: forall t. GType t #

Representation of the unit type.

pattern TFun :: forall t. GType t -> GType t -> GType t #

Representation of the function type.

pattern TBot :: forall t. GType t -> GType t #

Representation of the bottom type at a given kind.

pattern TUnion :: forall t. GType t -> GType t -> GType t -> GType t #

Representation of a union of two types.

pattern TPrim :: forall t. GTPrim t -> GType t #

Representation of primitive type constructors.

Dictionaries

type ShowGType l = (Show l, Show (GTAnnot l), Show (GTBindVar l), Show (GTBoundVar l), Show (GTBindCon l), Show (GTBoundCon l), Show (GTPrim l)) #

Synonym for show constraints of all language types.

Terms

Type Functions

type family GXAnnot l Source #

Yield the type of annotations.

Instances

type family GXBindVar l Source #

Yield the type of binding occurrences of variables.

Instances

type family GXBoundVar l Source #

Yield the type of bound occurrences of variables.

type family GXBindCon l Source #

Yield the type of binding occurrences of constructors.

type family GXBoundCon l Source #

Yield the type of bound occurrences of constructors.

type family GXPrim l Source #

Yield the type of primitive operator names.

Instances

Syntax

data GXBindVarMT l Source #

A possibly typed binding.

Constructors

XBindVarMT (GXBindVar l) (Maybe (GType l)) 

data GExp l Source #

Well-typed expressions have types of kind Data.

Constructors

XAnnot !(GXAnnot l) !(GExp l) 
XVar !(GXBoundVar l)

Value variable or primitive operation.

XPrim !(GXPrim l)

Primitive values.

XCon !(DaCon (GXBoundCon l) (GType l))

Data constructor or literal.

XLAM !(GXBindVarMT l) !(GExp l)

Type abstraction (level-1).

XLam !(GXBindVarMT l) !(GExp l)

Value and Witness abstraction (level-0).

XApp !(GExp l) !(GExp l)

Application.

XLet !(GLets l) !(GExp l)

A non-recursive let-binding.

XCase !(GExp l) ![GAltCase l]

Case branching.

XCast !(GCast l) !(GExp l)

Type cast.

XType !(GType l)

Type can appear as the argument of an application.

XWitness !(GWitness l)

Witness can appear as the argument of an application.

XDefix !(GXAnnot l) [GExp l]

Some expressions and infix operators that need to be resolved into proper function applications.

XInfixOp !(GXAnnot l) String

Use of a naked infix operator, like in 1 + 2. INVARIANT: only appears in the list of an XDefix node.

XInfixVar !(GXAnnot l) String

Use of an infix operator as a plain variable, like in (+) 1 2. INVARIANT: only appears in the list of an XDefix node.

XMatch !(GXAnnot l) ![GAltMatch l] !(GExp l)

Match expression with default. Similar to a case expression, except that if an alternative fails then we try the next one instead of failing. If none of the alternatives succeeds then the overall value is the value of the default expression.

XWhere !(GXAnnot l) !(GExp l) ![GClause l]

Where expression defines a group of recursive clauses, and is desugared to a letrec.

XLamPat !(GXAnnot l) !(GPat l) !(Maybe (GType l)) !(GExp l)

Lambda abstraction which matches its argument against a single pattern.

XLamCase !(GXAnnot l) ![GAltCase l]

Lambda abstraction that matches its argument against the given alternatives.

Instances

Expand Exp Source # 

Methods

expand :: SourcePos -> Env -> Exp -> Exp Source #

HasAnonBind l => MapBoundX GExp l Source # 

Methods

mapBoundAtDepthX :: l -> (Int -> GXBoundVar l -> GXBoundVar l) -> Int -> GExp l -> GExp l Source #

Defix GExp l Source # 

Methods

defix :: FixTable l -> GExp l -> Either (Error l) (GExp l) Source #

ShowLanguage l => Show (GExp l) Source # 

Methods

showsPrec :: Int -> GExp l -> ShowS #

show :: GExp l -> String #

showList :: [GExp l] -> ShowS #

data GLets l Source #

Possibly recursive bindings. Whether these are taken as recursive depends on whether they appear in an XLet or XLetrec group.

Constructors

LLet !(GXBindVarMT l) !(GExp l)

Non-recursive expression binding.

LRec ![(GXBindVarMT l, GExp l)]

Recursive binding of lambda abstractions.

LPrivate ![GXBindVar l] !(Maybe (GType l)) ![(GXBindVar l, GType l)]

Bind a local region variable, and witnesses to its properties.

LGroup ![GClause l]

A possibly recursive group of binding clauses.

Multiple clauses in the group may be part of the same function.

Instances

Defix GLets l Source # 

Methods

defix :: FixTable l -> GLets l -> Either (Error l) (GLets l) Source #

ShowLanguage l => Show (GLets l) Source # 

Methods

showsPrec :: Int -> GLets l -> ShowS #

show :: GLets l -> String #

showList :: [GLets l] -> ShowS #

data GPat l Source #

Patterns.

Constructors

PDefault

The default pattern always succeeds.

PAt !(GXBindVar l) !(GPat l)

Give a name to the value matched by a pattern.

PVar !(GXBindVar l)

The variable pattern always succeeds and binds the value to the new variable.

PData !(DaCon (GXBoundCon l) (GType l)) ![GPat l]

Match a data constructor and bind its arguments.

Instances

ShowLanguage l => Show (GPat l) Source # 

Methods

showsPrec :: Int -> GPat l -> ShowS #

show :: GPat l -> String #

showList :: [GPat l] -> ShowS #

data GClause l Source #

Binding clause

Constructors

SSig !(GXAnnot l) !(GXBindVar l) !(GType l)

A separate type signature.

SLet !(GXAnnot l) !(GXBindVarMT l) ![GParam l] ![GGuardedExp l]

A function binding using pattern matching and guards.

data GParam l Source #

Parameter for a binding.

Constructors

MType !(GXBindVar l) (Maybe (GType l))

Type parameter with optional kind.

MWitness !(GXBindVar l) (Maybe (GType l))

Witness parameter with optional type.

MValue !(GPat l) (Maybe (GType l))

Value paatter with optional type.

Instances

ShowLanguage l => Show (GParam l) Source # 

Methods

showsPrec :: Int -> GParam l -> ShowS #

show :: GParam l -> String #

showList :: [GParam l] -> ShowS #

data GGuard l Source #

Expression guards.

Constructors

GPat !(GPat l) !(GExp l) 
GPred !(GExp l) 
GDefault 

Instances

data GGuardedExp l Source #

An expression with some guards.

Constructors

GGuard !(GGuard l) !(GGuardedExp l) 
GExp !(GExp l) 

data GAltMatch l Source #

Match alternative. This is like a case alternative except that the match expression does not give us a head pattern.

Constructors

AAltMatch !(GGuardedExp l) 

data GAltCase l Source #

Case alternative. If the pattern matches then bind the variables then enter the guarded expression.

Constructors

AAltCase !(GPat l) ![GGuardedExp l] 

data GCast l Source #

Type casts.

Constructors

CastWeakenEffect !(GType l)

Weaken the effect of an expression. The given effect is added to the effect of the body.

CastPurify !(GWitness l)

Purify the effect (action) of an expression.

CastBox

Box a computation, capturing its effects in the S computation type.

CastRun

Run a computation, releasing its effects into the environment.

Instances

HasAnonBind l => MapBoundX GCast l Source # 

Methods

mapBoundAtDepthX :: l -> (Int -> GXBoundVar l -> GXBoundVar l) -> Int -> GCast l -> GCast l Source #

ShowLanguage l => Show (GCast l) Source # 

Methods

showsPrec :: Int -> GCast l -> ShowS #

show :: GCast l -> String #

showList :: [GCast l] -> ShowS #

data GWitness l Source #

Witnesses.

Constructors

WAnnot !(GXAnnot l) !(GWitness l)

Witness annotation

WVar !(GXBoundVar l)

Witness variable.

WCon !(GWiCon l)

Witness constructor.

WApp !(GWitness l) !(GWitness l)

Witness application.

WType !(GType l)

Type can appear as an argument of a witness application.

Instances

data GWiCon l Source #

Witness constructors.

Constructors

WiConBound !(GXBoundVar l) !(GType l)

Witness constructors defined in the environment. In the interpreter we use this to hold runtime capabilities. The attached type must be closed.

Instances

ShowLanguage l => Show (GWiCon l) Source # 

Methods

showsPrec :: Int -> GWiCon l -> ShowS #

show :: GWiCon l -> String #

showList :: [GWiCon l] -> ShowS #

data DaCon n t :: * -> * -> * #

Data constructors.

Constructors

DaConUnit

Baked in unit data constructor.

DaConPrim

Primitive data constructor used for literals and baked-in constructors.

The type of the constructor needs to be attached to handle the case where there are too many constructors in the data type to list, like for Int literals. In this case we determine what data type it belongs to from the attached type of the data constructor.

Fields

DaConBound

Data constructor that has a data type declaration.

Fields

Instances

(Eq n, Eq t) => Eq (DaCon n t) 

Methods

(==) :: DaCon n t -> DaCon n t -> Bool #

(/=) :: DaCon n t -> DaCon n t -> Bool #

(Show n, Show t) => Show (DaCon n t) 

Methods

showsPrec :: Int -> DaCon n t -> ShowS #

show :: DaCon n t -> String #

showList :: [DaCon n t] -> ShowS #

(NFData n, NFData t) => NFData (DaCon n t) 

Methods

rnf :: DaCon n t -> () #

Dictionaries