orc 1.1 → 1.1.1.0

raw patch · 3 files changed

+36/−31 lines, 3 files

Files

• orc.cabal +1/−1
• src/Examples/test.hs +3/−3
• src/Orc/Combinators.hs +32/−27

@@ -1,5 +1,5 @@ name:               orc-version:            1.1+version:            1.1.1.0 synopsis:           Orchestration-style co-ordination EDSL description:        Provides an EDSL with Orc primitives. category:           Web

@@ -37,9 +37,9 @@       "4" -> printOrc parvalueVal       "5" -> printOrc $ count queens       "6" -> printOrc numbers -      "7" -> printOrc (scan (flip (++)) [] (first 10 queens)) +      "7" -> printOrc (scan (flip (++)) [] (takeOrc 10 queens))        "8" -> printOrc $ count (chans [1 .. 12])-      "9" -> printOrc $ first 100 $ zipper (recursive 1) (recursive 1000)+      "9" -> printOrc $ takeOrc 100 $ zipOrc (recursive 1) (recursive 1000)       _   -> putStrLn "Unknown"     putStrLn "----------------------------" @@ -81,7 +81,7 @@  firstmetro :: Orc String firstmetro =  return "Respond to 2 prompt within 15 seconds, then check all prompts are dead"-          <|> (delay 1 >> first 2 (metronome >> prompt "Hello"))+          <|> (delay 1 >> takeOrc 2 (metronome >> prompt "Hello"))           <|> (delay 15 >> return "15 seconds...")  metronome = signal <|> (delay 2 >> metronome)

@@ -104,10 +104,8 @@ scan f s p = do   accum <- newTVar s   x <- p-  v <- readTVar accum-  let w = f x v-  writeTVar accum w-  return w+  (w,w') <- modifyTVar accum (f x)+  return w'  (<?>) :: Orc a -> Orc a -> Orc a p <?> q = do@@ -138,8 +136,18 @@      <+>        readTVar accum -ignore :: Int -> Orc a -> Orc a-ignore n p = do++---------------------------------------------------------------------------+-- | List-like functions++takeOrc :: Int -> Orc a -> Orc a+takeOrc n p = do+    vals <- newEmptyMVar+    end  <- newEmptyMVar+    echo n vals end <|> silent (sandbox p vals end)++dropOrc :: Int -> Orc a -> Orc a+dropOrc n p = do     countdown <- newTVar n     x <- p     join $ atomically $ do @@ -149,33 +157,30 @@           writeTVarSTM countdown (w-1)           return stop -first :: Int -> Orc a -> Orc a-first n p = do-    vals <- newEmptyMVar-    end  <- newEmptyMVar-    echo n vals end <|> silent (sandbox p vals end)-  where-  echo 0  _   end = silent (putMVar end ())-  echo j vals end = do-    mx <- takeMVar vals-    case mx of-      Nothing -> silent (putMVar end ())-      Just x  -> return x <|> echo (j-1) vals end--sandbox :: Orc a -> MVar (Maybe a) -> MVar () -> Orc ()-sandbox p vals end-  = ((p >>= (putMVar vals . Just)) <+> putMVar vals Nothing)-    `onlyUntil` takeMVar end ---zipper :: Orc a -> Orc b -> Orc (a,b)-zipper p q = do+zipOrc :: Orc a -> Orc b -> Orc (a,b)+zipOrc p q = do     pvals <- newEmptyMVar     qvals <- newEmptyMVar     end   <- newEmptyMVar     zipp pvals qvals end       <|> silent (sandbox p pvals end)       <|> silent (sandbox q qvals end)++--------------+-- Auxilliary definitions++sandbox :: Orc a -> MVar (Maybe a) -> MVar () -> Orc ()+sandbox p vals end+  = ((p >>= (putMVar vals . Just)) <+> putMVar vals Nothing)+    `onlyUntil` takeMVar end ++echo :: Int -> MVar (Maybe a) -> MVar () -> Orc a+echo 0  _   end = silent (putMVar end ())+echo j vals end = do+    mx <- takeMVar vals+    case mx of+      Nothing -> silent (putMVar end ())+      Just x  -> return x <|> echo (j-1) vals end  zipp :: MVar (Maybe a) -> MVar (Maybe b) -> MVar () -> Orc (a,b) zipp pvals qvals end = do