oi 0.0.3 → 0.0.4

raw patch · 4 files changed

+88/−20 lines, 4 files

Files

oi.cabal +2/−2
sample/Makefile +4/−1
sample/talk.hs +53/−0
src/Data/OI.hs +29/−17

oi.cabal view

@@ -1,5 +1,5 @@ Name:			oi-Version:		0.0.3+Version:		0.0.4 Category:		Data Synopsis:		Purely Functional Lazy Interaction with the outer world Description:		This package implements a data structure and operations on it @@ -13,7 +13,7 @@ Cabal-Version:		>= 1.6  Data-dir:		sample-Data-files:		Makefile echo.hs recdircs.hs+Data-files:		Makefile echo.hs recdircs.hs talk.hs  Library   Hs-Source-Dirs:	    src/

sample/Makefile view

@@ -1,4 +1,4 @@-EXECS = echo recdircs+EXECS = echo recdircs talk  all	: $(EXECS) @@ -6,6 +6,9 @@ 	ghc --make -O0 -threaded $< -o $@  recdircs	: recdircs.hs+	ghc --make -O0 -threaded $< -o $@++talk	: talk.hs 	ghc --make -O0 -threaded $< -o $@  clean	:

+ sample/talk.hs view

@@ -0,0 +1,53 @@+{-# LANGUAGE TypeOperators+  #-}+module Main where++import Data.OI+import Control.Parallel++import System.Environment++main :: IO ()+main = do { kbd1:scr1:kbd2:scr2:_ <- getArgs+          ; run (pmain kbd1 scr1 kbd2 scr2)+          }++pmain+  :: FilePath+  -> FilePath+  -> FilePath+  -> FilePath+  -> ((String, [String], ()), (String, [String], ()))+  :-> ()+pmain kbd1 scr1 kbd2 scr2 r+ = let+     p1 = talk "Alice" kbd1 scr1+     p2 = talk "Bob"   kbd2 scr2+     (is1,is2)  = (p1 |><| p2) r+   in is1 `par` is2++(|><|) :: (q -> a :-> (p,c))+       -> (p -> b :-> (q,d))+       -> ((a,b)  :-> (c,d))+(f |><| g) rasbs = case deTuple rasbs of+  (ras,rbs) -> (cs,ds) where { (xs,cs) = f ys ras; (ys,ds) = g xs rbs }++talk :: String             -- Talker name+     -> FilePath+     -> FilePath                          +     -> [String]           -- Messages from the other end+     -> OI ( String        -- Messages typed by the keyboard+           , [String]      -- Oracles for merging messages+           , ())           -- Result of the process+     -> ([String]          -- Messages to the other end+        ,())               -- Results of the process+talk name kbd scr msg r = (ins,showscreen scr (mergeOI ins msg os) us)+  where+    (is,os,us) = deTriple r+    ins = map ((name ++ ": ")++) $ lines $ readkeyboard kbd is++readkeyboard :: FilePath -> String :-> String+readkeyboard = iooi . readFile++showscreen :: FilePath -> [String] -> () :-> ()+showscreen s = iooi . writeFile s . unlines

src/Data/OI.hs view

@@ -41,6 +41,7 @@    -- * Embeding interaction data in data structure  ,deTuple+ ,deTriple  ,deList    -- * Interaction combinators@@ -51,17 +52,18 @@  ,zipWithOI'  ,sequenceOI  ,sequenceOI'+ ,mergeOI+  ) where  import Control.Applicative-import Control.Concurrent.MVar+import Control.Concurrent import Control.Parallel import Control.Comonad import System.IO.Unsafe - data OI a = OI { variable :: LeftValueOf (IO a), value :: a }-type a :-> b = OI a -> b+type a :-> b  = OI a -> b  -- | Binding operator (=:)         ::  a -> a :-> a@@ -115,10 +117,21 @@ deTuple :: (a,b) :-> (OI a,OI b) deTuple (OI vxy ~(x,y)) = assign io vxy `pseq` (OI vx x, OI vy y)  where-  vx     = new ()-  vy     = new ()+  vx     = new0 ()+  vy     = new0 ()   io     = (,) <$> unsafeInterleaveIO (dereference vx) <*> unsafeInterleaveIO (dereference vy) +-- | Embed interactions into triple+deTriple :: (a,b,c) :-> (OI a,OI b,OI c)+deTriple (OI vxyz ~(x,y,z)) = assign io vxyz `pseq` (OI vx x, OI vy y, OI vz z)+ where+  vx     = new0 ()+  vy     = new0 ()+  vz     = new0 ()+  io     = (,,) <$> unsafeInterleaveIO (dereference vx)+                <*> unsafeInterleaveIO (dereference vy)+                <*> unsafeInterleaveIO (dereference vz)+ -- | Embed interactions into list deList :: [a] :-> Maybe (OI a, OI [a]) deList (OI vxxs xxs)@@ -127,17 +140,16 @@       x:xs -> Just (OI vx x, OI vxs xs)       _    -> Nothing    where-     vx  = new ()-     vxs = new ()+     vx  = new0 ()+     vxs = new0 ()      io  = (:) <$> (unsafeInterleaveIO (dereference vx)) <*> (unsafeInterleaveIO (dereference vxs)) ----infixr 1 <|- -- | Connect two interactions into an interaction (<|)  ::  (b -> c :-> d) -> (a :-> b) -> (a,c) :-> d (f <| g) ac = case deTuple ac of (a,c) -> f (g a) c +infixr 1 <|+ -- | Map interaction function on an interaction list mapOI :: (a :-> b) -> [a] :-> [b] mapOI f xxs = case deList xxs of@@ -179,13 +191,17 @@   Nothing     ->  xxs sequenceOI' [] xxs = xxs +-- | Merging two lists by using oracles+mergeOI :: [a] -> [a] -> [a] :-> [a]+mergeOI xs ys = iooi $ mergeIO xs ys+ -- | Convert an IO to an interaction function iooi            ::  IO a -> (a :-> a) iooi io (OI vix x)  =   assign io vix `pseq` x  -- | Drive an interaction function run        ::  (a :-> b) -> IO b-run pmain  =   do { vx <- unsafeInterleaveIO newEmptyMVar+run pmain  =   do { vx <- newEmptyMVar                   ; x  <- unsafeInterleaveIO (dereference vx)                   ; return $! pmain (OI vx x)                   }@@ -194,19 +210,15 @@  type LeftValueOf = MVar -{-# NOINLINE new #-}-new :: () -> LeftValueOf a-new _ = unsafePerformIO $ newEmptyMVar+new0 :: () -> LeftValueOf a+new0 () = unsafePerformIO $ newEmptyMVar -{-# NOINLINE reference #-} reference :: a -> LeftValueOf a reference = unsafePerformIO . newMVar -{-# NOINLINE dereference #-} dereference :: LeftValueOf a -> a dereference = unsafePerformIO . readMVar -{-# NOINLINE assign #-} assign :: a -> LeftValueOf a -> a assign !x v = unsafePerformIO              $ do { s <- tryPutMVar v x