copilot-0.26: A stream DSL for writing embedded C monitors.

Language.Copilot.Core

Contents

Description

Provides basic types and functions for other parts of Copilot.

If you wish to add a new type, you need to make it an instance of Streamable, to add it to foldStreamableMaps, mapStreamableMaps, and optionnaly to add an ext[Type], a [type] and a var[Type] functions in Language.hs to make it easier to use.

Synopsis

Type hierarchy for the copilot language

type Var = StringSource

Names of the streams or external variables

type Name = StringSource

C file name

type Period = IntSource

Atom period

type Phase = IntSource

Phase of an Atom phase

type Port = IntSource

Port over which to broadcast information

data Spec a whereSource

Specification of a stream, parameterized by the type of the values of the stream. The only requirement on a is that it should be Streamable.

Constructors

Var :: Streamable a => Var -> Spec a 
Const :: Streamable a => a -> Spec a 
PVar :: Streamable a => Type -> Var -> Phase -> Spec a 
PArr :: (Streamable a, Streamable b, IntegralE b) => Type -> (Var, Spec b) -> Phase -> Spec a 
F :: (Streamable a, Streamable b) => (b -> a) -> (E b -> E a) -> Spec b -> Spec a 
F2 :: (Streamable a, Streamable b, Streamable c) => (b -> c -> a) -> (E b -> E c -> E a) -> Spec b -> Spec c -> Spec a 
F3 :: (Streamable a, Streamable b, Streamable c, Streamable d) => (b -> c -> d -> a) -> (E b -> E c -> E d -> E a) -> Spec b -> Spec c -> Spec d -> Spec a 
Append :: Streamable a => [a] -> Spec a -> Spec a 
Drop :: Streamable a => Int -> Spec a -> Spec a 

Instances

Eq a => Eq (Spec a) 
(Streamable a, NumE a, Fractional a) => Fractional (Spec a) 
(Streamable a, NumE a) => Num (Spec a) 
Show a => Show (Spec a) 
Monoid (StreamableMaps Spec) 

type Streams = Writer (StreamableMaps Spec) ()Source

Container for mutually recursive streams, whose specifications may be parameterized by different types

type Stream a = Streamable a => (Var, Spec a)Source

A named stream

type Sends = StreamableMaps SendSource

Container for all the instructions sending data, parameterised by different types

data Send a Source

An instruction to send data on a port at a given phase

Constructors

Sendable a => Send (Var, Phase, Port) 

type DistributedStreams = (Streams, Sends)Source

Holds the complete specification of a distributed monitor

General functions on Streams and StreamableMaps

class (Expr a, Assign a, Show a) => Streamable a whereSource

A type is streamable iff a stream may emit values of that type

There are very strong links between Streamable and StreamableMaps : the types aggregated in StreamableMaps are exactly the Streamable types and that invariant should be kept (see methods)

Methods

getSubMap :: StreamableMaps b -> Map Var (b a)Source

Provides access to the Map in a StreamableMaps which store values of the good type

updateSubMap :: (Map Var (b a) -> Map Var (b a)) -> StreamableMaps b -> StreamableMaps bSource

Provides a way to modify (mostly used for insertions) the Map in a StreamableMaps which store values of the good type

unit :: aSource

A default value for the type a. Its value is not important.

atomConstructor :: Var -> a -> Atom (V a)Source

A constructor to produce an Atom value

externalAtomConstructor :: Var -> V aSource

A constructor to get an Atom value from an external variable

typeId :: a -> StringSource

The argument only coerces the type, it is discarded. Returns the format for outputting a value of this type with printf in C

For example %f for a float

typeIdPrec :: a -> StringSource

The same, only adds the wanted precision for floating points.

atomType :: a -> TypeSource

The argument only coerces the type, it is discarded. Returns the corresponding Atom type.

showAsC :: a -> StringSource

Like Show, except that the formatting is exactly the same as the one of C for example the booleans are first converted to 0 or 1, and floats and doubles have the good precision.

makeTrigger :: [(Var, String)] -> StreamableMaps Spec -> ProphArrs -> TmpSamples -> Indexes -> Var -> Spec a -> Atom () -> Atom ()Source

To make customer C triggers. Only for Spec Bool (others throw an error). XXX make them throw errors!

class Streamable a => Sendable a whereSource

Methods

send :: E a -> Port -> Atom ()Source

Instances

data StreamableMaps a Source

This is a generalization of Streams which is used for storing Maps over values parameterized by different types.

It is extensively used in the internals of Copilot, in conjunction with foldStreamableMaps and mapStreamableMaps

Constructors

SM 

Fields

bMap :: Map Var (a Bool)
 
i8Map :: Map Var (a Int8)
 
i16Map :: Map Var (a Int16)
 
i32Map :: Map Var (a Int32)
 
i64Map :: Map Var (a Int64)
 
w8Map :: Map Var (a Word8)
 
w16Map :: Map Var (a Word16)
 
w32Map :: Map Var (a Word32)
 
w64Map :: Map Var (a Word64)
 
fMap :: Map Var (a Float)
 
dMap :: Map Var (a Double)
 

Instances

emptySM :: StreamableMaps aSource

An empty streamableMaps.

isEmptySM :: StreamableMaps a -> BoolSource

Verifies if its argument is equal to emptySM

getMaybeElem :: Streamable a => Var -> StreamableMaps b -> Maybe (b a)Source

Lookup into the map of the right type in StreamableMaps

getElem :: Streamable a => Var -> StreamableMaps b -> b aSource

Lookup into the map of the right type in StreamableMaps Launch an exception if the index is not in it

foldStreamableMaps :: forall b c. (Streamable a => Var -> c a -> b -> b) -> StreamableMaps c -> b -> bSource

This function is used to iterate on all the values in all the maps stored by a StreamableMaps, accumulating a value over time

foldSendableMaps :: forall b c. (forall a. Sendable a => Var -> c a -> b -> b) -> StreamableMaps c -> b -> bSource

This function is used to iterate on all the values in all the maps stored by a StreamableMaps, accumulating a value over time

mapStreamableMaps :: forall s s'. (forall a. Streamable a => Var -> s a -> s' a) -> StreamableMaps s -> StreamableMaps s'Source

mapStreamableMapsM :: forall s s' m. Monad m => (Streamable a => Var -> s a -> m (s' a)) -> StreamableMaps s -> m (StreamableMaps s')Source

filterStreamableMaps :: forall c b. StreamableMaps c -> [(Type, Var, b)] -> (StreamableMaps c, Bool)Source

Only keeps in sm the values whose key+type are in l. Also returns a bool saying whether all the elements in sm were in l. Works even if some elements in l are not in sm. Not optimised at all.

normalizeVar :: Var -> VarSource

Replace all accepted special characters by sequences of underscores.

getVars :: StreamableMaps Spec -> [Var]Source

Get the Copilot variables.

type Vars = StreamableMaps []Source

For each typed variable, this type holds all its successive values in an infinite list Beware : each element of one of those lists corresponds to a full Atom period, not to a single clock tick.

data BoundedArray a Source

Constructors

B ArrIndex (Maybe (A a)) 

type Indexes = Map Var (V ArrIndex)Source

data PhasedValueVar a Source

Constructors

PhV Phase (V a) 

data PhasedValueArr a Source

Constructors

PhA Phase (V a) 

data PhasedValueIdx a Source

Constructors

PhIdx (E a)