assorted-commits Mailing List for Assorted projects (Page 67)

SourceForge Headquarters 225 Broadway Suite 1600 San Diego, CA 92101 +1 (858) 422-6466

Revision: 252
          http://assorted.svn.sourceforge.net/assorted/?rev=252&view=rev
Author:   yangzhang
Date:     2008-01-19 22:31:46 -0800 (Sat, 19 Jan 2008)

Log Message:
-----------
adding haskell commons code

Added Paths:
-----------
    haskell-commons/trunk/src/Commons/
    haskell-commons/trunk/src/Commons/Concurrent.hs
    haskell-commons/trunk/src/Commons/Control.hs
    haskell-commons/trunk/src/Commons/Exception.hs
    haskell-commons/trunk/src/Commons/Io.hs
    haskell-commons/trunk/src/Commons/Posix.hs
    haskell-commons/trunk/src/Commons/Text.hs

Added: haskell-commons/trunk/src/Commons/Concurrent.hs
===================================================================

--- haskell-commons/trunk/src/Commons/Concurrent.hs	                        (rev 0)
+++ haskell-commons/trunk/src/Commons/Concurrent.hs	2008-01-20 06:31:46 UTC (rev 252)
@@ -0,0 +1,75 @@
+module Commons.Concurrent where
+
+import Control.Concurrent
+import Control.Concurrent.MVar
+import Control.Exception
+import Control.Monad
+import Data.Maybe
+import Data.Typeable
+
+tryReadMVar v = do
+  x <- tryTakeMVar v
+  case x of 
+    Just x  -> putMVar v x
+    Nothing -> return ()
+  return x
+
+-- TODO extend this to allow interruptibles to specify exactly which
+-- exceptions they tolerate
+
+-- This is designed for only one interrupt to ever happen; there is
+-- currently no mechanism to clear interrupts. This is also designed
+-- for only one client thread.
+
+newInterruptible :: (Typeable e) =>
+                    Bool -> IO ((forall a. IO a -> IO a), (e -> IO ()))
+newInterruptible saveInterrupts = do
+  -- omnipotent lock
+  lock <- newMVar ()
+  -- any ThreadId currently running and is interruptible
+  tid <- newEmptyMVar
+  -- any pending interrupt
+  pending <- newEmptyMVar
+
+  let acquire    = takeMVar lock
+      release    = putMVar lock ()
+      withLock f = bracket acquire (const release) (const f)
+
+  let
+      -- the interruptible first puts tid, then takes pending
+      interruptible f = do
+        myTid  <- myThreadId
+        acquire
+        intr   <- tryReadMVar pending
+        case intr of
+          Nothing -> do
+            -- Let interruptors know who to throw to.
+            putMVar tid myTid
+
+            -- We're clear to proceed; we'll get async exceptions for
+            -- interrupts.
+            release
+            res <- f
+
+            -- If an async exception is on its way, then we'll
+            -- (thankfully, due to async exception semantics) receive
+            -- it while blocked either on acquire or on takeMVar.
+            withLock $ do
+              takeMVar tid
+              return res
+
+          Just ex -> do
+            -- There's an interrupt just waiting for us; raise the
+            -- exception.
+            release
+            throwDyn ex
+
+      -- The interrupter first puts pending, then takes tid.
+      interrupt ex = withLock $ do
+        when saveInterrupts $ putMVar pending ex
+        current <- tryTakeMVar tid
+        case current of
+          Just tid -> throwDynTo tid ex
+          Nothing  -> return ()
+
+  return (interruptible, interrupt)
\ No newline at end of file

Added: haskell-commons/trunk/src/Commons/Control.hs
===================================================================
--- haskell-commons/trunk/src/Commons/Control.hs	                        (rev 0)
+++ haskell-commons/trunk/src/Commons/Control.hs	2008-01-20 06:31:46 UTC (rev 252)
@@ -0,0 +1,13 @@
+module Commons.Control where
+
+import Control.Monad
+
+while :: Bool -> IO a -> IO ()
+while cond body =
+  when cond (body `seq` while cond body)
+
+loop :: IO a -> IO ()
+loop = while True
+
+discard :: (Monad m) => m a -> m ()
+discard f = f >> return ()
\ No newline at end of file

Added: haskell-commons/trunk/src/Commons/Exception.hs
===================================================================
--- haskell-commons/trunk/src/Commons/Exception.hs	                        (rev 0)
+++ haskell-commons/trunk/src/Commons/Exception.hs	2008-01-20 06:31:46 UTC (rev 252)
@@ -0,0 +1,8 @@
+module Commons.Exception where
+
+import Control.Exception
+
+-- avoid monomorphism restriction
+handleDyn body handler = catchDyn handler body
+
+f `or` handler = f `Prelude.catch` handler
\ No newline at end of file

