ajhc-0.8.0.6: Haskell compiler that produce binary through C language

Safe HaskellNone

Grin.Grin

Synopsis

Documentation

data Exp Source

Constructors

Exp :>>= Lam

Sequencing - the same as >>= for monads.

BaseOp 

Fields

expBaseOp :: BaseOp
 
expArgs :: [Val]
 
App

Application of functions and builtins

Fields

expFunction :: Atom
 
expArgs :: [Val]
 
expType :: [Ty]
 
Prim

Primitive operation

Fields

expPrimitive :: Prim
 
expArgs :: [Val]
 
expType :: [Ty]
 
Case

Case statement

Fields

expValue :: Val
 
expAlts :: [Lam]
 
Return

Return a value

Fields

expValues :: [Val]

add some new variables to the GC roots for a subcomputation

Error

Abort with an error message, non recoverably.

Fields

expError :: String
 
expType :: [Ty]
 
Call

Call or jump to a callable

Fields

expValue :: Val
 
expArgs :: [Val]
 
expType :: [Ty]
 
expJump :: Bool

Jump is equivalent to a call except it deallocates the region it resides in before transfering control

expFuncProps :: FuncProps
 
expInfo :: Info
 
NewRegion

create a new region and pass it to its argument

Fields

expLam :: Lam

the computation that is passed the newly created computation

expInfo :: Info
 
Alloc

allocate space for a number of values in the given region

Fields

expValue :: Val
 
expCount :: Val
 
expRegion :: Val
 
expInfo :: Info
 
Let

A let of local functions

Fields

expDefs :: [FuncDef]
 
expBody :: Exp
 
expFuncCalls :: (Set Atom, Set Atom)

cache

expIsNormal :: Bool

cache, True = definitely normal, False = maybe normal

expNonNormal :: Set Atom

cache, a superset of functions called in non-tail call position.

expInfo :: Info
 
MkClosure

create a closure

Fields

expValue :: Val
 
expArgs :: [Val]
 
expRegion :: Val
 
expType :: [Ty]
 
expInfo :: Info
 
MkCont

Make a continuation, always allocated on region encompasing expLam

Fields

expCont :: Lam

the continuation routine

expLam :: Lam

the computation that is passed the newly created computation

expInfo :: Info
 
GcRoots 

Fields

expValues :: [Val]

add some new variables to the GC roots for a subcomputation

expBody :: Exp
 

data FuncProps Source

Constructors

FuncProps 

Fields

funcInfo :: Info
 
funcFreeVars :: Set Var
 
funcTags :: Set Tag
 
funcType :: ([Ty], [Ty])
 
funcExits :: Perhaps

function quits the program

funcCuts :: Perhaps

function cuts to a value

funcAllocs :: Perhaps

function allocates memory

funcCreates :: Perhaps

function allocates memory and stores or returns it

funcLoops :: Perhaps

function may loop

data TyThunk Source

Constructors

TyNotThunk

not the thunk

TyPApp (Maybe Ty) Atom

can be applied to (possibly) an argument, and what results

TySusp Atom

can be evaluated and calls what function

Instances

data Ty Source

Constructors

TyPtr Ty

pointer to a memory location which contains its argument

TyNode

a whole node

TyINode

a whole possibly indirect node

TyAttr Ty Ty

attach an attribute to a type

TyAnd Ty Ty

boolean conjunction of types

TyOr Ty Ty

boolean disjunction of types

TyPrim Ty

a basic type

TyUnit

type of Unit

TyCall Callable [Ty] [Ty]

something call,jump, or cut-to-able

TyRegion

a region

TyGcContext

the context for garbage collection

TyRegister Ty

a register contains a mutable value, the register itself cannot be addressed, hence they may not be returned from functions or passed as arguments.

TyComplex Ty

A complex version of a basic type

TyVector !Int Ty

A vector of a basic type

TyUnknown

an unknown possibly undefined type, All of these must be eliminated by code generation

newtype TyEnv Source

Constructors

TyEnv (GMap Atom TyTy) 

Instances

data TyTy Source

Constructors

TyTy 

Fields

tySlots :: [Ty]
 
tyReturn :: [Ty]
 
tyThunk :: TyThunk
 
tySiblings :: Maybe [Atom]
 

data Val Source

Constructors

NodeC !Tag [Val]

Complete node, of type TyNode

Const Val

constant data, only Lit, Const and NodeC may be children. of type TyINode

Lit !Number Ty

Literal

Var !Var Ty

Variable

Unit

Empty value used as placeholder

ValPrim Prim [Val] Ty

Primitive value

Index Val Val

A pointer incremented some number of values (Index v 0) == v

Item Atom Ty

Specific named thing. function, global, region, etc..

ValUnknown Ty

Unknown or unimportant value

tyINode :: TySource

lazy node sptr_t

tyDNode :: TySource

strict node wptr_t

findArgs :: Monad m => TyEnv -> Atom -> m [Ty]Source

findArgsType :: Monad m => TyEnv -> Atom -> m ([Ty], [Ty])Source