Difference between revisions of "Concurrency demos/Haskell-Javascript concurrency"
Jump to navigation
Jump to 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