Added: haskell-commons/trunk/src/Commons/Io.hs
===================================================================
--- haskell-commons/trunk/src/Commons/Io.hs	                        (rev 0)
+++ haskell-commons/trunk/src/Commons/Io.hs	2008-01-20 06:31:46 UTC (rev 252)
@@ -0,0 +1,24 @@
+module Commons.Io where
+
+import Data.List
+import System.IO
+
+-- TODO available in 6.8
+{-
+withFile path mode f = do
+  h <- openFile path mode
+  res <- f h
+  hClose h
+  return res
+-}
+
+unhidden = filter (not . ("." `isPrefixOf`))
+
+strict f = do
+  xs <- f
+  length xs `seq` return xs
+
+hGetContents' = strict . hGetContents
+
+readFileOrNil path = readFile path `catch` const (return "")
+readFileOrNil' = strict . readFileOrNil
\ No newline at end of file

Added: haskell-commons/trunk/src/Commons/Posix.hs
===================================================================
--- haskell-commons/trunk/src/Commons/Posix.hs	                        (rev 0)
+++ haskell-commons/trunk/src/Commons/Posix.hs	2008-01-20 06:31:46 UTC (rev 252)
@@ -0,0 +1,12 @@
+module Commons.Posix where
+
+import Data.List
+import System.Posix.Files
+
+mergeModes = foldl' unionFileModes nullFileMode
+
+executeMode = mergeModes [ownerExecuteMode, groupExecuteMode, otherExecuteMode]
+
+chmod mode path = do
+  origMode <- fmap fileMode $ getFileStatus path
+  setFileMode path $ origMode `unionFileModes` mode

Added: haskell-commons/trunk/src/Commons/Text.hs
===================================================================
--- haskell-commons/trunk/src/Commons/Text.hs	                        (rev 0)
+++ haskell-commons/trunk/src/Commons/Text.hs	2008-01-20 06:31:46 UTC (rev 252)
@@ -0,0 +1,9 @@
+module Commons.Text where
+
+import Control.Arrow
+
+indent n = lines >>> map (replicate n ' ' ++) >>> unlines
+
+--grep pat = lines >>> filter (contains pat) >>> unlines
+--
+--fgrep_v = filter (contains "
\ No newline at end of file


This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.




2007	Jan	Feb	Mar	Apr	May	Jun	Jul	Aug	Sep	Oct	Nov (9)	Dec (12)
2008	Jan (86)	Feb (265)	Mar (96)	Apr (47)	May (136)	Jun (28)	Jul (57)	Aug (42)	Sep (20)	Oct (67)	Nov (37)	Dec (34)
2009	Jan (39)	Feb (85)	Mar (96)	Apr (24)	May (82)	Jun (13)	Jul (10)	Aug (8)	Sep (2)	Oct (20)	Nov (31)	Dec (17)
2010	Jan (16)	Feb (11)	Mar (17)	Apr (53)	May (31)	Jun (13)	Jul (3)	Aug (6)	Sep (11)	Oct (4)	Nov (17)	Dec (17)
2011	Jan (3)	Feb (19)	Mar (5)	Apr (17)	May (3)	Jun (4)	Jul (14)	Aug (3)	Sep (2)	Oct (1)	Nov (3)	Dec (2)
2012	Jan (3)	Feb (7)	Mar (1)	Apr	May (1)	Jun	Jul (4)	Aug (5)	Sep (2)	Oct (3)	Nov	Dec
2013	Jan	Feb	Mar (9)	Apr (5)	May	Jun (2)	Jul (1)	Aug (10)	Sep (1)	Oct (2)	Nov	Dec
2014	Jan (1)	Feb (3)	Mar (3)	Apr (1)	May (4)	Jun	Jul	Aug	Sep (2)	Oct	Nov	Dec
2015	Jan	Feb	Mar	Apr	May	Jun	Jul	Aug	Sep	Oct (1)	Nov	Dec
2016	Jan (1)	Feb	Mar (2)	Apr	May	Jun	Jul	Aug	Sep (1)	Oct	Nov	Dec
2017	Jan	Feb	Mar (1)	Apr	May (5)	Jun (1)	Jul	Aug	Sep	Oct	Nov	Dec (2)
2018	Jan	Feb	Mar	Apr	May	Jun (1)	Jul	Aug	Sep	Oct	Nov	Dec