{- - Copyright (c) 2008, Jochem Berndsen - All rights reserved. - - Redistribution and use in source and binary forms, with or without - modification, are permitted provided that the following conditions - are met: - - 1. Redistributions of source code must retain the above copyright - notice, this list of conditions and the following disclaimer. - 2. 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. - 3. Neither the name of the author nor the names of its 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 HOLDER 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 FOUNDATION 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. -} -- | -- Module : Control.Hasim.DES -- Copyright : (c) Jochem Berndsen 2008 -- License : BSD3 -- -- Maintainer : jochem@functor.nl -- Stability : experimental -- Portability : unportable -- -- This module defines a /DES/, which stands for /Discrete Event Set/. -- There are functions for creating and inserting events. -- -- For each process, an 'Event' may be scheduled. This event consists of -- a 'Time' and a 'Runnable'. There can be at most one 'Event' scheduled -- for each 'Process'. module Control.Hasim.DES ( -- * Events -- ** Abstract data type Event, -- ** Querying events eTime, eRunnable, eProcess, -- * Discrete Event Set -- ** ADT for Discrete Event Set DES, -- ** Creating Discrete Event Set initDES, emptyDES, -- ** Querying Discrete Event Set isEmpty, -- * Updating Discrete Event Set removeNext, update ) where -- Internal imports import Control.Hasim.Process import Control.Hasim.Types -- External imports import Control.Monad import Data.IORef import Data.Maybe -- | Event. An event consists of a 'Time' and a 'Runnable' data Event = Event { eTime :: Time -- ^ The 'Time' at which the event takes place. , eRunnable :: Runnable -- ^ The 'Runnable' that should be run at this time } -- | The process of an 'Event' eProcess :: Event -> Process eProcess = runnable2process . eRunnable instance Show Event where show e = "Event { t = " ++ t ++ ", proc = " ++ p ++ " }" where t = show (eTime e) p = show (eProcess e) -- | Discrete Event Set. A discrete event set is a data structure -- that supports the operations 'update' and 'removeNext'. newtype DES = DES { unDES :: [Event] } instance Show DES where show = show . unDES -- | Is the Discrete Event Set empty? isEmpty :: DES -> Bool isEmpty = null . unDES -- | Get an event with lowest time that will take place next. -- Returns a tuple @(evt, des)@ where @evt@ is the next 'Event' -- and @des@ is the new 'DES' where this event is removed. -- -- Calls 'error' if the 'DES' is empty. removeNext :: DES -> (Event, DES) removeNext (DES (e:es)) = (e, DES es) removeNext (DES []) = error "Control.Hasim.DES.removeNext : empty discrete event set" insert :: Event -> DES -> DES insert e' = DES . go . unDES where go es = left ++ [e'] ++ right where (left, right) = span (\e -> eTime e' >= eTime e) es -- | Schedule an event in a discrete event set. Note that an old -- event of the same process is removed from the discrete event set. update :: Time -- ^ The time at which the event takes place -> Runnable -- ^ The 'Runnable' that should be run at that time -> DES -- ^ The old discrete event set -> DES -- ^ The discrete event set with the event added update newtime runnable = insert evt . DES . rmv . unDES where proc = runnable2process runnable rmv = filter ((/= proc) . eProcess) evt = Event { eTime = newtime, eRunnable = runnable } -- | Create a new 'DES'. For each 'Process', an 'Event' is scheduled -- at time 0 and with 'Runnable' the associated 'Runnable' of the 'Process'. initDES :: [Process] -- ^ The list of processes -> IO DES -- ^ IO, with result the created DES initDES ps = DES `liftM` mapM (\(Process p) -> do mRunnable <- readIORef (action p) when (isNothing mRunnable) (fail "Control.Hasim.DES.initDES: Process without action") return $! Event { eTime = 0 , eRunnable = fromJust mRunnable } ) ps -- | An empty discrete event set. emptyDES :: DES emptyDES = DES []