packages feed

SoOSiM (empty) → 0.1

raw patch · 8 files changed

+658/−0 lines, 8 filesdep +basedep +containersdep +ghcsetup-changed

Dependencies added: base, containers, ghc, monad-coroutine, mtl, stm, transformers

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c)2012, S(o)OS Consortium++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of S(o)OS Consortium nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ SoOSiM.cabal view
@@ -0,0 +1,50 @@+Name:                SoOSiM+Version:             0.1+Synopsis:            Abstract full system simulator++Description:+  SoOSiM is a simulator developed for the purpose of exploring operating+  system concepts and operating system modules. The simulator provides a+  highly abstracted view of a computing system, consisting of computing+  nodes, and components that are concurrently executed on these nodes.+  OS modules are subsequently modelled as components that progress as a+  result of reacting to two types of events: messages from other components,+  or a system-wide tick event. Using this abstract view, a developer can+  quickly formalize assertions regarding the interaction between operating+  system modules and applications.++Homepage:            http://www.soos-project.eu/+License:             BSD3+License-file:        LICENSE+Author:              S(o)OS Consortium+Maintainer:          Christiaan Baaij <christiaan.baaij@gmail.com>+Copyright:           (c) 2012, S(o)OS Consortium+Category:            Simulation+Build-type:          Simple+Stability:           alpha++Cabal-version:       >=1.6++Library+  HS-Source-Dirs:   src++  Exposed-modules:  SoOSiM,+                    SoOSiM.Simulator,+                    SoOSiM.Types++  ghc-options:      -Wall++  Build-depends:    base             >= 4.3.1.0 && < 4.6,+                    containers       >= 0.4.0.0 && < 0.5,+                    transformers     >= 0.2.2.0 && < 2.3,+                    mtl              >= 2.0.1.0 && < 2.1,+                    monad-coroutine  >= 0.7.1   && < 0.8,+                    ghc              >= 7.0.3   && < 7.5,+                    stm              >= 2.3     && < 2.4++  Other-modules:    SoOSiM.SimMonad,+                    SoOSiM.Util++source-repository head+  type:     git+  location: git://github.com/christiaanb/SoOSiM.git
+ src/SoOSiM.hs view
@@ -0,0 +1,17 @@+module SoOSiM+  ( SimM+  , ComponentId+  , NodeId+  , ComponentIface (..)+  , ComponentInput (..)+  , module SoOSiM.SimMonad+  , module Data.Dynamic+  , module Unique+  )+where++import Data.Dynamic+import Unique++import SoOSiM.Types+import SoOSiM.SimMonad
+ src/SoOSiM/SimMonad.hs view
@@ -0,0 +1,172 @@+{-# LANGUAGE RecordWildCards #-}+module SoOSiM.SimMonad where++import Control.Concurrent.STM+import Control.Monad.Coroutine+import Control.Monad.State+import Control.Monad.Trans.Class ()+import Data.IntMap as IntMap+import Data.Map    as Map+import Data.Maybe++import SoOSiM.Simulator+import SoOSiM.Types+import SoOSiM.Util+import Unique+import UniqSupply++-- | Register a component interface with the simulator+registerComponent ::+  ComponentIface s+  => s+  -> SimM ()+registerComponent cstate = SimM $ do+  lift $ modify (\s -> s {componentMap = Map.insert (componentName cstate) (SC cstate) (componentMap s)})++-- | Create a new component+createComponent ::+  Maybe NodeId         -- ^ Node to create component on, leave to 'Nothing' to create on current node+  -> Maybe ComponentId -- ^ ComponentId to set as parent, set to 'Nothing' to use own ComponentId+  -> String            -- ^ Name of the registered component+  -> SimM ComponentId  -- ^ 'ComponentId' of the created component+createComponent nodeId_maybe parentId_maybe cname = SimM $ do+    curNodeId     <- lift $ gets currentNode+    let nId       = fromMaybe curNodeId nodeId_maybe+    pId           <- lift $ gets currentComponent+    let parentId  = fromMaybe pId parentId_maybe+    cId           <- lift getUniqueM++    (SC cstate)   <- fmap (fromJust . Map.lookup cname) $ lift $ gets componentMap+    cstateTV      <- (lift . lift) $ newTVarIO cstate++    statusTV      <- (lift . lift) $ newTVarIO Idle+    bufferTV      <- (lift . lift) $ newTVarIO []++    let emptyMeta = SimMetaData 0 0 0 Map.empty Map.empty+    emptyMetaTV   <- (lift . lift) $ newTVarIO emptyMeta++    lift $ modifyNode nId (addComponent cId (CC cId statusTV cstateTV parentId bufferTV [] emptyMetaTV))+    return cId+  where+    addComponent cId cc n@(Node {..}) =+      n { nodeComponents      = IntMap.insert (getKey cId) cc nodeComponents+        , nodeComponentLookup = Map.insert cname cId nodeComponentLookup+        , nodeComponentOrder  = nodeComponentOrder ++ [cId]+        }++-- | Synchronously invoke another component+invoke ::+  Maybe ComponentId -- ^ Caller, leave 'Nothing' to set to current module+  -> ComponentId    -- ^ Callee+  -> Dynamic        -- ^ Argument+  -> SimM Dynamic   -- ^ Response from recipient+invoke senderMaybe recipient content = SimM $ do+  nId <- lift $ componentNode recipient+  mId <- lift $ gets currentComponent+  let senderId = fromMaybe mId senderMaybe+  senderNodeId <- lift $ componentNode senderId+  lift $ modifyNodeM senderNodeId (incrSendCounter recipient senderId)+  lift $ modifyNodeM nId (updateMsgBuffer recipient (ComponentMsg senderId content))+  suspend (Request recipient return)++-- | Invoke another component, don't wait for a response+invokeNoWait ::+  Maybe ComponentId -- ^ Caller, leave 'Nothing' to set to current module+  -> ComponentId    -- ^ Callee+  -> Dynamic        -- ^ Argument+  -> SimM ()        -- ^ Call returns immediately+invokeNoWait senderMaybe recipient content = SimM $ do+  nId <- lift $ componentNode recipient+  mId <- lift $ gets currentComponent+  let senderId = fromMaybe mId senderMaybe+  senderNodeId <- lift $ componentNode senderId+  lift $ modifyNodeM senderNodeId (incrSendCounter recipient senderId)+  lift $ modifyNodeM nId (updateMsgBuffer recipient (ComponentMsg senderId content))++-- | Yield to the simulator scheduler+yield ::+  ComponentIface s+  => s+  -> SimM s+yield s = SimM $ suspend (Yield (return s))++-- | Get the component id of your component+getComponentId ::+  SimM ComponentId+getComponentId = SimM $ lift $ gets currentComponent++-- | Get the node id of of the node your component is currently running on+getNodeId ::+  SimM NodeId+getNodeId = SimM $ lift $ gets currentNode++-- | Create a new node+createNode ::+  SimM NodeId -- ^ NodeId of the created node+createNode = SimM $ do+  nodeId <- lift getUniqueM+  let newNode = Node nodeId NodeInfo Map.empty IntMap.empty IntMap.empty []+  lift $ modify (\s -> s {nodes = IntMap.insert (getKey nodeId) newNode (nodes s)})+  return nodeId++-- | Write memory of local node+writeMemory ::+  Maybe NodeId -- ^ Node you want to write on, leave 'Nothing' to set to current node+  -> Int       -- ^ Address to write+  -> Dynamic   -- ^ Value to write+  -> SimM ()+writeMemory nodeId_maybe i val = SimM $ do+    curNodeId <- lift $ gets currentNode+    let nodeId = fromMaybe curNodeId nodeId_maybe+    lift $ modifyNode nodeId writeVal+  where+    writeVal n@(Node {..}) = n { nodeMemory = IntMap.insert i val nodeMemory }++-- | Read memory of local node+readMemory ::+  Maybe NodeId -- ^ Node you want to look on, leave 'Nothing' to set to current node+  -> Int       -- ^ Address to read+  -> SimM Dynamic+readMemory nodeId_maybe i = SimM $ do+  curNodeId <- lift $ gets currentNode+  let nodeId = getKey $ fromMaybe curNodeId nodeId_maybe+  memVal <- fmap (IntMap.lookup i . nodeMemory . (IntMap.! nodeId)) $ lift $ gets nodes+  case memVal of+    Just val -> return val+    Nothing  -> error $ "Trying to read empty memory location: " ++ show i ++ " from Node: " ++ show (fromMaybe curNodeId nodeId_maybe)++-- | Return the 'ComponentId' of the component that created the current component+componentCreator ::+  SimM ComponentId+componentCreator = SimM $ do+  nId <- fmap getKey $ lift $ gets currentNode+  cId <- fmap getKey $ lift $ gets currentComponent+  ns <- lift $ gets nodes+  let ces       = (nodeComponents (ns IntMap.! nId))+  let ce        = ces IntMap.! cId+  let ceCreator = creator ce+  return ceCreator++-- | Get the unique 'ComponentId' of a certain component+componentLookup ::+  Maybe NodeId                -- ^ Node you want to look on, leave 'Nothing' to set to current node+  -> ComponentName            -- ^ Name of the component you are looking for+  -> SimM (Maybe ComponentId) -- ^ 'Just' 'ComponentID' if the component is found, 'Nothing' otherwise+componentLookup nodeId_maybe cName = SimM $ do+  curNodeId <- lift $ gets currentNode+  let nId   = getKey $ fromMaybe curNodeId nodeId_maybe+  nsLookup  <- fmap (nodeComponentLookup . (IntMap.! nId)) $ lift $ gets nodes+  return $ Map.lookup cName nsLookup++runIO ::+  IO a+  -> SimM a+runIO = SimM . liftIO++traceMsg ::+  String+  -> SimM ()+traceMsg msg = SimM $ do+  curNodeId <- lift $ gets currentNode+  curCompId <- lift $ gets currentComponent+  lift $ modifyNode curNodeId (updateTraceBuffer curCompId msg)
+ src/SoOSiM/Simulator.hs view
@@ -0,0 +1,230 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE PatternGuards   #-}+{-# LANGUAGE Rank2Types      #-}+module SoOSiM.Simulator+  ( modifyNode+  , modifyNodeM+  , incrSendCounter+  , componentNode+  , updateMsgBuffer+  , updateTraceBuffer+  , execStep+  , execStepSmall+  )+where++import Control.Concurrent.STM+import Control.Monad.Coroutine+import Control.Monad.State+import Control.Monad.Trans.Class ()+import Data.IntMap as IM+import Data.Map    as Map+import qualified Data.Traversable as T+import Unique++import SoOSiM.Types++modifyNode ::+  NodeId            -- ^ ID of the node you want to update+  -> (Node -> Node) -- ^ Update function+  -> SimMonad ()+modifyNode i f =+  modify (\s -> s {nodes = IM.adjust f (getKey i) (nodes s)})++modifyNodeM ::+  NodeId                   -- ^ ID of the node you want to update+  -> (Node -> SimMonad ()) -- ^ Update function+  -> SimMonad ()+modifyNodeM i f = do+  ns <- gets nodes+  f $ ns IM.! (getKey i)++componentNode ::+  ComponentId+  -> SimMonad NodeId+componentNode cId = do+  let key = getKey cId+  ns <- gets nodes+  let (node:_) = IM.elems $ IM.filter (\n -> IM.member key (nodeComponents n)) ns+  return (nodeId node)++updateMsgBuffer ::+  ComponentId       -- ^ Recipient component ID+  -> ComponentInput -- ^ Actual message+  -> Node           -- ^ Node containing the component+  -> SimMonad ()+updateMsgBuffer recipientId msg@(ComponentMsg senderId _) node = do+    let ce = (nodeComponents node) IM.! (getKey recipientId)+    lift $ atomically $ modifyTVar (msgBuffer ce) (\msgs -> msgs ++ [msg])+    lift $ atomically $ modifyTVar (simMetaData ce) (\mData -> mData {msgsReceived = Map.insertWith (+) senderId 1 (msgsReceived mData)})++updateMsgBuffer recipientId msg node = do+    let ce = (nodeComponents node) IM.! (getKey recipientId)+    lift $ atomically $ modifyTVar (msgBuffer ce) (\msgs -> msgs ++ [msg])++incrSendCounter ::+  ComponentId    -- RecipientID+  -> ComponentId -- SenderId+  -> Node        -- Node containing the sender+  -> SimMonad ()+incrSendCounter recipientId senderId node = do+  let ce = (nodeComponents node) IM.! (getKey senderId)+  lift $ atomically $ modifyTVar (simMetaData ce) (\mData -> mData {msgsSend = Map.insertWith (+) recipientId 1 (msgsSend mData)})++updateTraceBuffer ::+  ComponentId+  -> String+  -> Node+  -> Node+updateTraceBuffer componentId msg node =+    node { nodeComponents = f (nodeComponents node)}+  where+    f ccs = IM.adjust g (getKey componentId) ccs+    g cc  = cc { traceMsgs = msg:(traceMsgs cc)}++-- | Update component context according to simulator event+handleComponent ::+  ComponentIface s+  => TVar SimMetaData+  -> ComponentStatus s -- ^ Current component context+  -> s+  -> ComponentInput    -- ^ Simulator event+  -> SimMonad (ComponentStatus s, s, Maybe ComponentInput) -- ^ Returns tuple of: ((potentially updated) component context, 'Nothing' when event is consumed; 'Just' 'ComponentInput' otherwise)++-- If a component receives the message from the sender it was waiting for+handleComponent mDataTV (WaitingForMsg waitingFor f) cstate (ComponentMsg sender content)+  | waitingFor == sender+  = do+    incrRunningCount mDataTV+    -- Run the resumable computation with the message content+    res <- resume $ runSimM (f content)+    case res of+      -- Computation is finished, return to idle state+      Right a                     -> return (Running, a, Nothing)+      -- Computation is waiting for a message, store the resumable computation+      Left (Request o c) -> return (WaitingForMsg o (SimM . c), cstate, Nothing)+      Left (Yield c)     -> do+        res' <- resume c+        case res' of+          Right a -> return (Idle, a, Nothing)+          Left  _ -> error "yield did not return state!"++-- Don't change the execution context if we're not getting the message we're waiting for+handleComponent mDataTV st@(WaitingForMsg _ _) s msg+  = incrWaitingCount mDataTV >> return (st, s, Just msg)++-- Not in an waiting state, just handle the message+handleComponent mDataTV _ cstate msg = do+  incrRunningCount mDataTV+  res <- resume $ runSimM (componentBehaviour cstate msg)+  case res of+    -- Computation is finished, return to idle state+    Right a            -> return (Running, a, Nothing)+    -- Computation is waiting for a message, store the resumable computation+    Left (Request o c) -> return (WaitingForMsg o (SimM . c), cstate, Nothing)+    Left (Yield c)     -> do+        res' <- resume c+        case res' of+          Right a -> return (Idle, a, Nothing)+          Left  _ -> error "yield did not return state!"++executeComponent ::+  ComponentContext+  -> SimMonad ()+executeComponent (CC cId statusTvar cstateTvar _ bufferTvar _ mDataTV) = do+  modify $ (\s -> s {currentComponent = cId})+  status <- lift $ readTVarIO statusTvar+  cstate <- lift $ readTVarIO cstateTvar+  buffer <- lift $ readTVarIO bufferTvar++  (status',cstate',buffer') <- case (status,buffer) of+        (Running, []) -> do+          incrRunningCount mDataTV+          res <- resume $ runSimM (componentBehaviour cstate Tick)+          case res of+            Right a            -> return (Running, a, [])+            Left (Request o c) -> return (WaitingForMsg o (SimM . c), cstate, [])+            Left (Yield c)     -> do+                res' <- resume c+                case res' of+                  Right a -> return (Idle, a, [])+                  Left  _ -> error "yield did not return state!"+        (Idle, [])+          -> do+            incrIdleCount mDataTV+            return (status,cstate,buffer)+        (WaitingForMsg _ _, [])+          -> do+            incrWaitingCount mDataTV+            return (status,cstate,buffer)+        _ -> mapUntilNothingM (handleComponent mDataTV) status cstate buffer++  lift $ atomically $ writeTVar statusTvar status'+  lift $ atomically $ writeTVar cstateTvar cstate'+  lift $ atomically $ writeTVar bufferTvar buffer'++incrIdleCount, incrWaitingCount, incrRunningCount ::+  TVar SimMetaData+  -> SimMonad ()+incrIdleCount    tv = lift $ atomically $ modifyTVar tv (\mdata -> mdata {cyclesIdling  = cyclesIdling  mdata + 1})+incrWaitingCount tv = lift $ atomically $ modifyTVar tv (\mdata -> mdata {cyclesWaiting = cyclesWaiting mdata + 1})+incrRunningCount tv = lift $ atomically $ modifyTVar tv (\mdata -> mdata {cyclesRunning = cyclesRunning mdata + 1})++mapUntilNothingM ::+  ComponentIface s+  => (ComponentStatus s -> s -> ComponentInput -> SimMonad (ComponentStatus s, s, Maybe ComponentInput))+  -> ComponentStatus s+  -> s+  -> [ComponentInput]+  -> SimMonad (ComponentStatus s, s, [ComponentInput])+mapUntilNothingM _ st s [] = return (st,s,[])+mapUntilNothingM f st s (inp:inps) = do+  (st', s', inp_maybe) <- f st s inp+  case inp_maybe of+    Nothing -> return (st',s',inps)+    Just _  -> do+      (st'',s'',inps') <- mapUntilNothingM f st s inps+      return (st'',s'',inp:inps')++executeNode ::+  Node+  -> SimMonad ()+executeNode node = do+    modify $ (\s -> s {currentNode = nodeId node})+    _ <- T.mapM executeComponent (nodeComponents node)+    return ()++executeNodeSmall ::+  Node+  -> SimMonad ()+executeNodeSmall node = do+    modify $ (\s -> s {currentNode = nodeId node})+    --_ <- T.mapM executeComponent (nodeComponents node)+    --return ()+    case (nodeComponentOrder node) of+      [] -> return ()+      (c:_) -> do+          executeComponent ((nodeComponents node) IM.! (getKey c))+          modifyNode (nodeId node) (\n -> n {nodeComponentOrder = rotate (nodeComponentOrder n)})+  where+    rotate []     = []+    rotate (x:xs) = xs ++ [x]++tick :: SimMonad ()+tick = do+  ns <- gets nodes+  _ <- T.mapM executeNode ns+  return ()++tickSmall :: SimMonad ()+tickSmall = do+  ns <- gets nodes+  _ <- T.mapM executeNodeSmall ns+  return ()++execStep :: SimState -> IO SimState+execStep = execStateT tick++execStepSmall :: SimState -> IO SimState+execStepSmall = execStateT tickSmall+
+ src/SoOSiM/Types.hs view
@@ -0,0 +1,136 @@+{-# LANGUAGE Rank2Types                 #-}+{-# LANGUAGE ExistentialQuantification  #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE StandaloneDeriving         #-}+{-# LANGUAGE DeriveDataTypeable         #-}+{-# LANGUAGE TypeSynonymInstances       #-}+module SoOSiM.Types where++import Control.Concurrent.STM+import Control.Monad.Coroutine+import Control.Monad.State+import Control.Monad.Trans.Class ()+import Data.Dynamic+import Data.IntMap+import Data.Map+import Unique+import UniqSupply++type ComponentId   = Unique+type ComponentName = String++deriving instance Typeable Unique++-- | Type class that defines every OS component+class ComponentIface s where+  -- | The minimal internal state of your component+  initState          :: s+  -- | A function returning the unique global name of your component+  componentName      :: s -> ComponentName+  -- | The function defining the behaviour of your component+  componentBehaviour :: s -> ComponentInput -> SimM s++-- | Context of a running component in the simulator.+--+-- We need rank-2 types because we need to make a single collection+-- of several component contexts, each having their own type representing+-- their internal state.+data ComponentContext = forall s . ComponentIface s =>+  CC { componentId        :: ComponentId+     , currentStatus      :: TVar (ComponentStatus s) -- ^ Status of the component+     , componentState     :: TVar s                   -- ^ State internal to the component+     , creator            :: ComponentId              -- ^ 'ComponentId' of the component that created this component+     , msgBuffer          :: TVar [ComponentInput]    -- ^ Message waiting to be processed by the component+     , traceMsgs          :: [String]                 -- ^ Trace message buffer+     , simMetaData        :: TVar SimMetaData         -- ^ Statistical information regarding a component+     }++data SimMetaData+  = SimMetaData+  { cyclesRunning :: Int+  , cyclesWaiting :: Int+  , cyclesIdling  :: Int+  , msgsReceived  :: Map ComponentId Int -- ^ Key: senderId; Value: number of messages+  , msgsSend      :: Map ComponentId Int -- ^ Key: receiverId: Value: number of messages+  }++-- | Status of a running component+data ComponentStatus a+  = Idle                                          -- ^ Component is doing nothing+  | WaitingForMsg ComponentId (Dynamic -> SimM a) -- ^ Component is waiting for a message from 'ComponentId', will continue with computation ('Dynamic' -> 'SimM' a) once received+  | Running                                       -- ^ Component is busy doing computations++-- | Events send to components by the simulator+data ComponentInput = ComponentMsg ComponentId Dynamic -- ^ A message send another component: the field argument is the 'ComponentId' of the sender, the second field the message content+                    | NodeMsg NodeId Dynamic           -- ^ A message send by a node: the first field is the 'NodeId' of the sending node, the second field the message content+                    | Initialize                       -- ^ Event send when a component is first created+                    | Deinitialize                     -- ^ Event send when a component is about to be removed+                    | Tick                             -- ^ Event send every simulation round+  deriving Show++type NodeId   = Unique+-- | Meta-data describing the functionaly of the computing node, currently just a singleton type.+data NodeInfo = NodeInfo++-- | Nodes represent computing entities in the simulator,+-- and host the OS components and application threads+data Node =+  Node { nodeId              :: NodeId                        -- ^ Globally Unique ID of the node+       , nodeInfo            :: NodeInfo                      -- ^ Meta-data describing the node+       , nodeComponentLookup :: Map ComponentName ComponentId -- ^ Lookup table of OS components running on the node, key: the 'ComponentName', value: unique 'ComponentId'+       , nodeComponents      :: IntMap ComponentContext       -- ^ Map of component contexts, key is the 'ComponentId'+       , nodeMemory          :: IntMap Dynamic                -- ^ Node-local memory+       , nodeComponentOrder  :: [ComponentId]+       }++-- 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>'+--+newtype SimM a = SimM { runSimM :: Coroutine (RequestOrYield Unique Dynamic) SimMonad a }+  deriving (Functor, Monad)++data RequestOrYield request response x+  = Request request (response -> x)+  | Yield   x++instance Functor (RequestOrYield x f) where+  fmap f (Request x g) = Request x (f . g)+  fmap f (Yield y)     = Yield (f y)++-- | The internal monad of the simulator is currently a simple state-monad wrapping IO+type SimMonad  = StateT SimState IO++-- | The internal simulator state+data SimState =+  SimState { currentComponent :: ComponentId  -- ^ The 'ComponentId' of the component currently under evaluation+           , currentNode      :: NodeId       -- ^ The 'NodeId' of the node containing the component currently under evaluation+           , nodes            :: IntMap Node  -- ^ The set of nodes comprising the entire system+           , uniqueSupply     :: UniqSupply   -- ^ Unlimited supply of unique values+           , componentMap     :: Map String StateContainer+           }++data StateContainer = forall s . ComponentIface s => SC s++instance MonadUnique SimMonad where+  getUniqueSupplyM = gets uniqueSupply+  getUniqueM       = do+    supply <- gets uniqueSupply+    let (supply'',supply') = splitUniqSupply supply+        unique             = uniqFromSupply supply''+    modify (\s -> s {uniqueSupply = supply'})+    return unique
+ src/SoOSiM/Util.hs view
@@ -0,0 +1,21 @@+module SoOSiM.Util+  ( module SoOSiM.Util+  , module Data.Dynamic+  )+where++import Data.Dynamic+import Data.IntMap+import Data.Monoid++adjustForce :: Monoid a => (a -> a) -> Key -> IntMap a -> IntMap a+adjustForce f k m = case (member k m) of+  True  -> adjust f k m+  False -> insert k (f mempty) m++mapAccumLM :: Monad m => (a -> b -> m (a,c)) -> a -> [b] -> m (a,[c])+mapAccumLM _ a []     = return (a,[])+mapAccumLM f a (x:xs) = do+  (a',y) <- f a x+  (a'',ys) <- mapAccumLM f a' xs+  return (a'',y:ys)