Permalink
Browse files

new project. extracted from reactive.

darcs-hash:20080908144009-fb517-a9cd51b349aa314a712bdbb247f74d8118a83a6a.gz
  • Loading branch information...
0 parents commit 281a3a12379bccb0428d08189ea8c492c74f99b4 @conal conal committed Sep 8, 2008
Showing with 219 additions and 0 deletions.
  1. +1 −0 Makefile
  2. +25 −0 README
  3. +3 −0 Setup.lhs
  4. +140 −0 src/Data/Unamb.hs
  5. +35 −0 unamb.cabal
  6. +15 −0 wikipage.tw
@@ -0,0 +1 @@
+include ../cho-cabal-make.inc
25 README
@@ -0,0 +1,25 @@
+unamb [1] contains the "unambiguous choice" operator "unamb" [2], which
+wraps thread racing up in a purely functional, semantically simple
+wrapper. Given any two arguments u and v that agree unless bottom, the
+value of unamb u v is the more terminating of u and v. Operationally, the
+value of unamb u v becomes available when the earlier of u and v does.
+The agreement precondition ensures unamb's referential transparency.
+
+unamb was originally a part of Reactive [3]. I moved it to its own
+package in order to encourage experimentation.
+
+Please share any comments & suggestions on the discussion (talk) page at
+[1].
+
+You can configure, build, and install all in the usual way with Cabal
+commands.
+
+ runhaskell Setup.lhs configure
+ runhaskell Setup.lhs build
+ runhaskell Setup.lhs install
+
+References:
+
+[1] http://haskell.org/haskellwiki/unamb
+[2] http://conal.net/papers/simply-reactive
+[3] http://haskell.org/haskellwiki/reactive
@@ -0,0 +1,3 @@
+#!/usr/bin/env runhaskell
+> import Distribution.Simple
+> main = defaultMain
@@ -0,0 +1,140 @@
+{-# LANGUAGE PatternSignatures #-}
+{-# OPTIONS_GHC -Wall #-}
+----------------------------------------------------------------------
+-- |
+-- Module : Data.Unamb
+-- Copyright : (c) Conal Elliott 2008
+-- License : BSD3
+--
+-- Maintainer : conal@conal.net
+-- Stability : experimental
+--
+-- Unambiguous choice
+----------------------------------------------------------------------
+
+module Data.Unamb
+ (
+ unamb, amb, race, assuming, hang, asAgree
+ -- * Tests
+ , batch
+ ) where
+
+import Test.QuickCheck.Help
+import Test.QuickCheck.Later
+
+-- For hang
+import Control.Monad (forever)
+import System.IO.Unsafe
+
+-- For unamb
+import Control.Concurrent
+import Control.Exception (evaluate)
+
+
+-- | Unambiguous choice operator. Equivalent to the ambiguous choice
+-- operator, but with arguments restricted to be equal where not bottom,
+-- so that the choice doesn't matter. See also 'amb'.
+unamb :: a -> a -> a
+a `unamb` b = unsafePerformIO (a `amb` b)
+
+
+-- | Ambiguous choice operator. Yield either value. Evaluates in
+-- separate threads and picks whichever finishes first. See also
+-- 'unamb' and 'race'.
+amb :: a -> a -> IO a
+a `amb` b = evaluate a `race` evaluate b
+
+-- | Race two actions against each other in separate threads, and pick
+-- whichever finishes first. See also 'amb'.
+{-race :: IO a -> IO a -> IO a
+a `race` b =
+ -- Evaluate a and b in concurrent threads. Whichever thread finishes
+ -- first kill the other thread.
+ do v <- newEmptyMVar -- to hold a or b
+
+ -- Thanks to Luke Palmer for pointing out the problem with
+ -- using recursive do notation to pass tids to the threads.
+ -- Loop is triggered if the first thread gets to killThread
+ -- before the second thread has been started.
+ -- Workaround involves creating two MVars to hold the tids.
+
+ mta <- newEmptyMVar
+ mtb <- newEmptyMVar
+ lock <- newEmptyMVar -- to avoid double-kill
+ -- Evaluate one value and kill the other.
+ let run io mtid = forkIO $ do x <- io
+ tid <- takeMVar mtid
+ putMVar lock ()
+ -- fork a thread to kill the other
+ -- if we don't, we may end up blocked
+ -- waiting for the other thread to die.
+ forkIO (killThread tid)
+ putMVar v x
+ ta <- run a mtb
+ tb <- run b mta
+ putMVar mtb tb
+ putMVar mta ta
+ readMVar v-}
+
+race :: IO a -> IO a -> IO a
+race a b = do
+ v <- newEmptyMVar
+ ta <- forkIO (a >>= putMVar v)
+ tb <- forkIO (b >>= putMVar v)
+ x <- takeMVar v
+ forkIO (killThread ta >> killThread tb)
+ return x
+
+-- Without using unsafePerformIO, is there a way to define a
+-- non-terminating but non-erroring pure value that consume very little
+-- resources while not terminating?
+
+-- | Never yield an answer. Like 'undefined' or 'error "whatever"', but
+-- don't raise an error, and don't consume computational resources.
+hang :: a
+hang = unsafePerformIO hangIO
+
+-- | Block forever
+hangIO :: IO a
+hangIO = do -- putStrLn "warning: blocking forever."
+ -- Any never-terminating computation goes here
+ -- This one can yield an exception "thread blocked indefinitely"
+ -- newEmptyMVar >>= takeMVar
+ -- sjanssen suggests this alternative:
+ forever $ threadDelay maxBound
+ -- forever's return type is (), though it could be fully
+ -- polymorphic. Until it's fixed, I need the following line.
+ return undefined
+
+
+-- | Yield a value if a condition is true. Otherwise wait forever.
+assuming :: Bool -> a -> a
+assuming c a = if c then a else hang
+
+-- | The value of agreeing values (or hang)
+asAgree :: Eq a => a -> a -> a
+a `asAgree` b = assuming (a == b) a
+
+
+
+{----------------------------------------------------------
+ Tests
+----------------------------------------------------------}
+
+batch :: TestBatch
+batch = ( "FRP.Reactive.Unamb"
+ , [ ("both identity", bothId unambNumericType hang)
+ , ("idempotence" , idempotent2 unambNumericType)
+ , ("commutative" , isCommutTimes 0.00001 unambNumericType)
+ , ("associative" , isAssocTimes 0.00001 unambNumericType)
+ ]
+ )
+ where
+ unambNumericType :: NumericType -> NumericType -> NumericType
+ unambNumericType = unamb
+
+-- The commutative and associative test take a long time because of the
+-- intentional delays. I don't understand the magnitude of the delays,
+-- however. They appear to be 1000 times what I'd expect. For instance,
+-- 0.00001 sec time 500 tests is 5 milliseconds, but I count about 5
+-- seconds.
@@ -0,0 +1,35 @@
+Name: unamb
+Version: 0.0
+Cabal-Version: >= 1.2
+Synopsis: Unambiguous choice
+Category: Concurrency, Data, Other
+Description:
+ unamb contains the "unambiguous choice" operator "unamb", which
+ wraps thread racing up in a purely functional, semantically simple
+ wrapper. Originally a part of Reactive, I moved unamb to its own
+ package in order to encourage experimentation.
+ .
+ Project wiki page: <http://haskell.org/haskellwiki/unamb>
+ .
+ The module documentation pages have links to colorized source code and
+ to wiki pages where you can read and contribute user comments. Enjoy!
+ .
+ &#169; 2008 by Conal Elliott; BSD3 license.
+Author: Conal Elliott
+Maintainer: conal@conal.net
+Homepage: http://haskell.org/haskellwiki/unamb
+Package-Url: http://code.haskell.org/unamb
+Copyright: (c) 2008 by Conal Elliott
+License: BSD3
+Stability: experimental
+build-type: Simple
+
+Library
+ hs-Source-Dirs: src
+ Extensions:
+ Build-Depends: base, QuickCheck, checkers
+ Exposed-Modules:
+ Data.Unamb
+ ghc-options: -Wall
+
+-- ghc-prof-options: -prof -auto-all
@@ -0,0 +1,15 @@
+[[Category:Packages]]
+
+== Abstract ==
+
+'''unamb''' is a package containing the ''unambiguous choice'' operator <hask>unamb</hask>, which wraps thread racing up in a purely functional, semantically simple wrapper. Given any two arguments <hask>u</hask> and <hask>v</hask> that agree unless bottom, the value of <hask>unamb u v</hask> is the more terminating of <hask>u</hask> and <hask>v</hask>. Operationally, the value of <hask>unamb u v</hask> becomes available when the earlier of <hask>u</hask> and <hask>v</hask> does. The agreement precondition ensures unamb's referential transparency. For more info about <hask>unamb</hask> and its use, see the paper ''[http://conal.net/papers/simply-reactive/ Simply Efficient Functional Reactivity]'', sections 10 and 11.
+
+<hask>unamb</hask> was originally a part of [[Reactive]]. I moved it to its own package in order to encourage experimentation.
+
+Besides this wiki page, here are more ways to find out about unamb:
+* Read [http://code.haskell.org/unamb/doc/html/ the library documentation].
+* Get the code repository: '''<tt>darcs get http://code.haskell.org/unamb</tt>'''.
+* Install from [http://hackage.haskell.org/cgi-bin/hackage-scripts/package/unamb Hackage].
+* See the [[unamb/Versions| version history]].
+
+Please leave comments at the [[Talk:unamb|Talk page]].

0 comments on commit 281a3a1

Please sign in to comment.