CCA 0.1.1 → 0.1.3

raw patch · 10 files changed

+237/−213 lines, 10 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CCA.cabal +11/−8
• README +11/−2
• src/Control/CCA.lhs +4/−5
• src/Control/CCA/CCNF.lhs +59/−160
• src/Control/CCA/Types.lhs +2/−4
• src/Language/Haskell/TH/Instances.hs +23/−5
• test/Main.hs +28/−18
• test/Makefile +1/−1
• test/Sample.as +32/−10
• test/Sample1.hs +66/−0

@@ -1,6 +1,6 @@ Name:           CCA-Version:        0.1.1-Cabal-Version:  >= 1.2+Version:        0.1.3+Cabal-Version:  >= 1.6 Build-Type:     Simple License:        BSD3 License-File:   LICENSE@@ -12,7 +12,7 @@ Synopsis:       preprocessor and library for Causal Commutative Arrows (CCA) Description:    A library that provides normalization support via Template                  Haskell for CCAs, and a modified preprocessor based on-                Ross Patterson's arrowp that reads Haskell with arrow notation +                Ross Paterson's arrowp that reads Haskell with arrow notation                  and outputs Haskell 98 + Template Haskell sources for                 use with CCA library. Extra-Source-Files: @@ -20,6 +20,7 @@                 test/Makefile                 test/Main.hs                 test/Sample.as+                test/Sample1.hs   library@@ -31,9 +32,11 @@     build-depends: base >= 4 && < 5, syb, ghc-prim  Executable ccap-    Main-is:        Main.lhs-    Other-Modules:  ArrCode ArrSyn Lexer Parser Parser State Utils-    Build-Depends:  base >= 3 && < 5, array, containers, haskell-src-    Hs-Source-Dirs: preprocessor-+  Main-is:        Main.lhs+  Other-Modules:  ArrCode ArrSyn Lexer Parser Parser State Utils+  Build-Depends:  base >= 3 && < 5, array, containers, haskell-src+  Hs-Source-Dirs: preprocessor +source-repository head+  type:          darcs+  location:      http://code.haskell.org/CCA/

@@ -7,12 +7,21 @@ program, now called ccap, is provided to help preparing proper input to  Template Haskell.  -Note that this is a preliminary release, and still very experiment. Please+Note that this is a preliminary release, and still very experimental. Please send your feedbacks directly to Paul H. Liu <paul@thev.net>, as well as Eric Cheng <eric.cheng@yale.edu>. All suggestions are welcome. +ChangeLog:++    Mon Apr 12 EDT 2010: ++        Normalize to loopD instead of loopB, add more test cases, add support+        for GHC 6.12.1, and bump version to 0.1.3.++    Sun Sep 13 EDT 2009: Some cleanup using HLint, bump version to 0.1.2.+ -----Last Modified: Wed Sep 09 EDT 2009+Last Modified: Wed Sep 13 EDT 2009  [1]: Hai Liu, Eric Cheng, and Paul Hudak. Causal Commutative Arrows and Their Optimization. Proceedings of the 14th ACM SIGPLAN International Conference on

