Safe Haskell | Safe-Infered |
---|
SoOSiM
Contents
- 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
Arguments
:: (ComponentInterface iface, Typeable (Receive iface)) | |
=> iface | Component Interface |
-> Sim ComponentId |
|
Create a new component
Arguments
:: (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
Arguments
:: (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
Arguments
:: (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
Arguments
:: 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
Arguments
:: (ComponentInterface iface, Typeable (Receive iface)) | |
=> iface | Component Interface |
-> NodeId | |
-> Sim ComponentId |
Create a new component
Arguments
:: (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
Arguments
:: 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
Arguments
:: 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
Arguments
:: 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
Arguments
:: Maybe NodeId | Node you want to look on, leave |
-> Int | Address to read |
-> Sim Dynamic |
Read memory of local node
Arguments
:: 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
Associated Types
Type of messages send by the component
Type of messages received by the component
Type of internal state of the component
Methods
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
Instances
ComponentInterface HandlerStub |
Events send to components by the simulator
Constructors
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.
Instances
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