Personal tools

Concurrency demos/Haskell-Javascript concurrency

From HaskellWiki

< Concurrency demos(Difference between revisions)
Jump to: navigation, search
(Uploaded test source)
 
(Code comments portion 1)
Line 1: Line 1:
  +
This piece of code is intended for compilation to Javascript via [[Yhc/Javascript|Yhc Javascript Backend]] and loading into a web browser.
  +
  +
The program is written in monadic style, but it is based on the [[Continuation|Continuation Monad]].
  +
  +
When started, the <hask>main</hask> function forks out three pseudo-threads, and exits. Each thread outputs some lines of text and terminates. Each line printed contains absolute timestamp obtined via Javascript function <code>newDate.getTime()</code>. Explicit delays are used to yield control to other threads.
  +
 
<haskell>
 
<haskell>
 
-- Test of Control.Monad.Cont in Javascript
 
-- Test of Control.Monad.Cont in Javascript
Line 13: Line 19:
 
import DOM.Level2.HTMLDivElement
 
import DOM.Level2.HTMLDivElement
 
import Debug.Profiling
 
import Debug.Profiling
  +
  +
-- Output a line of text into browser's window.
  +
-- tmf: boolean value instructing to output timestamp when True
  +
-- cls: stylesheet class name
  +
-- txt: text to output
  +
-- doc: reference to the owner document
  +
-- par: parent element where text will be output
   
 
putLineTm = putLine True
 
putLineTm = putLine True
Line 22: Line 35:
 
addChild t d
 
addChild t d
 
addChild d par
 
addChild d par
  +
  +
-- Main function. References to the cdocument and document body will be passed
  +
-- to every thread for simplicity. All output goes into the document's body.
  +
-- In our example all computations have type Cont Bool x. This makes sense
  +
-- because Javascript event handlers are expected to return a boolean value.
   
 
main = (`runCont` id) $ do
 
main = (`runCont` id) $ do
Line 27: Line 45:
 
body <- documentBody doc
 
body <- documentBody doc
 
putLine False "title" "Simple Concurrency Test with Control.Monad.Cont" doc body
 
putLine False "title" "Simple Concurrency Test with Control.Monad.Cont" doc body
  +
  +
-- Fork three pseudo-threads.
  +
 
forkCont $ step0 doc body
 
forkCont $ step0 doc body
 
forkCont $ step1 doc body
 
forkCont $ step1 doc body
 
forkCont $ step3 doc body
 
forkCont $ step3 doc body
 
return True
 
return True
  +
  +
-- Home-grown continiation delimiter function. Passes remainder of the
  +
-- whole computation to a given function and forces the whole computation
  +
-- to complete by returning a final value. Something similar to returning
  +
-- a final value in plain CPS instead of invoking the continuation.
  +
-- f: function which the remainder of the program will be passed to.
  +
-- Remainder will not be evaluated.
  +
-- r: final value of the whole computation that the latter will be
  +
-- terminated with.
   
 
delimit f r = Cont $ \c -> runCont (return 0) $ \a -> f (runCont (return a) c) r
 
delimit f r = Cont $ \c -> runCont (return 0) $ \a -> f (runCont (return a) c) r
  +
  +
-- A primitive to fork out a thread. See the Yhc/Javascript Programmers Guide
  +
-- for the implementation of forkAfter; briefly, it saves the continuation
  +
-- in a global Javascript object, and calls window.setTimeout to execute
  +
-- the saved continuation after the timeout expires. Thus effects like
  +
-- forking parallel thread and cooperative concurrency may be achieved.
  +
-- As follows from the functin source below, it yields execution to whatever
  +
