ddc-core-salt-0.3.1.1: Disciplined Disciple Compiler C code generator.

Safe HaskellNone

DDC.Core.Salt

Contents

Description

Disciple Core Salt.

This is what happens to C when you leave it out in the sun for too long.

Salt is a fragment of System-F2 that contains just those features that can be easily mapped onto C or LLVM code. It has functions, case expressions and primops, but no partial application, data types, or nested functions. All operations on algebraic data need to have been expanded to primitive store operations.

Salt exposes raw store and control primops, so its possible for functions written directly in Salt to corrupt the heap (if they are wrong).

Synopsis

Language profile

profile :: Profile NameSource

Language profile for Disciple Core Salt.

Conversion

seaOfSaltModuleSource

Arguments

:: Show a 
=> Bool

Whether to include top-level include macros.

-> Platform

Target platform specification

-> Module a Name

Module to convert.

-> Either (Error a) Doc 

Convert a Disciple Core Salt module to C-source text.

data Error a Source

Things that can go wrong when converting Disciple Core Salt to to C source text.

Constructors

ErrorUndefined

Variable is not in scope.

Fields

errorVar :: Bound Name
 
ErrorBindNone

Binder has BNone form, binds no variable.

ErrorNoTopLevelLetrec

Modules must contain a top-level letrec.

Fields

errorModule :: Module a Name
 
ErrorTypeInvalid

A local variable has an invalid type.

Fields

errorType :: Type Name
 
ErrorFunctionInvalid

An invalid function definition.

Fields

errorExp :: Exp a Name
 
ErrorParameterInvalid

An invalid function parameter.

Fields

errorBind :: Bind Name
 
ErrorBodyInvalid

An invalid function body.

Fields

errorExp :: Exp a Name
 
ErrorBodyMustPassControl

A function body that does not explicitly pass control.

Fields

errorExp :: Exp a Name
 
ErrorStmtInvalid

An invalid statement.

Fields

errorExp :: Exp a Name
 
ErrorAltInvalid

An invalid alternative.

Fields

errorAlt :: Alt a Name
 
ErrorRValueInvalid

An invalid RValue.

Fields

errorExp :: Exp a Name
 
ErrorArgInvalid

An invalid function argument.

Fields

errorExp :: Exp a Name
 
ErrorPrimCallInvalid

An invalid primitive call

Fields

errorPrimOp :: PrimOp
 
errorArgs :: [Exp a Name]
 

Instances

Show a => Show (Error a) 
(Show a, Pretty a) => Pretty (Error a) 

Names

data Name Source

Names of things used in Disciple Core Salt.

Constructors

NameVar String

A type or value variable.

NameCon String

Constructor names.

NameObjTyCon

The abstract heap object type constructor.

NamePrimTyCon PrimTyCon

A primitive type constructor.

NamePrimOp PrimOp

A primitive operator.

NameLitVoid

The void literal.

NameLitBool Bool

A boolean literal.

NameLitNat Integer

A natural number literal.

NameLitInt Integer

An integer number literal.

NameLitTag Integer

A constructor tag literal.

NameLitWord Integer Int

A WordN# literal, of the given width.

data PrimTyCon Source

Primitive type constructors.

Constructors

PrimTyConVoid

Void# the Void type has no values.

PrimTyConBool

Bool# unboxed booleans.

PrimTyConNat

Nat# natural numbers. Big enough to count every addressable byte in the store.

PrimTyConInt

Int# signed integers.

PrimTyConWord Int

WordN# machine words of the given width.

PrimTyConFloat Int

FloatN# floating point numbers of the given width.

PrimTyConTag

Tag# data constructor tags.

PrimTyConAddr

Addr# raw machine addresses. Unlike pointers below, a raw Addr# need not to refer to memory owned by the current process.

PrimTyConPtr

Ptr# should point to a well-formed object owned by the current process.

PrimTyConString

String# of UTF8 characters.

These are primitive until we can define our own unboxed types.

data PrimOp Source

Primitive operators implemented directly by the machine or runtime system.

Constructors

PrimArith PrimArith

Arithmetic, logic, comparison and bit-wise operators.

PrimCast PrimCast

Casting between numeric types.

PrimStore PrimStore

Raw store access.

