stgi-1.0.1: Educational implementation of the STG (Spineless Tagless G-machine)

Safe HaskellNone
LanguageHaskell2010

Stg.Language

Contents

Description

The STG language syntax tree, modeled after the description in the 1992 paper (link).

A Program is typically created using functionality provided by the Stg.Parser module, as opposed to manually combining the data types given in this module.

For plenty of comparisons of STG language source and generated parse trees, have a look at the Stg.Parser.QuasiQuoter module.

Synopsis

Documentation

newtype Program Source

An STG program consists of bindings.

Constructors

Program Binds 

newtype Binds Source

Bindings are collections of lambda forms, indexed over variables.

They exist at the top level, or as part of a let(rec) binding.

Constructors

Binds (Map Var LambdaForm) 

Instances

Eq Binds Source 
Ord Binds Source 
Show Binds Source 
Generic Binds Source 
Pretty Binds Source 
Monoid Binds Source

Right-biased union of binds. This makes it easier to overwrite modify definitions from other programs. For example, if you have one program that has a certain definition of map, you can write

program' = program <> [stg| map = ... |]

to make it use your own version.

NFData Binds Source 
Lift Binds Source 
type Rep Binds Source 

data LambdaForm Source

A lambda form unifies free and bound variables associated with a function body. The lambda body must not be of primitive type, as this would imply the value is both boxed and unboxed.

>>> [stg| \(x) y z -> expr x z |]
LambdaForm [Var "x"] NoUpdate [Var "y",Var "z"] (AppF (Var "expr") [AtomVar (Var "x"),AtomVar (Var "z")])

Constructors

LambdaForm ![Var] !UpdateFlag ![Var] !Expr 

prettyLambda Source

Arguments

:: ([Var] -> Doc)

Free variable list printer

-> LambdaForm 
-> Doc 

Prettyprint a LambdaForm, given prettyprinters for the free variable list.

Introduced so Closure can hijack it to display the free value list differently.

data UpdateFlag Source

The update flag distinguishes updateable from non-updateable lambda forms.

The former will be overwritten in-place when it is evaluated, allowing the calculation of a thunk to be shared among multiple uses of the same value.

Constructors

Update 
NoUpdate 

data Expr Source

An expression in the STG language.

Constructors

Let !Rec !Binds !Expr

Let expression let(rec) ... in ...

Case !Expr !Alts

Case expression case ... of ... x -> y

AppF !Var ![Atom]

Function application f x y z

AppC !Constr ![Atom]

Saturated constructor application Just a

AppP !PrimOp !Atom !Atom

Primitive function application + 2#

Lit !Literal

Literal expression 1#

data Alts Source

List of possible alternatives in a Case expression.

The list of alts has to be homogeneous. This is not ensured by the type system, and should be handled by the parser instead.

data NonDefaultAlts Source

The part of a Case alternative that's not the default.

Constructors

NoNonDefaultAlts

Used in 'case' statements that consist only of a default alternative. These can be useful to force or unpack values.

AlgebraicAlts !(NonEmpty AlgebraicAlt)

Algebraic alternative, like Cons x xs.

PrimitiveAlts !(NonEmpty PrimitiveAlt)

Primitive alternative, like 1#.

newtype Literal Source

Literals are the basis of primitive operations.

Constructors

Literal Integer 

data Atom Source

Smallest unit of data. Atoms unify variables and literals, and are what functions take as arguments.

Constructors

AtomVar !Var 
AtomLit !Literal 

class Pretty a where

The member prettyList is only used to define the instance Pretty a => Pretty [a]. In normal circumstances only the pretty function is used.

Minimal complete definition

pretty

Methods

pretty :: a -> Doc

prettyList :: [a] -> Doc

Meta information

classify :: LambdaForm -> LambdaType Source

Classify the type of a lambda form based on its shape.

data LambdaType Source

Possible classification of lambda forms.

Constructors

LambdaCon

Data constructor (AppC as body)

LambdaFun

Function (lambda with non-empty argument list)

LambdaThunk

Thunk (everything else)