-- given as `x' (which must return a final value of the same type as
  +
-- the "parent" thread), while the remained of the parent will be started
  +
-- after a minimal timeout. The "child" thread is expected to be courteous
  +
-- to its parent and yield execution shortly.
   
 
forkCont x = delimit (forkAfter 0) (runCont x id)
 
forkCont x = delimit (forkAfter 0) (runCont x id)

Revision as of 04:54, 22 November 2007

This piece of code is intended for compilation to Javascript via Yhc Javascript Backend and loading into a web browser.

The program is written in monadic style, but it is based on the Continuation Monad.

When started, the
main
function forks out three pseudo-threads, and exits. Each thread outputs some lines of text and terminates. Each line printed contains absolute timestamp obtined via Javascript function newDate.getTime(). Explicit delays are used to yield control to other threads.
-- Test of Control.Monad.Cont in Javascript
 
module ContTest where
 
import UnsafeJS
import Control.Monad
import Control.Monad.Cont
import CDOM.Level2.DomUtils
import DOM.Level2.Dom
import DOM.Level2.Html2
import DOM.Level2.HTMLElement
import DOM.Level2.HTMLDivElement
import Debug.Profiling
 
-- Output a line of text into browser's window.
--  tmf: boolean value instructing to output timestamp when True
--  cls: stylesheet class name
--  txt: text to output
--  doc: reference to the owner document
--  par: parent element where text will be output
 
putLineTm = putLine True
 
putLine tmf cls txt doc par = do
  tm <- getTimeStamp 0
  t <- mkText doc $ (if tmf then (show tm ++ ": ") else "") ++ txt
  d <- mkDiv doc >>= set'className cls
  addChild t d
  addChild d par
 
-- Main function. References to the cdocument and document body will be passed
-- to every thread for simplicity. All output goes into the document's body.
-- In our example all computations have type Cont Bool x. This makes sense
-- because Javascript event handlers are expected to return a boolean value.
 
main = (`runCont` id) $ do
  doc <- getHTMLDocument
  body <- documentBody doc
  putLine False "title" "Simple Concurrency Test with Control.Monad.Cont" doc body
 
-- Fork three pseudo-threads.
 
  forkCont $ step0 doc body
  forkCont $ step1 doc body
  forkCont $ step3 doc body
  return True
 
-- Home-grown continiation delimiter function. Passes remainder of the 
-- whole computation to a given function and forces the whole computation
-- to complete by returning a final value. Something similar to returning 
-- a final value in plain CPS instead of invoking the continuation.
--  f: function which the remainder of the program will be passed to.
--     Remainder will not be evaluated.
--  r: final value of the whole computation that the latter will be 
--     terminated with.
 
delimit f r = Cont $ \c -> runCont (return 0) $ \a -> f (runCont (return a) c) r
 
-- A primitive to fork out a thread. See the Yhc/Javascript Programmers Guide
-- for the implementation of forkAfter; briefly, it saves the continuation
-- in a global Javascript object, and calls window.setTimeout to execute
-- the saved continuation after the timeout expires. Thus effects like
-- forking parallel thread and cooperative concurrency may be achieved.
-- As follows from the functin source below, it yields execution to whatever
-- given as `x' (which must return a final value of the same type as 
-- the "parent" thread), while the remained of the parent will be started
-- after a minimal timeout. The "child" thread is expected to be courteous
-- to its parent and yield execution shortly.
 
forkCont x = delimit (forkAfter 0) (runCont x id)
 
yield n = delimit (forkAfter n) True
 
step0 doc body = do
  putLineTm "" "Line 0-1" doc body
  tmm <- callCC $ \tdiff -> do
    putLineTm "" "Line 0-2" doc body
    t1 <- getTimeStamp 0
    yield 1000
    t2 <- getTimeStamp t1
    putLineTm "" "Line 0-3" doc body
    tdiff t2
  putLineTm "" "Line 0-4" doc body
  putLineTm "" ("Actual timeout was " ++ show tmm ++ "ms") doc body
  return True
 
step1 doc body = do
  putLineTm "" "Line 1-5" doc body
  putLineTm "" "Line 1-6" doc body
  yield 1000
  putLineTm "" "Line 1-7" doc body
  putLineTm "" "Line 1-8" doc body
  return True
 
step3 doc body = do
  putLineTm "" "Line 3-9" doc body
  putLineTm "" "Line 3-A" doc body
  yield 500
  putLineTm "" "Line 3-B" doc body
  putLineTm "" "Line 3-C" doc body
  return True