PrimCall PrimCall

Special function calling conventions.

PrimControl PrimControl

Non-functional control flow.

data PrimCast Source

Primitive cast between two types.

The exact set of available casts is determined by the target platform. For example, you can only promote a Nat# to a Word32# on a 32-bit system. On a 64-bit system the Nat# type is 64-bits wide, so casting it to a Word32# would be a truncation.

Constructors

PrimCastPromote

Promote a value to one of similar or larger width, without loss of precision.

PrimCastTruncate

Truncate a value to a new width, possibly losing precision.

primCastPromoteIsValidSource

Arguments

:: Platform

Target platform.

-> PrimTyCon

Source type.

-> PrimTyCon

Destination type.

-> Bool 

Check for a valid promotion primop.

primCastTruncateIsValidSource

Arguments

:: Platform

Target platform.

-> PrimTyCon

Source type.

-> PrimTyCon

Destination type.

-> Bool 

Check for valid truncation primop.

data PrimCall Source

Primitive ways of invoking a function, where control flow returns back to the caller.

Constructors

PrimCallTail Int

Tailcall a function

data PrimControl Source

Primitive non-returning control flow.

Constructors

PrimControlFail

Ungraceful failure -- just abort the program. This is called on internal errors in the runtime system. There is no further debugging info provided, so you'll need to look at the stack trace to debug it.

PrimControlReturn

Return from the enclosing function with the given value.

data PrimStore Source

Raw access to the store.

Constructors

PrimStoreSize

Number of bytes needed to store a value of a primitive type.

PrimStoreSize2

Log2 of number of bytes need to store a value of a primitive type.

PrimStoreCreate

Create a heap of the given size. This must be called before alloc# below, and has global side effect. Calling it twice in the same program is undefined.

PrimStoreCheck

Check whether there are at least this many bytes still available on the heap.

PrimStoreRecover

Force a garbage collection to recover at least this many bytes.

PrimStoreAlloc

Allocate some space on the heap. There must be enough space available, else undefined.

PrimStoreRead

Read a value from the store at the given address and offset.

PrimStoreWrite

Write a value to the store at the given address and offset.

PrimStorePlusAddr

Add an offset in bytes to an address.

PrimStoreMinusAddr

Subtract an offset in bytes from an address.

PrimStorePeek

Read a value from a pointer plus the given offset.

PrimStorePoke

Write a value to a pointer plus the given offset.

PrimStorePlusPtr

Add an offset in bytes to a pointer.

PrimStoreMinusPtr

Subtract an offset in bytes from a pointer.

PrimStoreMakePtr

Convert an raw address to a pointer.

PrimStoreTakePtr

Convert a pointer to a raw address.

PrimStoreCastPtr

Cast between pointer types.

data PrimArith Source

Primitive arithmetic, logic, and comparison opretors. We expect the backend/machine to be able to implement these directly.

For the Shift Right operator, the type that it is used at determines whether it is an arithmetic (with sign-extension) or logical (no sign-extension) shift.

Constructors

PrimArithNeg

Negation

PrimArithAdd

Addition

PrimArithSub

Subtraction

PrimArithMul

Multiplication

PrimArithDiv

Division

PrimArithRem

Remainder

PrimArithEq

Equality

PrimArithNeq

Negated Equality

PrimArithGt

Greater Than

PrimArithGe

Greater Than or Equal

PrimArithLt

Less Than

PrimArithLe

Less Than or Equal

PrimArithAnd

Boolean And

PrimArithOr

Boolean Or

PrimArithShl

Shift Left

PrimArithShr

Shift Right

PrimArithBAnd

Bit-wise And

PrimArithBOr

Bit-wise Or

PrimArithBXOr

Bit-wise eXclusive Or

Name parsing

readName :: String -> Maybe NameSource

Read the name of a variable, constructor or literal.

Program lexing

lexModuleStringSource

Arguments

:: String

Source file name.

-> Int

Starting line number.

-> String

String to parse.

-> [Token (Tok Name)] 

Lex a string to tokens, using primitive names.

lexExpStringSource

Arguments

:: String

Source file name.

-> Int

Starting line number.

-> String

String to parse.

-> [Token (Tok Name)] 

Lex a string to tokens, using primitive names.