@@ -1,10 +1,9 @@-> {-# LANGUAGE TemplateHaskell #-}-> {-# LANGUAGE FlexibleInstances #-}+> {-# LANGUAGE TemplateHaskell, FlexibleInstances #-}  > module Control.CCA  >   ((>>>), (<<<), first, second, (***), (&&&), loop,  >    Arrow, ArrowLoop, ArrowInit, ->    arr, init, arr', init',+>    arr, init, arr', init', constant, >    norm, normOpt) where  > import Control.Arrow hiding (arr, returnA)@@ -21,6 +20,6 @@ > init :: ExpQ -> ExpQ > init i = appE [|init' i|] i -> returnA :: ArrowInit a => a b b-> returnA = arr' [|id|] id+> constant :: (ArrowInit a, Lift b) => b -> a () b+> constant c = arr' [|const c|] (const c) 

@@ -2,12 +2,13 @@  > module Control.CCA.CCNF  >   (norm, normOpt, ->    pprNorm, pprNormOpt, printCCA, ASyn) where+>    pprNorm, pprNormOpt, printCCA, ASyn,+>    cross, dup, swap, assoc, unassoc, juggle, trace, mirror, untag, tagT, untagT) where  #if __GLASGOW_HASKELL__ >= 610  > import Control.Category-> import Prelude hiding ((.), init)+> import Prelude hiding ((.), id, init)  #else @@ -33,8 +34,7 @@ >   | First AExp >   | AExp :>>> AExp >   | Loop AExp->   | LoopD ExpQ AExp    -- loop with initialized feedback->   | LoopB ExpQ AExp    -- loop with both immediate and initialized feedback+>   | LoopD ExpQ ExpQ -- loop with initialized feedback >   | Init ExpQ >   | Lft AExp @@ -83,20 +83,11 @@ >   f +++ g = left f >>> right g >   f ||| g = f +++ g >>> arr' [| untag |] untag -These helpers have to be at the top-level because TH cannot splice in a-polymorphic local function.--> mirror (Left x) = Right x-> mirror (Right y) = Left y--> untag (Left x) = x-> untag (Right y) = y- Pretty printing AExp.  > printCCA (AExp x) = printAExp x > printAExp x = runQ (fromAExp x) >>= putStrLn . simplify . pprint-> simplify = unwords . map (unwords . (map aux) . words) . lines +> simplify = unwords . map (unwords . map aux . words) . lines  >   where aux (c:x) | not (isAlpha c) = c : aux x >         aux x = let (u, v) = break (=='.') x >                 in if length v > 1 then aux (tail v)@@ -110,13 +101,11 @@ > imap h (First f) = First (h f) > imap h (f :>>> g) = h f :>>> h g > imap h (Loop f) = Loop (h f)-> imap h (LoopD i f) = LoopD i (h f)-> imap h (LoopB i f) = LoopB i (h f) > imap h (Lft f) = Lft (h f) > imap h x = x  > everywhere :: Traversal -> Traversal -> everywhere h e = h (imap (everywhere h) e)+> everywhere h = h . imap (everywhere h)  Normalization =============@@ -126,15 +115,15 @@  > norm :: ASyn t t1 -> ExpQ         -- returns a generic ArrowInit arrow > norm (AExp e) = fromAExp (normE e)-> normE = everywhere (normalize normE)+> normE = everywhere normalize   normOpt returns the pair of state and pure function as (i, f) from optimized  CCNF in the form loopD i (arr f).   > normOpt :: ASyn t t1 -> ExpQ      -- returns a pair of state and pure function (s, f) > normOpt (AExp e) = ->   case toLoopD $ normE e of->     LoopD i (Arr f) -> tupE [i, f]+>   case normE e of+>     LoopD i f -> tupE [i, f] >     _         -> error "The given arrow can't be normalized to optimized CCNF."   pprNorm and pprNormOpt return the pretty printed normal forms as a @@ -150,8 +139,7 @@ > fromAExp (First f) = appE [|first|] (fromAExp f) > fromAExp (f :>>> g) = infixE (Just (fromAExp f)) [|(>>>)|] (Just (fromAExp g)) > fromAExp (Loop f) = appE [|loop|] (fromAExp f)-> fromAExp (LoopD i f) = appE (appE [|loopD|] i) (fromAExp f)-> fromAExp (LoopB i f) = appE (appE [|loopB|] i) (fromAExp f)+> fromAExp (LoopD i f) = appE (appE [|loopD|] i) f > fromAExp (Init i) = appE [|init|] i > fromAExp (Lft f) = appE [|left|] (fromAExp f) @@ -160,135 +148,29 @@  Arrow laws: -> normalize norm (Arr f :>>> Arr g) = Arr (g `o` f)-> normalize norm (First (Arr f)) = Arr (f `crossE` idE)-> normalize norm (First f :>>> First g) = First ((f :>>> g))+> normalize (Arr f :>>> Arr g) = Arr (g `o` f)+> normalize (First (Arr f)) = Arr (f `crossE` idE)+> normalize (Arr f :>>> LoopD i g) = LoopD i (g `o` (f `crossE` idE))+> normalize (LoopD i f :>>> Arr g) = LoopD i ((g `crossE` idE) `o` f)+> normalize (LoopD i f :>>> LoopD j g) = LoopD (tupE [i,j]) +>   (assocE `o` juggleE `o` (g `crossE` idE) `o` juggleE `o` (f `crossE` idE) `o` assocE')+> normalize (Loop (LoopD i f)) = LoopD i (traceE (juggleE `o` f `o` juggleE))+> normalize (First (LoopD i f)) = LoopD i (juggleE `o` (f `crossE` idE) `o` juggleE)+> normalize (Init i) = LoopD i swapE  Choice: -> normalize norm (Lft (Arr f)) = Arr [| \x -> case x of->                                               Left a -> Left ($f a)->                                               Right b -> Right b |]-> normalize norm (Lft (LoopB i f)) =->     norm (LoopB i (Arr tagE :>>> Lft f :>>> Arr untagE))->     where->       tagE = [| \(inp,s) -> case inp of->                               Left a -> Left (a, s)->                               Right c -> Right (c, s) |]->       untagE = [| \out -> case out of->                             Left (b,s) -> (Left b, s)->                             Right (c,s) -> (Right c, s) |]--LoopB laws:--> normalize norm (h :>>> (LoopB i f)) = norm (LoopB i (First h :>>> f))-> normalize norm ((LoopB i f) :>>> h) = norm (LoopB i (f :>>> First h))-> normalize norm (LoopB i (LoopB j f)) = ->   norm (LoopB (tupE [i, j]) (Arr shuffleE :>>> f :>>> Arr shuffleE'))->   where->     shuffleE = assocE' `o` (idE `crossE` transposeE)->     shuffleE' = (idE `crossE` transposeE) `o` assocE-> normalize norm (First (LoopB i f)) = ->  norm (LoopB i (Arr juggleE :>>> First f :>>> Arr juggleE))--LoopD, Loop, and Init are translated to LoopB:-->-- normalize norm (LoopD i f) = norm (Loop (f :>>> secondA (Init i)))->-- normalize norm (Loop f) = LoopB (Term "()") (norm (Arr assocE' :>>> First f :>>> Arr assocE))->-- normalize norm (Init i) = LoopB i (Arr (swapE `o` juggleE `o` swapE))--LoopD laws--> normalize norm (h :>>> LoopD i f) = norm (LoopD i (First h :>>> f))-> normalize norm (LoopD i f :>>> h) = norm (LoopD i (f :>>> First h))-> normalize norm (LoopD i (LoopD j f)) = ->   norm (LoopD (tupE [i, j]) (Arr assocE' :>>> f :>>> Arr assocE))-> normalize norm (First (LoopD i f)) = ->   norm (LoopD i (Arr juggleE :>>> First f :>>> Arr juggleE))--Loop laws--> normalize norm (h :>>> Loop f) = norm (Loop (First h :>>> f))-> normalize norm (Loop f :>>> h) = norm (Loop (f :>>> First h))-> normalize norm (Loop (Loop f)) = ->   norm (Loop (Arr assocE' :>>> f :>>> Arr assocE))-> normalize norm (First (Loop f)) = ->   norm (Loop (Arr juggleE :>>> First f :>>> Arr juggleE))--Loop and LoopB--> normalize norm (Loop (LoopB i f)) = ->   norm (LoopB i (Arr shuffleE :>>> f :>>> Arr shuffleE'))->  where ->    shuffleE = assocE' `o` (idE `crossE` assocE)->    shuffleE' = (idE `crossE` assocE') `o` assocE--> normalize norm (LoopB i (Loop f)) = ->   norm (LoopB i (Arr shuffleE :>>> f :>>> Arr shuffleE'))->   where ->     shuffleE = assocE' `o` (idE `crossE` juggleE)->     shuffleE' = (idE `crossE` juggleE) `o` assocE--Loop and LoopD--> normalize norm (Loop (LoopD i f)) = ->   norm (LoopB i (Arr assocE' :>>> f :>>> Arr assocE))--> normalize norm (LoopD i (Loop f)) = ->   norm (LoopB i (Arr (juggleE `o` assocE') :>>> f :>>> ->                  Arr (assocE' `o` juggleE)))--LoopB AND LoopD--> normalize norm (LoopB i (LoopD j f)) = ->   norm (LoopB (tupE [i, j]) (Arr shuffleE :>>> f :>>> Arr shuffleE'))->   where->     shuffleE = assocE' `o` (idE `crossE` assocE')->     shuffleE' = (idE `crossE` assocE) `o` assocE--> normalize norm (LoopD i (LoopB j f)) = ->   norm (LoopB (tupE [i, j]) (Arr shuffleE :>>> f :>>> Arr shuffleE'))->   where->     shuffleE = transposeE `o` assocE'->     shuffleE' = assocE `o` transposeE--Init--> normalize norm (Init i) = norm (LoopD i (Arr swapE))--All the other cases remain unchanged --> normalize norm e = e --Optimized CCNF-==============--to transform loopB to loopD:--   loopB i (arr f) ---> loopD i (arr g)--we must generate the function g from f:+> normalize (Lft (Arr f)) = Arr (lftE f)+> normalize (Lft (LoopD i f)) = LoopD i (untagE `o` lftE f `o` tagE) -   g (x, z) = let (x', (y, z')) = f (x, (y, z))-              in (x', z')+All the other cases are unchanged.  -> toLoopD (LoopB i (Arr f)) = LoopD i (Arr g)->   where->     g = do->       f' <- f->       [x, y, z, x', z'] <- mapM newName ["x", "y", "z", "x'", "z'"]->       return $ LamE [TupP [VarP x, VarP z]] $ LetE ->                [ValD (TupP [VarP x', TupP [VarP y, VarP z']]) (NormalB $->                 AppE f' (TupE [VarE x, TupE [VarE y, VarE z]])) []]->                (TupE [VarE x', VarE z'])-> toLoopD x = x+> normalize e = e  -Notice the recursively defined variable y, and it'll prevent GHC from inlining-g and f.  So we must further transform f into a set of let-expressions, and-move the definition of y inside. Here is a set of transformations we do to-function g:+To Let-Expression+================= -1.  Transform function applications to let-expressions.+Transform function applications to let-expressions.    (\x -> e1) e2  === let x = e2 in e1 @@ -299,23 +181,40 @@ >     aux (AppE (LamE (pat:ps) body) arg) = LamE ps (LetE [ValD pat (NormalB arg) []] body) >     aux x = x -2.  TODO: For every pattern match agains tuples, unfold right-hand-size until it is a-    tuple too, and then break up into a list of let-expressions. - Auxiliary Functions =================== -> f `o` g = appE (appE [|\f g x -> f (g x)|] f) g-> f `crossE` g = appE (appE [|\f g x -> (f $ fst x, g $ snd x)|] f) g-> idE = [|\x -> x|]-> dupE = [|\x -> (x, x)|]-> swapE = [|\x -> (snd x, fst x)|]-> curryE = [|\f x y -> f (x, y)|]-> uncurryE = [|\f x -> f (fst x) (snd x)|]-> assocE = [|\x -> (fst $ fst x, (snd $ fst x, snd x))|]-> assocE' = [|\x -> ((fst x, fst $ snd x), snd $ snd x)|]-> juggleE = assocE' `o` (idE `crossE` swapE) `o` assocE-> transposeE = [|\x -> ((fst $ fst x, fst $ snd x),->                       (snd $ fst x, snd $ snd x))|]-+> dup x = (x, x)+> swap (x, y) = (y, x)+> unassoc (x, (y, z)) = ((x, y), z)+> assoc ((x, y), z) = (x, (y, z))+> juggle ((x, y), z) = ((x, z), y)+> trace f x = let (y, z) = f (x, z) in y+> cross f g (x, y) = (f x, g y)+> mirror (Left x) = Right x+> mirror (Right y) = Left y+> untag (Left x) = x+> untag (Right y) = y+> lft f x = case x of+>   Left  u -> Left (f u)+>   Right u -> Right u +> tagT (x, y) = case x of+>   Left  u -> Left  (u, y)+>   Right u -> Right (u, y)+> untagT z = case z of+>   Left  (x, y) -> (Left  x, y)+>   Right (x, y) -> (Right x, y)+ +> f `o` g = appE (appE [|(.)|] f) g+> f `crossE` g = appE (appE [|cross|] f) g+> idE = [|id|]+> dupE = [|dup|]+> swapE = [|swap|]+> assocE = [|assoc|]+> assocE' = [|unassoc|]+> juggleE = [|juggle|]+> traceE = appE [|trace|]+> tagE = [|tagT|]+> untagE = [|untagT|]+> lftE = appE [|lft|] 

