diff --git a/CCA.cabal b/CCA.cabal
--- a/CCA.cabal
+++ b/CCA.cabal
@@ -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/
diff --git a/README b/README
--- a/README
+++ b/README
@@ -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
diff --git a/src/Control/CCA.lhs b/src/Control/CCA.lhs
--- a/src/Control/CCA.lhs
+++ b/src/Control/CCA.lhs
@@ -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)
 
diff --git a/src/Control/CCA/CCNF.lhs b/src/Control/CCA/CCNF.lhs
--- a/src/Control/CCA/CCNF.lhs
+++ b/src/Control/CCA/CCNF.lhs
@@ -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|]
 
diff --git a/src/Control/CCA/Types.lhs b/src/Control/CCA/Types.lhs
--- a/src/Control/CCA/Types.lhs
+++ b/src/Control/CCA/Types.lhs
@@ -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))
 
 
diff --git a/src/Language/Haskell/TH/Instances.hs b/src/Language/Haskell/TH/Instances.hs
--- a/src/Language/Haskell/TH/Instances.hs
+++ b/src/Language/Haskell/TH/Instances.hs
@@ -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|]
diff --git a/test/Main.hs b/test/Main.hs
--- a/test/Main.hs
+++ b/test/Main.hs
@@ -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)
 
diff --git a/test/Makefile b/test/Makefile
--- a/test/Makefile
+++ b/test/Makefile
@@ -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
diff --git a/test/Sample.as b/test/Sample.as
--- a/test/Sample.as
+++ b/test/Sample.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)
 
diff --git a/test/Sample1.hs b/test/Sample1.hs
new file mode 100644
--- /dev/null
+++ b/test/Sample1.hs
@@ -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)
+