Re: [Haskell-cafe] process simulation in functional style

16 Jul 2006

      You might discover helpful techniques by searching for these
terms/projects/papers:

- "functional reactive programming" (e.g. Yampa project)
- "resumption monad" (e.g. "Cheap but Functional Threads")
- concurrent Haskell extensions
- or even comonads (e.g. "Essence of Dataflow")

The "activation energy" to be invested in each technique is likely
considerable, but that's the fun part, right?

Hope that helps,
Nick

On 7/16/06, Alexander Vodomerov  wrote:
...
Hello!
I'm writing a program that simulates multiple processes. The processes may
send/receive messages, do some work, or sleep for some amount of time.
I have seen that many such things can be expressed in Haskell in very
elegant manner using it functional or lazy properties. For example,
client/server interaction may be expressed via inifinite lists as shown
in "Gentle Introduction to Haskell". Another way of process simulation
is describied in http://citeseer.ist.psu.edu/harcourt95extensible.html,
where simple and concise CCS interperter is constructed.
I've tried to apply the idea of infinite lists or CCS-style processes,
but fail. The main reason is that:
1) messages are asynchronous (it may be received and handled while
process are sleeping, without waking them)
2) in some cases received message may wake up process
3) all activity in system is ordered by time
4) there are >2 process and during simulations new processes may be
created
I've no idea how to implement 1, 2 in CCS interpeter.
The approach of infinite lists seems to have problems with 3, 4.
Have somebody any ideas how this can be solved in simple and concise way?
With best regards,
    Alexander.
PS. Currently I have some code (see below), but it is VERY UGLY. The
main drawback is that is very "imperative". It employs notion of "Global
state".  It doesn't use features of Haskell and can be rewritten in ML
or C++ without changes. Another flaws is that it is very unextensible,
and all processes must have the same state.
-- example code
latency = 0.001
type Message = String
type MsgM = WriterT [(Int, Message)] IO  -- process may send messages
-- process states
next id = (id + 1) `mod` 3
type State = (Int, Int, Double) -- proc. number, counter, interval
do_step :: State -> MsgM (Double, State) --- do something and then sleep
do_step (id, cnt, delay) = do
  tell [(next id, "ping " ++ show id ++ " cnt " ++ show cnt)]
  return (delay, (id, cnt + 1, delay))
handle_message :: Message -> State -> MsgM State
handle_message msg (id, cnt, delay) = do
    -- liftIO $ putStrLn $ show id ++ " received  msg " ++ msg
    if msg !! 0 == 'p' then tell [(next id, "reply " ++ show id ++ " to " ++ msg)] else return ()
    return (id, cnt, delay)
-- global event queue
data Event = MsgRecv Message | Work deriving Show
type EventQueue = [(Double, Int, Event)]
compare_event (t1, n1, e1) (t2, n2, e2) = compare t1 t2
type EventM = WriterT EventQueue IO
queue_event :: Int -> Event -> Double -> EventM ()
queue_event dest ev time = tell [(time, dest, ev)]
type FullState = Map.Map Int State
handle_event :: Int -> Double -> Event -> FullState -> EventM FullState
handle_event procnum time ev fullstate  = do
    let localstate = (fullstate Map.! procnum)
    case ev of
      MsgRecv msg -> do
              (nstate, messages) <- lift $ runWriterT (handle_message msg localstate)
              sequence_ $ map (\(dst, msg) -> queue_event dst (MsgRecv msg) (time + latency)) messages
              return $ Map.insert procnum nstate fullstate
      Work -> do
              ((pause, nstate), messages) <- lift $ runWriterT (do_step localstate)
              sequence_ $ map (\(dst, msg) -> queue_event dst (MsgRecv msg) (time + latency)) messages
              queue_event procnum Work (time + pause)
              return $ Map.insert procnum nstate fullstate
run_queue :: FullState -> EventQueue -> IO ()
run_queue st eventqueue =
    case eventqueue of
      [] -> return ()
      (time, dest, ev) : rest -> do
                      putStrLn $ "processing event " ++ (showFFloat (Just 3) time) "" ++ " at procnum " ++ show dest ++ " "  ++ show ev
                      (nst, nev) <- runWriterT (handle_event dest time ev st)
                      let nqueue = foldl (\res -> \e -> insertBy compare_event e res) rest nev
                      run_queue nst nqueue
init_state = Map.fromList [(0, (0, 0, 0.3)), (1, (1, 0, 0.4)), (2, (2, 0, 0.5))]
main = run_queue init_state [(0, 0, Work), (0, 1, Work)]
_______________________________________________
Haskell-Cafe mailing list
Haskell-Cafe@haskell.org
http://www.haskell.org/mailman/listinfo/haskell-cafe

Re: [Haskell-cafe] process simulation in functional style

Nicolas Frisby