feldspar-compiler-0.7: Compiler for the Feldspar language

Safe HaskellNone
LanguageHaskell2010

Feldspar.Compiler.Imperative.FromCore.Interpretation

Contents

Synopsis

Documentation

type CodeWriter = RWS Readers Writers States Source

Code generation monad

data Readers Source

Constructors

Readers 

Fields

alias :: [(VarId, Expression ())]

variable aliasing

sourceInfo :: SourceInfo

Surrounding source info

backendOpts :: Options

Options for the backend.

data Writers Source

Constructors

Writers 

Fields

block :: Block ()

collects code within one block

def :: [Entity ()]

collects top level definitions

decl :: [Declaration ()]

collects top level variable declarations

params :: [Variable ()]

collects top level parameters

epilogue :: [Program ()]

collects postlude code (freeing memory, etc)

Instances

data States Source

Constructors

States 

Fields

fresh :: VarId

The first fresh variable id

type Location = Maybe (Expression ()) Source

Where to place the program result

class Compile sub dom where Source

A minimal complete instance has to define either compileProgSym or compileExprSym.

Minimal complete definition

Nothing

Methods

compileProgSym :: sub a -> Info (DenResult a) -> Location -> Args (AST (Decor Info dom)) a -> CodeWriter () Source

compileExprSym :: sub a -> Info (DenResult a) -> Args (AST (Decor Info dom)) a -> CodeWriter (Expression ()) Source

Instances

(Compile dom dom, Project (CLambda Type) dom) => Compile Let dom 
Compile FeldDom FeldDom 
(Compile dom dom, Project ((:||) Variable Type) dom) => Compile ParFeature dom 
(Compile dom dom, Project (CLambda Type) dom, Project ((:||) Variable Type) dom, Project (MONAD Mut) dom, Project MutableArray dom) => Compile MutableToPure dom 
(Compile dom dom, Project (CLambda Type) dom) => Compile MutableArray dom 
(Compile dom dom, Project (CLambda Type) dom) => Compile MutableReference dom 
(Compile dom dom, Project (CLambda Type) dom) => Compile Mutable dom 
Compile Empty dom 
Compile dom dom => Compile Semantics dom

Converts symbols to primitive function calls

(Compile dom dom, Project (CLambda Type) dom) => Compile (MONAD Mut) dom 
(Compile dom dom, Project (CLambda Type) dom, Project ParFeature dom) => Compile (MONAD Par) dom 
(Compile dom dom, Project (CLambda Type) dom, Project ((:||) Literal Type) dom, Project ((:||) Variable Type) dom) => Compile (LoopM Mut) dom 
Compile dom dom => Compile (ConditionM m) dom 
Compile (CLambda Type) dom 
Compile dom dom => Compile ((:||) Condition Type) dom 
Compile dom dom => Compile ((:||) Tuple Type) dom 
Compile dom dom => Compile ((:||) Select Type) dom 
Compile ((:||) Variable Type) dom 
Compile dom dom => Compile ((:||) (Decor SourceInfo1 Identity) Type) dom 
Compile ((:||) Literal Type) dom 
Compile dom dom => Compile ((:||) PropSize Type) dom 
(Compile dom dom, Project (CLambda Type) dom, Project ((:||) Literal Type) dom, Project ((:||) Variable Type) dom, Project Let dom, ConstrainedBy dom (Typeable *)) => Compile ((:||) Loop Type) dom 
Compile dom dom => Compile ((:||) Conversion Type) dom 
(Compile dom dom, Project ((:||) EQ Type) dom, Project ((:||) Condition Type) dom) => Compile ((:||) Switch Type) dom 
Compile dom dom => Compile ((:||) FUTURE Type) dom 
(Compile dom dom, Project (CLambda Type) dom, Project ((:||) Literal Type) dom, Project ((:||) Variable Type) dom, Project Let dom, Project ((:||) Array Type) dom, Project ((:||) Tuple Type) dom, ConstrainedBy dom (Typeable *), AlphaEq dom dom (Decor Info dom) [(VarId, VarId)]) => Compile ((:||) Array Type) dom 
Compile dom dom => Compile ((:||) Save Type) dom 
Compile dom dom => Compile ((:||) FFI Type) dom 
Compile dom dom => Compile ((:||) Trace Type) dom 
Compile dom dom => Compile ((:||) REALFLOAT Type) dom 
Compile dom dom => Compile ((:||) NoInline Type) dom 
Compile dom dom => Compile ((:||) FRACTIONAL Type) dom 
Compile dom dom => Compile ((:||) NUM Type) dom 
Compile dom dom => Compile ((:||) FLOATING Type) dom 
Compile dom dom => Compile ((:||) Error Type) dom 
Compile dom dom => Compile ((:||) INTEGRAL Type) dom 
Compile dom dom => Compile ((:||) BITS Type) dom 
Compile dom dom => Compile ((:||) Logic Type) dom 
Compile dom dom => Compile ((:||) EQ Type) dom 
Compile dom dom => Compile ((:||) ORD Type) dom 
Compile dom dom => Compile ((:||) COMPLEX Type) dom 
(Compile sub1 dom, Compile sub2 dom) => Compile ((:+:) sub1 sub2) dom 

compileExprLoc :: Compile sub dom => sub a -> Info (DenResult a) -> Location -> Args (AST (Decor Info dom)) a -> CodeWriter () Source

Implementation of compileExprSym that assigns an expression to the given location.

compileProgFresh :: Compile sub dom => sub a -> Info (DenResult a) -> Args (AST (Decor Info dom)) a -> CodeWriter (Expression ()) Source

Implementation of compileProgSym that generates code into a fresh variable.

compileProgDecor :: Compile dom dom => Location -> Decor Info dom a -> Args (AST (Decor Info dom)) a -> CodeWriter () Source

compileExprDecor :: Compile dom dom => Decor Info dom a -> Args (AST (Decor Info dom)) a -> CodeWriter (Expression ()) Source

compileProg :: Compile dom dom => Location -> ASTF (Decor Info dom) a -> CodeWriter () Source

Utility functions

mkVar :: Type -> VarId -> Expression () Source

Construct a variable.

mkNamedVar :: String -> Type -> VarId -> Variable () Source

Construct a named variable.

mkNamedRef :: String -> Type -> VarId -> Variable () Source

Construct a named pointer.

mkRef :: Type -> VarId -> Expression () Source

Construct a pointer.

confiscateBlock :: CodeWriter a -> CodeWriter (a, Block ()) Source

Like listen, but also prevents the program from being written in the monad.

confiscateBigBlock :: CodeWriter a -> CodeWriter ((a, Writers), Block ()) Source

Like listen, but also catches writer things and prevents the program from being written in the monad.

mkLength :: (Project (Literal :|| Type) dom, Project (Variable :|| Type) dom, Compile dom dom) => ASTF (Decor Info dom) a -> TypeRep a -> Size a -> CodeWriter (Expression ()) Source

mkBranch :: Compile dom dom => Location -> ASTF (Decor Info dom) Bool -> ASTF (Decor Info dom) a -> Maybe (ASTF (Decor Info dom) a) -> CodeWriter () Source