Safe Haskell | Safe-Infered |
---|
- createComponent :: (ComponentInterface iface, Typeable (Receive iface)) => iface -> Sim ComponentId
- invoke :: (ComponentInterface iface, Typeable (Receive iface), Typeable (Send iface)) => iface -> ComponentId -> Receive iface -> Sim (Send iface)
- invokeAsync :: (ComponentInterface iface, Typeable (Receive iface), Typeable (Send iface)) => iface -> ComponentId -> Receive iface -> (Send iface -> Sim ()) -> Sim ()
- respond :: (ComponentInterface iface, Typeable (Send iface)) => iface -> ReturnAddress -> Send iface -> Sim ()
- yield :: a -> Sim a
- readMemory :: Int -> Sim Dynamic
- writeMemory :: Typeable a => Int -> a -> Sim ()
- componentLookup :: ComponentInterface iface => iface -> Sim (Maybe ComponentId)
- traceMsg :: String -> Sim ()
- createNode :: Sim NodeId
- runSTM :: STM a -> Sim a
- getComponentId :: Sim ComponentId
- getNodeId :: Sim NodeId
- componentCreator :: Sim ComponentId
- createComponentN :: (ComponentInterface iface, Typeable (Receive iface)) => iface -> NodeId -> Sim ComponentId
- createComponentNP :: (ComponentInterface iface, Typeable (Receive iface)) => NodeId -> ComponentId -> iface -> Sim ComponentId
- invokeS :: forall iface. (ComponentInterface iface, Typeable (Receive iface), Typeable (Send iface)) => iface -> Maybe ComponentId -> ComponentId -> Receive iface -> Sim (Send iface)
- invokeAsyncS :: forall iface. (ComponentInterface iface, Typeable (Receive iface), Typeable (Send iface)) => iface -> Maybe ComponentId -> ComponentId -> Receive iface -> (Send iface -> Sim ()) -> Sim ()
- respondS :: forall iface. (ComponentInterface iface, Typeable (Send iface)) => iface -> Maybe ComponentId -> ReturnAddress -> Send iface -> Sim ()
- readMemoryN :: Maybe NodeId -> Int -> Sim Dynamic
- writeMemoryN :: Typeable a => Maybe NodeId -> Int -> a -> Sim ()
- class ComponentInterface s where
- type Send s
- type Receive s
- type State s
- initState :: s -> State s
- componentName :: s -> ComponentName
- componentBehaviour :: s -> State s -> Input (Receive s) -> Sim (State s)
- data Input a
- = Message a ReturnAddress
- | Tick
- data Sim a
- type ComponentId = Unique
- type ComponentName = String
- type NodeId = Unique
- class Typeable a
- data Dynamic
- tick :: SimState -> IO SimState
- ignore :: a -> Sim ()
- unmarshall :: forall a. Typeable a => String -> Dynamic -> a
- returnAddress :: ReturnAddress -> ComponentId
Basic API
:: (ComponentInterface iface, Typeable (Receive iface)) | |
=> iface | Component Interface |
-> Sim ComponentId |
|
Create a new component
:: (ComponentInterface iface, Typeable (Receive iface), Typeable (Send iface)) | |
=> iface | Interface type |
-> ComponentId | ComponentId of callee |
-> Receive iface | Argument |
-> Sim (Send iface) | Response from callee |
Synchronously invoke another component
:: (ComponentInterface iface, Typeable (Receive iface), Typeable (Send iface)) | |
=> iface | Interface type |
-> ComponentId | ComponentId of callee |
-> Receive iface | Argument |
-> (Send iface -> Sim ()) | Response Handler |
-> Sim () | Call returns immediately |
Invoke another component, handle response asynchronously
:: (ComponentInterface iface, Typeable (Send iface)) | |
=> iface | Interface type |
-> ReturnAddress | Return address to send response to |
-> Send iface | Value to send as response |
-> Sim () | Call returns immediately |
Respond to an invocation
Write memory of local node
:: ComponentInterface iface | |
=> iface | Interface type of the component you are looking for |
-> Sim (Maybe ComponentId) |
Get the unique ComponentId
of a component implementing an interface
Advanced API
getComponentId :: Sim ComponentIdSource
Get the component id of your component
componentCreator :: Sim ComponentIdSource
Return the ComponentId
of the component that created the current
component
Specialized API
:: (ComponentInterface iface, Typeable (Receive iface)) | |
=> iface | Component Interface |
-> NodeId | |
-> Sim ComponentId |
Create a new component
:: (ComponentInterface iface, Typeable (Receive iface)) | |
=> NodeId | Node to create component on, leave to |
-> ComponentId | ComponentId to set as parent, set to |
-> iface | Component Interface |
-> Sim ComponentId |
|
Create a new component
:: forall iface . (ComponentInterface iface, Typeable (Receive iface), Typeable (Send iface)) | |
=> iface | Interface type |
-> Maybe ComponentId | Caller, leave |
-> ComponentId | Callee |
-> Receive iface | Argument |
-> Sim (Send iface) | Response from recipient |
Synchronously invoke another component
:: forall iface . (ComponentInterface iface, Typeable (Receive iface), Typeable (Send iface)) | |
=> iface | Interface type |
-> Maybe ComponentId | Parent of handler, leave |
-> ComponentId | Callee |
-> Receive iface | Argument |
-> (Send iface -> Sim ()) | Handler |
-> Sim () | Call returns immediately |
Invoke another component, handle response asynchronously
:: forall iface . (ComponentInterface iface, Typeable (Send iface)) | |
=> iface | Interface type |
-> Maybe ComponentId | Callee Id, leave |
-> ReturnAddress | Return address |
-> Send iface | Value to send as response |
-> Sim () | Call returns immediately |
Respond to an invocation
:: Maybe NodeId | Node you want to look on, leave |
-> Int | Address to read |
-> Sim Dynamic |
Read memory of local node
:: Typeable a | |
=> Maybe NodeId | Node you want to write on, leave |
-> Int | Address to write |
-> a | Value to write |
-> Sim () |
Write memory of local node
SoOSiM API Types
class ComponentInterface s whereSource
Type class that defines an OS component
Type of messages send by the component
Type of messages received by the component
Type of internal state of the component
initState :: s -> State sSource
The minimal internal state of your component
componentName :: s -> ComponentNameSource
A function returning the unique global name of your component
componentBehaviour :: s -> State s -> Input (Receive s) -> Sim (State s)Source
The function defining the behaviour of your component
ComponentInterface HandlerStub |
Events send to components by the simulator
Message a ReturnAddress | A message send another component: the field argument is the
|
Tick | Event send every simulation round |
The simulator monad used by the OS components offers resumable
computations in the form of coroutines. These resumable computations
expect a value of type Dynamic
, and return a value of type a
.
We need resumable computations to simulate synchronous messaging between
two components. When a component synchronously sends a message to another
component, we store the rest of the computation as part of the execution
context in the simulator state. When a message is send back, the stored
computation will continue with the message content (of type Dynamic
).
To suspend a computation you simply do: 'request componentId'
Where the componentId is the ID of the OS component you are expecting a message from. The execute a resumeable computation you simply do: 'resume comp'
type ComponentId = UniqueSource
type ComponentName = StringSource
Imported Types
class Typeable a
The class Typeable
allows a concrete representation of a type to
be calculated.
Typeable Bool | |
Typeable Char | |
Typeable Double | |
Typeable Float | |
Typeable Int | |
Typeable Int8 | |
Typeable Int16 | |
Typeable Int32 | |
Typeable Int64 | |
Typeable Integer | |
Typeable Ordering | |
Typeable RealWorld | |
Typeable Word | |
Typeable Word8 | |
Typeable Word16 | |
Typeable Word32 | |
Typeable Word64 | |
Typeable () | |
Typeable ThreadId | |
Typeable Dynamic | |
Typeable TypeRep | |
Typeable TyCon | |
(Typeable1 s, Typeable a) => Typeable (s a) | One Typeable instance for all Typeable1 instances |
data Dynamic
A value of type Dynamic
is an object encapsulated together with its type.
A Dynamic
may only represent a monomorphic value; an attempt to
create a value of type Dynamic
from a polymorphically-typed
expression will result in an ambiguity error (see toDyn
).
Show
ing a value of type Dynamic
returns a pretty-printed representation
of the object's type; useful for debugging.
Progress The Simulator
Utility Functions
unmarshall :: forall a. Typeable a => String -> Dynamic -> aSource