@@ -18,9 +18,7 @@ >   arr' _ = arr >   init' :: ExpQ -> b -> a b b >   init' _ = init->   loopD :: e -> a (b, e) (c, e) -> a b c ->   loopD i f = loop (f >>> second (init i))->   loopB :: e -> a (b, (d, e)) (c, (d, e)) -> a b c->   loopB i f = loop (f >>> second (second (init i)))+>   loopD :: e -> ((b, e) -> (c, e)) -> a b c +>   loopD i f = loop (arr f >>> second (init i))  

@@ -1,8 +1,4 @@-{-# OPTIONS -fglasgow-exts #-}-{-# LANGUAGE CPP #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE MagicHash, CPP, TemplateHaskell, FlexibleInstances, TypeSynonymInstances #-}  module Language.Haskell.TH.Instances where import Data.Ratio@@ -39,6 +35,28 @@   lift s = let s' = occString s in [|mkOccName s'|]  fromInt (I# i) = i++#if __GLASGOW_HASKELL__ >= 612++instance Lift ModName where+  lift = lift . modString++instance Lift PkgName where+  lift = lift . pkgString++instance Lift Pred where+  lift (ClassP n ts) = [|ClassP n ts|]+  lift (EqualP t t2) = [|EqualP t t2|]++instance Lift Kind where+  lift StarK = [|StarK|]+  lift (ArrowK k1 k2) = [|ArrowK k1 k2|]++instance Lift TyVarBndr where+  lift (PlainTV n) = [|PlainTV n|]+  lift (KindedTV n k) = [|KindedTV n k|]++#endif  instance Lift NameFlavour where   lift NameS = [|NameS|]

@@ -10,11 +10,13 @@ #endif  import Control.Arrow+import Control.CCA import Control.CCA.CCNF import Control.CCA.Types import System.IO import System.CPUTime import Sample +import qualified Sample1 as S  newtype SF a b = SF { runSF :: (a -> (b, SF a b)) } @@ -70,16 +72,11 @@ instance ArrowInit SF where   init i = SF (f i)     where f i x = (i, SF (f x))-  loopD i g = SF (f i g)-    where-      f i g x = -        let ((y, i'), g') = runSF g (x, i)-        in (y, SF (f i' g'))-  loopB i g = SF (f i g)+  loopD i g = SF (f i)      where-      f i g x = -        let ((y, (z, i')), g') = runSF g (x, (z, i))-        in (y, SF (f i' g'))+      f i x = +        let (y, i') = g (x, i)+        in (y, SF (f i'))  run :: SF a b -> [a] -> [b] run (SF f) (x:xs) =@@ -113,28 +110,41 @@             (zip [0, dt..] l)       hClose h -plot3sec fn sf = gnuplot fn (take (sr * 3) (unfold sf))+plot3sec fn = gnuplot fn . take (sr * 3) . unfold   testcase list = do   ts <- mapM timer list   let ts' = map (\x -> 1 / fromIntegral x) ts   let x = minimum ts'   let ns = map (/x) ts'-  sequence_ $ [ putStr (show (fromIntegral (floor (x * 100)) / 100) ++ "\t") | x <- ns ]+  sequence_ [ putStr (show (fromIntegral (floor (x * 100)) / 100) ++ "\t") | x <- ns ]   putStrLn "\n"  main = do   let n = 1000000   putStrLn "Compare exp singal function"-  testcase $ [nth n exp, nth n expNorm, nth' n expOpt]+  testcase [nth n S.exp, nth n exp, expNorm n, expOpt n]   putStrLn "Compare sine singal function"-  testcase $ [nth n sine2, nth n sineNorm, nth' n sineOpt]+  testcase [nth n (S.sine 2), nth n (sine 2), sineNorm n, sineOpt n]+  putStrLn "Compare oscSine singal function"+  testcase [nth n (S.testOsc S.oscSine), nth n (testOsc oscSine), oscNorm n, oscOpt n]+  putStrLn "Compare sciFi singal function"+  testcase [nth n S.sciFi, nth n sciFi, sciFiNorm n, sciFiOpt n]+  putStrLn "Compare robot singal function"+  testcase [nth n (S.testRobot S.robot), nth n (testRobot robot), robotNorm n, robotOpt n] -expNorm = $(norm exp)-expOpt = $(normOpt exp)+expNorm n = nth n $(norm exp)+expOpt n = nth' n $(normOpt exp) -sine2 = sine 2-sineNorm = $(norm $ sine 2)-sineOpt = $(normOpt $ sine 2)+sineNorm n = nth n $(norm $ sine 2)+sineOpt n = nth' n $(normOpt $ sine 2) +oscNorm n = nth n $(norm $ testOsc oscSine)+oscOpt n = nth' n $(normOpt $ testOsc oscSine) ++sciFiNorm n = nth n $(norm sciFi)+sciFiOpt n = nth' n $(normOpt sciFi)++robotNorm n = nth n $(norm $ testRobot robot)+robotOpt n = nth' n $(normOpt $ testRobot robot) 

@@ -2,7 +2,7 @@ ARROWP = ccap FLAGS = -fvia-C -fno-method-sharing -fexcess-precision -O2 -XTemplateHaskell  -Main: Main.hs Sample.hs+Main: Main.hs Sample.hs Sample1.hs 	$(GHC) $(FLAGS) --make Main.hs  %.hs: %.as

@@ -19,16 +19,6 @@       i <- init 0 -< i'   returnA -< i -sineA :: ArrowInit a => Double -> a () Double-sineA freq = proc _ -> do-              rec -               d2o <- init (sin omh) -< r-               d1o <- init 0 -< d2o-               let r = 2 * cos(omh) * d2o - d1o-              returnA -< r-  where -    omh = 2*pi/(fromIntegral sr)*freq- sine :: ArrowInit a => Double -> a () Double sine freq = proc _ -> do   rec x <- init i -< r@@ -39,4 +29,36 @@     omh = 2 * pi / (fromIntegral sr) * freq     i = sin omh     c = 2 * cos omh++oscSine :: ArrowInit a => Double -> a Double Double+oscSine f0 = proc cv -> do+  let f = f0 * (2 ** cv)+  phi <- integral -< 2 * pi * f+  returnA -< sin phi++testOsc :: ArrowInit a => (Double -> a Double Double) -> a () Double+testOsc f = constant 1 >>> f 440++sciFi :: ArrowInit a => a () Double+sciFi = proc () -> do+   und <- oscSine 3.0 -< 0+   swp <- integral -< -0.25+   audio <- oscSine 440 -< und * 0.2 + swp + 1+   returnA -< audio++robot :: ArrowInit a => a (Double, Double) Double+robot = proc inp -> do+    let vr = snd inp+        vl = fst inp+        vz = vr + vl+    t <- integral -< vr - vl+    let t' = t / 10+    x <- integral -< vz * cos t'+    y <- integral -< vz * sin t'+    returnA -< x / 2 + y / 2++testRobot :: ArrowInit a => a (Double, Double) Double -> a () Double+testRobot bot = proc () -> do+    u <- sine 2 -< ()+    robot -< (u, 1 - u) 

@@ -0,0 +1,66 @@+{-# LANGUAGE Arrows #-}+module Sample1 where+++import Control.Arrow+import Control.CCA.Types+import Prelude hiding (init, exp)++sr = 44100 :: Int+dt = 1 / (fromIntegral sr)++exp :: ArrowInit a => a () Double+exp = proc () -> do+  rec let e = 1 + i+      i <- integral -< e+  returnA -< e++integral :: ArrowInit a => a Double Double+integral = proc x -> do+  rec let i' = i + x * dt+      i <- init 0 -< i'+  returnA -< i++sine :: ArrowInit a => Double -> a () Double+sine freq = proc _ -> do+  rec x <- init i -< r+      y <- init 0 -< x +      let r = c * x - y+  returnA -< r+  where+    omh = 2 * pi / (fromIntegral sr) * freq+    i = sin omh+    c = 2 * cos omh++oscSine :: ArrowInit a => Double -> a Double Double+oscSine f0 = proc cv -> do+  let f = f0 * (2 ** cv)+  phi <- integral -< 2 * pi * f+  returnA -< sin phi++testOsc :: ArrowInit a => (Double -> a Double Double) -> a () Double+testOsc f = arr (const 1) >>> f 440++sciFi :: ArrowInit a => a () Double+sciFi = proc () -> do+   und <- oscSine 3.0 -< 0+   swp <- integral -< -0.25+   audio <- oscSine 440 -< und * 0.2 + swp + 1+   returnA -< audio++robot :: ArrowInit a => a (Double, Double) Double+robot = proc inp -> do+    let vr = snd inp+        vl = fst inp+        vz = vr + vl+    t <- integral -< vr - vl+    let t' = t / 10+    x <- integral -< vz * cos t'+    y <- integral -< vz * sin t'+    returnA -< x / 2 + y / 2++testRobot :: ArrowInit a => a (Double, Double) Double -> a () Double+testRobot bot = proc () -> do+    u <- sine 2 -< ()+    robot -< (u, 1 - u)+