Language.Copilot.Core
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
,
to add it to Streamable
, foldStreamableMaps
, and optionnaly
to add an ext[Type], a [type] and a var[Type]
functions in Language.hs to make it easier to use.
mapStreamableMaps
- type Var = String
- type Name = String
- type Period = Int
- type Phase = Int
- type Port = Int
- data Spec a where
- PVar :: Streamable a => Type -> Var -> Phase -> Spec a
- Var :: Streamable a => Var -> Spec a
- Const :: Streamable a => a -> 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
- type Streams = Writer (StreamableMaps Spec) ()
- type Stream a = Streamable a => (Var, Spec a)
- type Sends = StreamableMaps Send
- data Send a = Sendable a => Send (Var, Phase, Port)
- type DistributedStreams = (Streams, Sends)
- class (Expr a, Assign a, Show a) => Streamable a where
- getSubMap :: StreamableMaps b -> Map Var (b a)
- updateSubMap :: (Map Var (b a) -> Map Var (b a)) -> StreamableMaps b -> StreamableMaps b
- unit :: a
- atomConstructor :: Var -> a -> Atom (V a)
- externalAtomConstructor :: Var -> V a
- typeId :: a -> String
- typeIdPrec :: a -> String
- atomType :: a -> Type
- showAsC :: a -> String
- makeTrigger :: Maybe [(Var, String)] -> StreamableMaps Spec -> ProphArrs -> TmpSamples -> Indexes -> Var -> Spec a -> Atom () -> Atom ()
- class Streamable a => Sendable a where
- data StreamableMaps a = SM {}
- emptySM :: StreamableMaps a
- isEmptySM :: StreamableMaps a -> Bool
- getMaybeElem :: Streamable a => Var -> StreamableMaps b -> Maybe (b a)
- getElem :: Streamable a => Var -> StreamableMaps b -> b a
- streamToUnitValue :: Streamable a => Var -> Spec a -> Atom (V a)
- foldStreamableMaps :: forall b c. (forall a. Streamable a => Var -> c a -> b -> b) -> StreamableMaps c -> b -> b
- foldSendableMaps :: forall b c. (forall a. Sendable a => Var -> c a -> b -> b) -> StreamableMaps c -> b -> b
- mapStreamableMaps :: forall s s'. (forall a. Streamable a => Var -> s a -> s' a) -> StreamableMaps s -> StreamableMaps s'
- mapStreamableMapsM :: forall s s' m. Monad m => (forall a. Streamable a => Var -> s a -> m (s' a)) -> StreamableMaps s -> m (StreamableMaps s')
- filterStreamableMaps :: forall c. StreamableMaps c -> [(Type, Var, Phase)] -> (StreamableMaps c, Bool)
- normalizeVar :: Var -> Var
- getVars :: StreamableMaps Spec -> [Var]
- type Vars = StreamableMaps []
- nextSt :: Streamable a => StreamableMaps Spec -> ProphArrs -> TmpSamples -> Indexes -> Spec a -> ArrIndex -> E a
- data BoundedArray a = B ArrIndex (Maybe (A a))
- type Outputs = StreamableMaps V
- type TmpSamples = StreamableMaps PhasedValue
- data PhasedValue a = Ph Phase (V a)
- type ProphArrs = StreamableMaps BoundedArray
- type Indexes = Map Var (V ArrIndex)
Type hierarchy for the copilot language
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
PVar :: Streamable a => Type -> Var -> Phase -> Spec a | |
Var :: Streamable a => Var -> Spec a | |
Const :: Streamable a => a -> 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 Streams = StreamableMaps Spec
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
An instruction to send data on a port at a given phase
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
and Streamable
:
the types aggregated in StreamableMaps
are exactly the StreamableMaps
types
and that invariant should be kept (see methods)
Streamable
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
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
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.
The argument only coerces the type, it is discarded. Returns the corresponding Atom type.
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 :: Maybe [(Var, String)] -> StreamableMaps Spec -> ProphArrs -> TmpSamples -> Indexes -> Var -> Spec a -> Atom () -> Atom ()Source
To make customer C triggers. Only for Spec Bool (others through an error).
class Streamable a => Sendable a whereSource
data StreamableMaps a Source
This is a generalization of
which is used for storing Maps over values parameterized by different types.
Streams
It is extensively used in the internals of Copilot, in conjunction with
and foldStreamableMaps
mapStreamableMaps
Constructors
SM | |
Fields
|
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
Launch an exception if the index is not in it
StreamableMaps
streamToUnitValue :: Streamable a => Var -> Spec a -> Atom (V a)Source
Just produce an Atom
value named after its first argument,
with an unspecified value. The second argument only coerces the type, it is discarded
foldStreamableMaps :: forall b c. (forall a. 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
, accumulating a value over time
StreamableMaps
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
, accumulating a value over time
StreamableMaps
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 => (forall a. Streamable a => Var -> s a -> m (s' a)) -> StreamableMaps s -> m (StreamableMaps s')Source
filterStreamableMaps :: forall c. StreamableMaps c -> [(Type, Var, Phase)] -> (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.
nextSt :: Streamable a => StreamableMaps Spec -> ProphArrs -> TmpSamples -> Indexes -> Spec a -> ArrIndex -> E aSource
data BoundedArray a Source
type Outputs = StreamableMaps VSource
data PhasedValue a Source