diff --git a/Makefile b/Makefile
--- a/Makefile
+++ b/Makefile
@@ -6,6 +6,9 @@
 ghci:
 	ghci -Wall -odirdist/build -hidirdist/build $(HIDE_SYNTH) -i:$(MODULE_PATH)
 
+ghci7:
+	ghci -Wall -odirdist/build -hidirdist/build $(HIDE_SYNTH) -i:$(MODULE_PATH) -XCPP -DNoImplicitPrelude=RebindableSyntax
+
 tutorial:
 	ghci -Wall -fobject-code -fexcess-precision -O2 -fvia-C -optc-O2 -odirdist/build -hidirdist/build $(HIDE_SYNTH) -i:$(MODULE_PATH) src/Synthesizer/Generic/Tutorial.hs
 
diff --git a/src/Synthesizer/Basic/Phase.hs b/src/Synthesizer/Basic/Phase.hs
--- a/src/Synthesizer/Basic/Phase.hs
+++ b/src/Synthesizer/Basic/Phase.hs
@@ -207,7 +207,7 @@
 
 FIXME:
 The increment and decrement routines are a bit dangerous,
-because they fail if the increment value is large than maxBound::Int.
+because they fail if the increment value is larger than maxBound::Int.
 However, we will always use increments with absolute value below one.
 -}
 {-# RULES
diff --git a/src/Synthesizer/Causal/Class.hs b/src/Synthesizer/Causal/Class.hs
new file mode 100644
--- /dev/null
+++ b/src/Synthesizer/Causal/Class.hs
@@ -0,0 +1,72 @@
+{-# LANGUAGE TypeFamilies #-}
+module Synthesizer.Causal.Class where
+
+import qualified Control.Category as Cat
+import Control.Arrow (Arrow, arr, (<<<), (>>>), (&&&), )
+
+import Data.Function.HT (nest, )
+
+
+class (Arrow process, ProcessOf (SignalOf process) ~ process) => C process where
+   type SignalOf process :: * -> *
+   type ProcessOf (signal :: * -> *) :: * -> * -> *
+   toSignal :: process () a -> SignalOf process a
+   fromSignal :: SignalOf process b -> process a b
+
+
+infixl 0 $<, $>, $*
+-- infixr 0 $:*   -- can be used together with $
+
+apply ::
+   (C process) => process a b -> SignalOf process a -> SignalOf process b
+apply proc sig =
+   toSignal (proc <<< fromSignal sig)
+
+applyFst, ($<) ::
+   (C process) => process (a,b) c -> SignalOf process a -> process b c
+applyFst proc sig =
+   proc <<< feedFst sig
+
+applySnd, ($>) ::
+   (C process) => process (a,b) c -> SignalOf process b -> process a c
+applySnd proc sig =
+   proc <<< feedSnd sig
+
+feedFst :: (C process) => SignalOf process a -> process b (a,b)
+feedFst sig =
+   fromSignal sig &&& Cat.id
+
+feedSnd :: (C process) => SignalOf process a -> process b (b,a)
+feedSnd sig =
+   Cat.id &&& fromSignal sig
+
+{-
+These infix operators may become methods of a type class
+that can also have synthesizer-core:Causal.Process as instance.
+-}
+($*) ::
+   (C process) =>
+   process a b -> SignalOf process a -> SignalOf process b
+($*) = apply
+($<) = applyFst
+($>) = applySnd
+
+
+
+{-# INLINE chainControlled #-}
+chainControlled ::
+   (Arrow arrow) =>
+   [arrow (c,x) x] -> arrow (c,x) x
+chainControlled =
+   foldr
+      (\p rest -> arr fst &&& p  >>>  rest)
+      (arr snd)
+
+{-# INLINE replicateControlled #-}
+replicateControlled ::
+   (Arrow arrow) =>
+   Int -> arrow (c,x) x -> arrow (c,x) x
+replicateControlled n p =
+   nest n
+      (arr fst &&& p  >>> )
+      (arr snd)
diff --git a/src/Synthesizer/Causal/Filter/NonRecursive.hs b/src/Synthesizer/Causal/Filter/NonRecursive.hs
--- a/src/Synthesizer/Causal/Filter/NonRecursive.hs
+++ b/src/Synthesizer/Causal/Filter/NonRecursive.hs
@@ -7,10 +7,12 @@
 import qualified Synthesizer.Generic.Filter.NonRecursive as FiltG
 import qualified Synthesizer.Generic.Signal as SigG
 import qualified Synthesizer.Plain.Filter.NonRecursive as Filt
+import qualified Synthesizer.State.Control as CtrlS
 import qualified Synthesizer.State.Signal as SigS
+import Synthesizer.Utility (affineComb, )
 
 import qualified Algebra.Module         as Module
--- import qualified Algebra.Field          as Field
+import qualified Algebra.Field          as Field
 import qualified Algebra.Ring           as Ring
 import qualified Algebra.Additive       as Additive
 
@@ -37,6 +39,16 @@
 envelopeVector :: (Module.C a v) =>
    Causal.T (a,v) v
 envelopeVector = Causal.map (uncurry (*>))
+
+
+{-# INLINE crossfade #-}
+crossfade :: (Field.C a, Module.C a a) => Int -> Causal.T (a,a) a
+crossfade len =
+   let affineCombMono :: (Module.C a a) => a -> (a,a) -> a
+       affineCombMono = affineComb
+   in  Causal.applyFst
+          (Causal.map (uncurry affineCombMono))
+          (CtrlS.line len (0, 1))
 
 
 {-# INLINE accumulatePosModulatedFromPyramid #-}
diff --git a/src/Synthesizer/Causal/Process.hs b/src/Synthesizer/Causal/Process.hs
--- a/src/Synthesizer/Causal/Process.hs
+++ b/src/Synthesizer/Causal/Process.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE Rank2Types #-}
 {-# LANGUAGE ExistentialQuantification #-}
 {- |
@@ -71,6 +72,7 @@
 
 import qualified Synthesizer.State.Signal as Sig
 import qualified Synthesizer.Generic.Signal as SigG
+import qualified Synthesizer.Causal.Class as Class
 
 import qualified Synthesizer.Plain.Modifier as Modifier
 
@@ -89,7 +91,6 @@
 import Control.Monad (liftM, )
 
 import Data.Tuple.HT (mapSnd, )
-import Data.Function.HT (nest, )
 import Prelude hiding (id, map, zipWith, )
 
 
@@ -158,6 +159,13 @@
    loop = liftKleisli loop
 
 
+instance Class.C T where
+   type SignalOf T = Sig.T
+   type ProcessOf Sig.T = T
+   toSignal = flip applyConst ()
+   fromSignal sig = const () ^>> feed sig
+
+
 {-# INLINE extendStateFstT #-}
 extendStateFstT :: Monad m => StateT s m a -> StateT (t,s) m a
 extendStateFstT st =
@@ -398,10 +406,7 @@
 
 {-# INLINE chainControlled #-}
 chainControlled :: [T (c,x) x] -> T (c,x) x
-chainControlled =
-   foldr
-      (\p rest -> map fst &&& p  >>>  rest)
-      (map snd)
+chainControlled = Class.chainControlled
 
 {- |
 If @T@ would be the function type @->@
@@ -410,10 +415,7 @@
 -}
 {-# INLINE replicateControlled #-}
 replicateControlled :: Int -> T (c,x) x -> T (c,x) x
-replicateControlled n p =
-   nest n
-      (map fst &&& p  >>> )
-      (map snd)
+replicateControlled = Class.replicateControlled
 
 
 {-# INLINE feedback #-}
diff --git a/src/Synthesizer/Causal/ToneModulation.hs b/src/Synthesizer/Causal/ToneModulation.hs
--- a/src/Synthesizer/Causal/ToneModulation.hs
+++ b/src/Synthesizer/Causal/ToneModulation.hs
@@ -68,11 +68,6 @@
     ((t, Phase.T t), sig y) ->
     ((t,t), ToneModS.Cell sig y)
 seekCell periodInt period =
-    {-
-    n will be zero within the data body.
-    It's only needed for extrapolation at the end.
-    Is it really needed?
-    -}
     (\(sp,ptr) ->
        let (k,q) = ToneMod.flattenShapePhase periodInt period sp
        in  (q, ToneModS.makeCell periodInt $
@@ -137,8 +132,7 @@
    Int -> Int -> sig y -> ((Bool, Int), sig y)
 dropMargin margin n xs =
    mapFst ((,) (SigG.lengthAtMost (margin+n) xs)) $
-   SigG.dropMarginRem margin
-      (ToneModS.checkNonNeg n) xs
+   SigG.dropMarginRem margin (ToneModS.checkNonNeg n) xs
 
 regroup :: (Int,t) -> Phase.T t -> ToneMod.Skip t
 regroup (d,s) p = (d, (s,p))
@@ -228,7 +222,7 @@
          then (x0, Causal.id)
          else (xMin,
                Causal.crochetL
-                  (\x lim ->
+                  (\x lim -> Just $
                      let d = x-lim
-                     in  Just $ if d>=zero
+                     in  if d>=zero
                            then (d,zero) else (zero, negate d)) x1)
diff --git a/src/Synthesizer/Frame/Stereo.hs b/src/Synthesizer/Frame/Stereo.hs
--- a/src/Synthesizer/Frame/Stereo.hs
+++ b/src/Synthesizer/Frame/Stereo.hs
@@ -1,6 +1,11 @@
-module Synthesizer.Frame.Stereo
-   (T, left, right, cons, map,
-    arrowFromMono, arrowFromMonoControlled, arrowFromChannels, ) where
+module Synthesizer.Frame.Stereo (
+   T, left, right, cons, map,
+   arrowFromMono, arrowFromMonoControlled, arrowFromChannels,
+   Stereo.Channel(Left, Right), Stereo.select,
+   Stereo.interleave,
+   Stereo.sequence,
+   Stereo.liftApplicative,
+   ) where
 
 import Sound.Frame.NumericPrelude.Stereo as Stereo
 import Control.Arrow (Arrow, (^<<), (<<^), (&&&), )
diff --git a/src/Synthesizer/Generic/Filter/NonRecursive.hs b/src/Synthesizer/Generic/Filter/NonRecursive.hs
--- a/src/Synthesizer/Generic/Filter/NonRecursive.hs
+++ b/src/Synthesizer/Generic/Filter/NonRecursive.hs
@@ -55,6 +55,13 @@
    a -> sig v -> sig v
 amplifyVector v = SigG.map (v*>)
 
+{-# INLINE normalize #-}
+normalize ::
+   (Field.C a, SigG.Transform sig a) =>
+   (sig a -> a) -> sig a -> sig a
+normalize volume xs =
+   amplify (recip $ volume xs) xs
+
 {-# INLINE envelope #-}
 envelope ::
    (Ring.C a, SigG.Transform sig a) =>
diff --git a/src/Synthesizer/Generic/Signal.hs b/src/Synthesizer/Generic/Signal.hs
--- a/src/Synthesizer/Generic/Signal.hs
+++ b/src/Synthesizer/Generic/Signal.hs
@@ -3,6 +3,7 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE ExistentialQuantification #-}
 {-# LANGUAGE RankNTypes #-}
 {- |
 Type classes that give a uniform interface to
@@ -83,28 +84,28 @@
 
 
 
-class Storage signal y where
+class Storage signal where
 
-   data Constraints signal y :: *
+   data Constraints signal :: *
 
-   constraints :: signal y -> Constraints signal y
+   constraints :: signal -> Constraints signal
 
 
 class Read0 sig where
-   toList :: Storage sig y => sig y -> [y]
-   toState :: Storage sig y => sig y -> SigS.T y
---   toState :: Storage sig y => StateT (sig y) Maybe y
-   foldL :: Storage sig y => (s -> y -> s) -> s -> sig y -> s
-   foldR :: Storage sig y => (y -> s -> s) -> s -> sig y -> s
-   index :: Storage sig y => sig y -> Int -> y
+   toList :: Storage (sig y) => sig y -> [y]
+   toState :: Storage (sig y) => sig y -> SigS.T y
+--   toState :: Storage (sig y) => StateT (sig y) Maybe y
+   foldL :: Storage (sig y) => (s -> y -> s) -> s -> sig y -> s
+   foldR :: Storage (sig y) => (y -> s -> s) -> s -> sig y -> s
+   index :: Storage (sig y) => sig y -> Int -> y
 
-class (Cut.Read (sig y), Read0 sig, Storage sig y) => Read sig y where
+class (Cut.Read (sig y), Read0 sig, Storage (sig y)) => Read sig y where
 
 class (Read0 sig) => Transform0 sig where
-   cons :: Storage sig y => y -> sig y -> sig y
-   takeWhile :: Storage sig y => (y -> Bool) -> sig y -> sig y
-   dropWhile :: Storage sig y => (y -> Bool) -> sig y -> sig y
-   span :: Storage sig y => (y -> Bool) -> sig y -> (sig y, sig y)
+   cons :: Storage (sig y) => y -> sig y -> sig y
+   takeWhile :: Storage (sig y) => (y -> Bool) -> sig y -> sig y
+   dropWhile :: Storage (sig y) => (y -> Bool) -> sig y -> sig y
+   span :: Storage (sig y) => (y -> Bool) -> sig y -> (sig y, sig y)
 
    {- |
    When using 'viewL' for traversing a signal,
@@ -112,20 +113,20 @@
    since this might involve optimized traversing
    like in case of Storable signals.
    -}
-   viewL :: Storage sig y => sig y -> Maybe (y, sig y)
-   viewR :: Storage sig y => sig y -> Maybe (sig y, y)
+   viewL :: Storage (sig y) => sig y -> Maybe (y, sig y)
+   viewR :: Storage (sig y) => sig y -> Maybe (sig y, y)
 
-   zipWithAppend :: Storage sig y => (y -> y -> y) -> sig y -> sig y -> sig y
+   zipWithAppend :: Storage (sig y) => (y -> y -> y) -> sig y -> sig y -> sig y
 
    -- functions from Transform2 that are oftenly used with only one type variable
    map ::
-      (Storage sig y0, Storage sig y1) =>
+      (Storage (sig y0), Storage (sig y1)) =>
       (y0 -> y1) -> (sig y0 -> sig y1)
    scanL ::
-      (Storage sig y0, Storage sig y1) =>
+      (Storage (sig y0), Storage (sig y1)) =>
       (y1 -> y0 -> y1) -> y1 -> sig y0 -> sig y1
    crochetL ::
-      (Storage sig y0, Storage sig y1) =>
+      (Storage (sig y0), Storage (sig y1)) =>
       (y0 -> s -> Maybe (y1, s)) -> s -> sig y0 -> sig y1
 
 class (Cut.Transform (sig y), Transform0 sig, Read sig y) => Transform sig y where
@@ -205,31 +206,31 @@
 for multiple signal processors.
 -}
 class Transform0 sig => Write0 sig where
-   fromList :: Storage sig y => LazySize -> [y] -> sig y
---   fromState :: Storage sig y => LazySize -> SigS.T y -> sig y
---   fromState :: Storage sig y => LazySize -> StateT s Maybe y -> s -> sig y
-   repeat :: Storage sig y => LazySize -> y -> sig y
-   replicate :: Storage sig y => LazySize -> Int -> y -> sig y
-   iterate :: Storage sig y => LazySize -> (y -> y) -> y -> sig y
-   iterateAssociative :: Storage sig y => LazySize -> (y -> y -> y) -> y -> sig y
-   unfoldR :: Storage sig y => LazySize -> (s -> Maybe (y,s)) -> s -> sig y
+   fromList :: Storage (sig y) => LazySize -> [y] -> sig y
+--   fromState :: Storage (sig y) => LazySize -> SigS.T y -> sig y
+--   fromState :: Storage (sig y) => LazySize -> StateT s Maybe y -> s -> sig y
+   repeat :: Storage (sig y) => LazySize -> y -> sig y
+   replicate :: Storage (sig y) => LazySize -> Int -> y -> sig y
+   iterate :: Storage (sig y) => LazySize -> (y -> y) -> y -> sig y
+   iterateAssociative :: Storage (sig y) => LazySize -> (y -> y -> y) -> y -> sig y
+   unfoldR :: Storage (sig y) => LazySize -> (s -> Maybe (y,s)) -> s -> sig y
 
 class (Write0 sig, Transform sig y) => Write sig y where
 
 
-instance (Storable y) => Storage SVL.Vector y where
-   data Constraints SVL.Vector y = Storable y => StorableLazyConstraints
+instance (Storable y) => Storage (SVL.Vector y) where
+   data Constraints (SVL.Vector y) = Storable y => StorableLazyConstraints
    constraints _ = StorableLazyConstraints
 
 
 readSVL ::
    (Storable a => SVL.Vector a -> b) ->
-   (Storage SVL.Vector a => SVL.Vector a -> b)
+   (Storage (SVL.Vector a) => SVL.Vector a -> b)
 readSVL f x = case constraints x of StorableLazyConstraints -> f x
 
 writeSVL ::
    (Storable a => SVL.Vector a) ->
-   (Storage SVL.Vector a => SVL.Vector a)
+   (Storage (SVL.Vector a) => SVL.Vector a)
 writeSVL x =
    let z = case constraints z of StorableLazyConstraints -> x
    in  z
@@ -309,18 +310,18 @@
 
 
 
-instance (Storable y) => Storage SV.Vector y where
-   data Constraints SV.Vector y = Storable y => StorableConstraints
+instance (Storable y) => Storage (SV.Vector y) where
+   data Constraints (SV.Vector y) = Storable y => StorableConstraints
    constraints _ = StorableConstraints
 
 readSV ::
    (Storable a => SV.Vector a -> b) ->
-   (Storage SV.Vector a => SV.Vector a -> b)
+   (Storage (SV.Vector a) => SV.Vector a -> b)
 readSV f x = case constraints x of StorableConstraints -> f x
 
 writeSV ::
    (Storable a => SV.Vector a) ->
-   (Storage SV.Vector a => SV.Vector a)
+   (Storage (SV.Vector a) => SV.Vector a)
 writeSV x =
    let z = case constraints z of StorableConstraints -> x
    in  z
@@ -375,8 +376,8 @@
 
 
 
-instance Storage [] y where
-   data Constraints [] y = ListConstraints
+instance Storage [y] where
+   data Constraints [y] = ListConstraints
    constraints _ = ListConstraints
 
 instance Read [] y where
@@ -439,8 +440,8 @@
 
 
 
-instance Storage SigS.T y where
-   data Constraints SigS.T y = StateConstraints
+instance Storage (SigS.T y) where
+   data Constraints (SigS.T y) = StateConstraints
    constraints _ = StateConstraints
 
 instance Read SigS.T y
@@ -508,8 +509,8 @@
    iterateAssociative _ = SigS.iterateAssociative
 
 
-instance Storage (EventList.T time) y where
-   data Constraints (EventList.T time) y = EventListConstraints
+instance Storage (EventList.T time y) where
+   data Constraints (EventList.T time y) = EventListConstraints
    constraints _ = EventListConstraints
 
 instance (NonNeg98.C time, P.Integral time) =>
@@ -667,8 +668,8 @@
    sig y ->
    (forall s. (s -> Maybe (y, s)) -> s -> x) ->
    x
-runViewL =
-   SigS.runViewL . toState
+runViewL xs =
+   SigS.runViewL (toState xs)
 
 {-# INLINE runSwitchL #-}
 runSwitchL ::
@@ -676,8 +677,8 @@
    sig y ->
    (forall s. (forall z. z -> (y -> s -> z) -> s -> z) -> s -> x) ->
    x
-runSwitchL =
-   SigS.runSwitchL . toState
+runSwitchL xs =
+   SigS.runSwitchL (toState xs)
 
 
 {-# INLINE singleton #-}
diff --git a/src/Synthesizer/Generic/Wave.hs b/src/Synthesizer/Generic/Wave.hs
--- a/src/Synthesizer/Generic/Wave.hs
+++ b/src/Synthesizer/Generic/Wave.hs
@@ -44,6 +44,8 @@
 --   uncurry (ToneMod.interpolateCell ipStep ipLeap . swap) $
    uncurry (ToneMod.interpolateCell ipLeap ipStep) $
    ToneMod.sampledToneCell
-      (ToneMod.makePrototype (Interpolation.margin ipLeap) (Interpolation.margin ipStep) period tone)
+      (ToneMod.makePrototype
+          (Interpolation.margin ipLeap) (Interpolation.margin ipStep)
+          period tone)
       shape phase
 
diff --git a/src/Synthesizer/Interpolation/Core.hs b/src/Synthesizer/Interpolation/Core.hs
new file mode 100644
--- /dev/null
+++ b/src/Synthesizer/Interpolation/Core.hs
@@ -0,0 +1,62 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{- |
+Plain interpolation functions.
+-}
+module Synthesizer.Interpolation.Core (
+   linear,
+   cubic,
+   cubicAlt,
+   ) where
+
+import qualified Algebra.Module    as Module
+import qualified Algebra.Field     as Field
+
+import Synthesizer.Utility (affineComb, )
+
+import NumericPrelude.Base
+import NumericPrelude.Numeric
+
+
+
+{-# INLINE linear #-}
+linear ::
+   (Module.C a v) =>
+   v -> v -> a -> v
+linear x0 x1 phase = affineComb phase (x0,x1)
+
+{-# INLINE cubic #-}
+cubic ::
+   (Module.C a v, Field.C a) =>
+   v -> v -> v -> v -> a -> v
+cubic xm1 x0 x1 x2 t =
+   let lipm12 = affineComb t (xm1,x2)
+       lip01  = affineComb t (x0, x1)
+       three  = 3 `asTypeOf` t
+   in  lip01 + (t*(t-1)/2) *>
+                  (lipm12 + (x0+x1) - three *> lip01)
+
+{- |
+The interpolators for module operations
+do not simply compute a straight linear combination of some vectors.
+Instead they add then scale, then add again, and so on.
+This is efficient whenever scaling and addition is cheap.
+In this case they might save multiplications.
+I can't say much about numeric cancellations, however.
+-}
+{-# INLINE cubicAlt #-}
+cubicAlt ::
+   (Module.C a v, Field.C a) =>
+   v -> v -> v -> v -> a -> v
+cubicAlt xm1 x0 x1 x2 t =
+   let half = 1/2 `asTypeOf` t
+   in  cubicHalf    t  x0 (half *> (x1-xm1)) +
+       cubicHalf (1-t) x1 (half *> (x0-x2))
+
+{- |
+@\t -> cubicHalf t x x'@ has a double zero at 1 and
+at 0 it has value x and slope x'.
+-}
+{-# INLINE cubicHalf #-}
+cubicHalf :: (Module.C t y) => t -> y -> y -> y
+cubicHalf t x x' =
+   (t-1)^2 *> ((1+2*t)*>x + t*>x')
diff --git a/src/Synthesizer/Interpolation/Module.hs b/src/Synthesizer/Interpolation/Module.hs
--- a/src/Synthesizer/Interpolation/Module.hs
+++ b/src/Synthesizer/Interpolation/Module.hs
@@ -18,6 +18,8 @@
 import qualified Synthesizer.State.Signal  as Sig
 import qualified Synthesizer.Plain.Control as Ctrl
 
+import qualified Synthesizer.Interpolation.Core as Core
+
 import Synthesizer.Interpolation (
    T, cons, getNode, fromPrefixReader,
    constant,
@@ -28,7 +30,6 @@
 
 import Control.Applicative (liftA2, )
 import Synthesizer.ApplicativeUtility (liftA4, )
-import Synthesizer.Utility (affineComb, )
 
 import NumericPrelude.Base
 import NumericPrelude.Numeric
@@ -39,9 +40,7 @@
 linear :: (Module.C t y) => T t y
 linear =
    fromPrefixReader "linear" 0
-      (liftA2
-          (\x0 x1 phase -> affineComb phase (x0,x1))
-          getNode getNode)
+      (liftA2 Core.linear getNode getNode)
 
 {- |
 Consider the signal to be piecewise cubic,
@@ -57,43 +56,13 @@
 cubic :: (Field.C t, Module.C t y) => T t y
 cubic =
    fromPrefixReader "cubic" 1
-      (liftA4
-         (\xm1 x0 x1 x2 t ->
-            let lipm12 = affineComb t (xm1,x2)
-                lip01  = affineComb t (x0, x1)
-                three  = 3 `asTypeOf` t
-            in  lip01 + (t*(t-1)/2) *>
-                           (lipm12 + (x0+x1) - three *> lip01))
-         getNode getNode getNode getNode)
+      (liftA4 Core.cubic getNode getNode getNode getNode)
 
-{- |
-The interpolators for module operations
-do not simply compute a straight linear combination of some vectors.
-Instead they add then scale, then add again, and so on.
-This is efficient whenever scaling and addition is cheap.
-In this case they might save multiplications.
-I can't say much about numeric cancellations, however.
--}
 {-# INLINE cubicAlt #-}
 cubicAlt :: (Field.C t, Module.C t y) => T t y
 cubicAlt =
    fromPrefixReader "cubicAlt" 1
-      (liftA4
-         (\xm1 x0 x1 x2 t ->
-          let half = 1/2 `asTypeOf` t
-          in  cubicHalf    t  x0 (half *> (x1-xm1)) +
-              cubicHalf (1-t) x1 (half *> (x0-x2)))
-         getNode getNode getNode getNode)
-
-
-{- |
-@\t -> cubicHalf t x x'@ has a double zero at 1 and
-at 0 it has value x and slope x'.
--}
-{-# INLINE cubicHalf #-}
-cubicHalf :: (Module.C t y) => t -> y -> y -> y
-cubicHalf t x x' =
-   (t-1)^2 *> ((1+2*t)*>x + t*>x')
+      (liftA4 Core.cubicAlt getNode getNode getNode getNode)
 
 
 
diff --git a/src/Synthesizer/PiecewiseConstant/Signal.hs b/src/Synthesizer/PiecewiseConstant/Signal.hs
--- a/src/Synthesizer/PiecewiseConstant/Signal.hs
+++ b/src/Synthesizer/PiecewiseConstant/Signal.hs
@@ -8,6 +8,7 @@
    subdivideLazyToShort,
    subdivideLongStrict,
    chopLongTime,
+   longFromShortTime,
    zipWith,
    ) where
 
@@ -80,6 +81,13 @@
    in  map (NonNegW.fromNumberMsg "chopLongTime" . fromInteger) $
        List.genericReplicate q d ++
        if not $ isZero r then [r] else []
+
+{-# INLINE longFromShortTime #-}
+longFromShortTime :: ShortStrictTime -> StrictTime
+longFromShortTime =
+   NonNegW.fromNumberMsg "longFromShortTime" .
+   fromIntegral .
+   NonNegW.toNumber
 
 
 {-# INLINE subdivideLongStrict #-}
diff --git a/src/Synthesizer/Plain/Analysis.hs b/src/Synthesizer/Plain/Analysis.hs
--- a/src/Synthesizer/Plain/Analysis.hs
+++ b/src/Synthesizer/Plain/Analysis.hs
@@ -21,6 +21,7 @@
 import qualified Algebra.NormedSpace.Euclidean as NormedEuc
 import qualified Algebra.NormedSpace.Sum       as NormedSum
 
+import qualified Data.NonEmpty as NonEmpty
 import qualified Data.Array as Array
 
 import qualified Data.IntMap as IntMap
@@ -94,9 +95,8 @@
 Compute minimum and maximum value of the stream the efficient way.
 Input list must be non-empty and finite.
 -}
-bounds :: Ord y => Sig.T y -> (y,y)
-bounds [] = error "Analysis.bounds: List must contain at least one element."
-bounds (x:xs) =
+bounds :: Ord y => NonEmpty.T Sig.T y -> (y,y)
+bounds (NonEmpty.Cons x xs) =
    foldl' (\(minX,maxX) y -> (min y minX, max y maxX)) (x,x) xs
 
 
@@ -136,13 +136,11 @@
 Input list must be finite.
 List is scanned twice, but counting may be faster.
 -}
-histogramDiscreteArray :: Sig.T Int -> (Int, Sig.T Int)
-histogramDiscreteArray [] =
-   (error "histogramDiscreteArray: no bounds found", [])
+histogramDiscreteArray :: NonEmpty.T Sig.T Int -> (Int, Sig.T Int)
 histogramDiscreteArray x =
    let hist =
           accumArray (+) zero
-             (bounds x) (attachOne x)
+             (bounds x) (attachOne $ NonEmpty.flatten x)
    in  (fst (Array.bounds hist), Array.elems hist)
 
 
@@ -152,10 +150,8 @@
 List is scanned twice, but counting may be faster.
 The sum of all histogram values is one less than the length of the signal.
 -}
-histogramLinearArray :: RealField.C y => Sig.T y -> (Int, Sig.T y)
-histogramLinearArray [] =
-   (error "histogramLinearArray: no bounds found", [])
-histogramLinearArray [x] = (floor x, [])
+histogramLinearArray :: RealField.C y => NonEmpty.T Sig.T y -> (Int, Sig.T y)
+histogramLinearArray (NonEmpty.Cons x []) = (floor x, [])
 histogramLinearArray x =
    let (xMin,xMax) = bounds x
        hist =
@@ -170,11 +166,9 @@
 If the input signal is empty, the offset is @undefined@.
 List is scanned once, counting may be slower.
 -}
-histogramDiscreteIntMap :: Sig.T Int -> (Int, Sig.T Int)
-histogramDiscreteIntMap [] =
-   (error "histogramDiscreteIntMap: no bounds found", [])
+histogramDiscreteIntMap :: NonEmpty.T Sig.T Int -> (Int, Sig.T Int)
 histogramDiscreteIntMap x =
-   let hist = IntMap.fromListWith (+) (attachOne x)
+   let hist = IntMap.fromListWith (+) (attachOne $ NonEmpty.flatten x)
    in  case IntMap.toAscList hist of
           [] -> error "histogramDiscreteIntMap: the list was non-empty before processing ..."
           fAll@((fIndex,fHead):fs) -> (fIndex, fHead :
@@ -182,10 +176,8 @@
                  (\(i0,_) (i1,f1) -> replicate (i1-i0-1) zero ++ [f1])
                  fAll fs))
 
-histogramLinearIntMap :: RealField.C y => Sig.T y -> (Int, Sig.T y)
-histogramLinearIntMap [] =
-   (error "histogramLinearIntMap: no bounds found", [])
-histogramLinearIntMap [x] = (floor x, [])
+histogramLinearIntMap :: RealField.C y => NonEmpty.T Sig.T y -> (Int, Sig.T y)
+histogramLinearIntMap (NonEmpty.Cons x []) = (floor x, [])
 histogramLinearIntMap x =
    let hist = IntMap.fromListWith (+) (meanValues x)
    -- we can rely on the fact that the keys are contiguous
@@ -207,18 +199,18 @@
 The bug has gone in IntMap as shipped with GHC-6.6.
 -}
 
-histogramIntMap :: (RealField.C y) => y -> Sig.T y -> (Int, Sig.T Int)
+histogramIntMap :: (RealField.C y) => y -> NonEmpty.T Sig.T y -> (Int, Sig.T Int)
 histogramIntMap binsPerUnit =
    histogramDiscreteIntMap . quantize binsPerUnit
 
-quantize :: (RealField.C y) => y -> Sig.T y -> Sig.T Int
-quantize binsPerUnit = map (floor . (binsPerUnit*))
+quantize :: (Functor f, RealField.C y) => y -> f y -> f Int
+quantize binsPerUnit = fmap (floor . (binsPerUnit*))
 
 attachOne :: Sig.T i -> Sig.T (i,Int)
 attachOne = map (\i -> (i,one))
 
-meanValues :: RealField.C y => Sig.T y -> [(Int,y)]
-meanValues x = concatMap spread (zip x (tail x))
+meanValues :: RealField.C y => NonEmpty.T Sig.T y -> [(Int,y)]
+meanValues = concatMap spread . NonEmpty.mapAdjacent (,)
 
 spread :: RealField.C y => (y,y) -> [(Int,y)]
 spread (l0,r0) =
diff --git a/src/Synthesizer/Plain/Effect.hs b/src/Synthesizer/Plain/Effect.hs
--- a/src/Synthesizer/Plain/Effect.hs
+++ b/src/Synthesizer/Plain/Effect.hs
@@ -16,8 +16,8 @@
 
 import qualified Synthesizer.Plain.File as File
 import qualified Control.Monad.Exception.Synchronous as Exc
-import System.Exit(ExitCode)
-import System.Cmd(rawSystem)
+import System.Process (rawSystem, )
+import System.Exit (ExitCode, )
 
 main :: IO ExitCode
 main =
diff --git a/src/Synthesizer/Plain/File.hs b/src/Synthesizer/Plain/File.hs
--- a/src/Synthesizer/Plain/File.hs
+++ b/src/Synthesizer/Plain/File.hs
@@ -37,7 +37,7 @@
 
 import qualified Control.Monad.Exception.Synchronous as Exc
 import Control.Monad.Trans.Class (lift, )
-import System.Cmd (rawSystem, )
+import System.Process (rawSystem, )
 import System.Exit (ExitCode, )
 import Control.Monad (liftM2, )
 import Data.Monoid (mconcat, )
diff --git a/src/Synthesizer/Plain/Filter/Delay.hs b/src/Synthesizer/Plain/Filter/Delay.hs
--- a/src/Synthesizer/Plain/Filter/Delay.hs
+++ b/src/Synthesizer/Plain/Filter/Delay.hs
@@ -5,7 +5,7 @@
 import qualified Synthesizer.Plain.Displacement as Syn
 import qualified Synthesizer.Plain.Control as Ctrl
 import qualified Synthesizer.Plain.Noise   as Noise
-import System.Random (Random, randomRs, mkStdGen, )
+import System.Random (randomRs, mkStdGen, )
 
 import qualified Algebra.Module    as Module
 import qualified Algebra.RealField as RealField
diff --git a/src/Synthesizer/Plain/Filter/Recursive/Butterworth.hs b/src/Synthesizer/Plain/Filter/Recursive/Butterworth.hs
--- a/src/Synthesizer/Plain/Filter/Recursive/Butterworth.hs
+++ b/src/Synthesizer/Plain/Filter/Recursive/Butterworth.hs
@@ -60,11 +60,11 @@
 
 
 
-partialParameterInstable, partialParameter :: (Trans.C a) =>
+partialLowpassParameterInstable, partialLowpassParameter :: (Trans.C a) =>
    a -> a -> a -> Filt2.Parameter a
 
 {- must handle infinite values when 'freq' approaches 0.5 -}
-partialParameterInstable ratio freq sinw =
+partialLowpassParameterInstable ratio freq sinw =
    let wc    = ratio * tan (pi*freq)
        sinw2 = 2 * wc * sinw
        wc2   = wc * wc
@@ -74,7 +74,7 @@
           (2*(1-wc2)/denom) ((-wc2+sinw2-1)/denom)
 
 -- using ratio disallows simplification by trigonometric Pythagoras' theorem
-partialParameter ratio freq =
+partialLowpassParameter ratio freq =
    let phi      = pi*freq
        rsin2phi = ratio * sin (2*phi)
        cosphi2  = cos phi ^ 2
@@ -104,11 +104,19 @@
    let sinesVec = SV.pack (makeSines order)
    in  \ (Pole ratio freq) ->
            Cascade.Parameter $
-           SV.map (\sinw ->
-              Filt2.adjustPassband kind
-                 (flip (partialParameter (partialRatio order ratio)) sinw) freq) $
+           SV.map
+              (\sinw ->
+                 partialParameter kind (partialRatio order ratio) sinw freq) $
            sinesVec
 
+partialParameter ::
+   Trans.C a =>
+   Passband -> a -> a -> a -> Filt2.Parameter a
+partialParameter kind partRatio sinw freq =
+   Filt2.adjustPassband kind
+      (flip (partialLowpassParameter partRatio) sinw)
+      freq
+
 {-# INLINE modifier #-}
 modifier ::
    (Ring.C a, Module.C a v, Storable a, Storable v) =>
@@ -155,15 +163,17 @@
 
 It uses the frequency and ratio information directly
 and thus cannot benefit from efficient parameter interpolation
-(asynchronous run of a ControlledProcess.
+(asynchronous run of a ControlledProcess).
 -}
 runPole :: (Trans.C a, Module.C a v) =>
    Passband -> Int -> Sig.T a -> Sig.T a -> Sig.T v -> Sig.T v
 runPole kind order ratios freqs =
    let makePartialFilter s =
-          Filt2.run (zipWith (\ratio ->
-             Filt2.adjustPassband kind $ \freq ->
-                partialParameter (partialRatio order ratio) freq s) ratios freqs)
+          Filt2.run $
+          zipWith
+             (\ratio freq ->
+                partialParameter kind (partialRatio order ratio) s freq)
+             ratios freqs
    in  foldl (.) id (map makePartialFilter (makeSines order))
 
 causalPole :: (Trans.C a, Module.C a v) =>
@@ -171,9 +181,10 @@
 causalPole kind order =
    let {-# INLINE makePartialFilter #-}
        makePartialFilter s =
-          Causal.first (Causal.map (\(Pole ratio freq) ->
-             Filt2.adjustPassband kind
-                (flip (partialParameter (partialRatio order ratio)) s) freq)) >>>
+          Causal.first
+             (Causal.map (\(Pole ratio freq) ->
+                partialParameter kind (partialRatio order ratio) s freq))
+          >>>
           Filt2.causal
    in  Causal.chainControlled $ map makePartialFilter $ makeSines order
 
diff --git a/src/Synthesizer/Plain/Filter/Recursive/Chebyshev.hs b/src/Synthesizer/Plain/Filter/Recursive/Chebyshev.hs
--- a/src/Synthesizer/Plain/Filter/Recursive/Chebyshev.hs
+++ b/src/Synthesizer/Plain/Filter/Recursive/Chebyshev.hs
@@ -24,6 +24,7 @@
 
 import qualified Algebra.Module                as Module
 import qualified Algebra.Transcendental        as Trans
+import qualified Algebra.Field                 as Field
 import qualified Algebra.Ring                  as Ring
 
 import Number.Complex (real, imag, cis, )
@@ -61,10 +62,10 @@
 for the Butterworth filter the quadratic factors of the polynomial can be determined
 more efficiently than the zeros.
 -}
-partialParameterA, partialParameterB :: (Trans.C a) =>
+partialLowpassParameterA, partialLowpassParameterB :: (Trans.C a) =>
    Int -> a -> a -> Complex.T a -> Filt2.Parameter a
 {-
-partialParameterA order ratio freq =
+partialLowpassParameterA order ratio freq =
    let {- if ratio == (sqrt 2) then the product of the normalization factors is
           2^(1-2*order) -}
 --       bn = asinh (ratio/sqrt(1-ratio^2)) / fromIntegral (2*order)
@@ -91,7 +92,7 @@
                  (-2*(cpims*cmims - resin2)/denom) ((cpims^2 + resin2)/denom)
 -}
 
-partialParameterA order ratio freq =
+partialLowpassParameterA order ratio freq =
    let {- if ratio == (sqrt 2) then the product of the normalization factors is
           2^(1-2*order) -}
 --       bn = asinh (ratio/sqrt(1-ratio^2)) / fromIntegral (2*order)
@@ -125,7 +126,7 @@
                  (-2*(cpims*cmims - resin2)/denom) ((cpims^2 + resin2)/denom)
 
 {-
-partialParameterA order ratio freq =
+partialLowpassParameterA order ratio freq =
    let {- if ratio == (sqrt 2) then the product of the normalization factors is
           2^(1-2*order) -}
        bn = asinh (ratio/sqrt(1-ratio^2)) / fromIntegral (2*order)
@@ -155,7 +156,7 @@
 -}
 
 {-
-partialParameterA order ratio freq =
+partialLowpassParameterA order ratio freq =
    let {- if ratio == (sqrt 2) then the product of the normalization factors is
           2^(1-2*order) -}
        bn = asinh (ratio/sqrt(1-ratio^2)) / fromIntegral (2*order)
@@ -185,7 +186,7 @@
 -}
 
 {-
-partialParameterB order ratio freq =
+partialLowpassParameterB order ratio freq =
    let -- bn = asinh (sqrt(1-ratio^2)/ratio) / fromIntegral (2*order)
        bn = (log(1+sqrt(1-ratio^2)) - log ratio) / fromIntegral (2*order)
        coshbn  = cosh bn
@@ -213,7 +214,7 @@
                  (-2*(spimc*smimc - recos2)/denom) (-(spimc^2 + recos2)/denom)
 -}
 
-partialParameterB order ratio freq =
+partialLowpassParameterB order ratio freq =
    let -- bn = asinh (sqrt(1-ratio^2)/ratio) / fromIntegral (2*order)
        bn = (log(1+sqrt(1-ratio^2)) - log ratio) / fromIntegral (2*order)
        coshbn  = cosh bn
@@ -244,6 +245,26 @@
 
 -- * use second order filter parameters for control
 
+{-# INLINE partialParameter #-}
+partialParameter ::
+   (Field.C a) =>
+   (a -> a -> Complex.T a -> Filt2.Parameter a) ->
+   Passband -> a -> Complex.T a -> a -> Filt2.Parameter a
+partialParameter lowpassParameter kind ratio c freq =
+   Filt2.adjustPassband kind
+      (flip (lowpassParameter ratio) c)
+      freq
+
+{-# INLINE partialParameterA #-}
+{-# INLINE partialParameterB #-}
+partialParameterA, partialParameterB ::
+   (Trans.C a) =>
+   Passband -> Int -> a -> Complex.T a -> a -> Filt2.Parameter a
+partialParameterA kind order =
+   partialParameter (partialLowpassParameterA order) kind
+partialParameterB kind order =
+   partialParameter (partialLowpassParameterB order) kind
+
 {-
 We could prevent definition of an extra parameter type
 by applying application to one of the filters using Filt2.amplify.
@@ -260,9 +281,7 @@
    in  \ (Pole ratio freq) ->
           (ratio,
            Cascade.Parameter $
-           SV.map (\c ->
-              Filt2.adjustPassband kind
-                 (flip (partialParameterA order ratio) c) freq) $
+           SV.map (\c -> partialParameterA kind order ratio c freq) $
            circleVec)
 
 {-# INLINE canonicalizeParameterA #-}
@@ -285,9 +304,7 @@
    let circleVec = SV.pack (makeCirclePoints order)
    in  \ (Pole ratio freq) ->
            Cascade.Parameter $
-           SV.map (\c ->
-              Filt2.adjustPassband kind
-                 (flip (partialParameterB order ratio) c) freq) $
+           SV.map (\c -> partialParameterB kind order ratio c freq) $
            circleVec
 
 {-
@@ -326,8 +343,7 @@
    let makePartialFilter c =
           Filt2.run
              (zipWith
-                 (\ratio -> Filt2.adjustPassband kind $
-                  \freq -> partialParameterA order ratio freq c)
+                 (\ratio freq -> partialParameterA kind order ratio c freq)
                  ratios freqs)
    in  foldl (.) (zipWith (*>) ratios)
           (map makePartialFilter (makeCirclePoints order))
@@ -336,8 +352,7 @@
    let makePartialFilter c =
           Filt2.run
              (zipWith
-                 (\ratio -> Filt2.adjustPassband kind $
-                  \freq -> partialParameterB order ratio freq c)
+                 (\ratio freq -> partialParameterB kind order ratio c freq)
                  ratios freqs)
    in  foldl (.) id (map makePartialFilter (makeCirclePoints order))
 
@@ -348,8 +363,7 @@
    let {-# INLINE makePartialFilter #-}
        makePartialFilter c =
           Causal.first (Causal.map (\(Pole ratio freq) ->
-             Filt2.adjustPassband kind
-             (flip (partialParameterA order ratio) c) freq)) >>>
+             partialParameterA kind order ratio c freq)) >>>
           Filt2.causal
    in  (\(p, y) -> (p, poleResonance p *> y)) ^>>
        (Causal.chainControlled $
@@ -360,8 +374,7 @@
    let {-# INLINE makePartialFilter #-}
        makePartialFilter c =
           Causal.first (Causal.map (\(Pole ratio freq) ->
-             Filt2.adjustPassband kind
-             (flip (partialParameterB order ratio) c) freq)) >>>
+             partialParameterB kind order ratio c freq)) >>>
           Filt2.causal
    in  Causal.chainControlled $
        map makePartialFilter $
diff --git a/src/Synthesizer/Plain/Filter/Recursive/FirstOrderComplex.hs b/src/Synthesizer/Plain/Filter/Recursive/FirstOrderComplex.hs
--- a/src/Synthesizer/Plain/Filter/Recursive/FirstOrderComplex.hs
+++ b/src/Synthesizer/Plain/Filter/Recursive/FirstOrderComplex.hs
@@ -11,6 +11,7 @@
 
 First order lowpass and highpass with complex valued feedback.
 The complex feedback allows resonance.
+It is often called complex resonator.
 -}
 module Synthesizer.Plain.Filter.Recursive.FirstOrderComplex (
    Parameter,
diff --git a/src/Synthesizer/Plain/Filter/Recursive/Universal.hs b/src/Synthesizer/Plain/Filter/Recursive/Universal.hs
--- a/src/Synthesizer/Plain/Filter/Recursive/Universal.hs
+++ b/src/Synthesizer/Plain/Filter/Recursive/Universal.hs
@@ -190,22 +190,57 @@
   by factor one and cancels the resonance frequency.
 -}
 {-# INLINE parameter #-}
-parameter :: Trans.C a => Pole a -> Parameter a
+parameter, parameterAlt, parameterOld :: Trans.C a => Pole a -> Parameter a
 parameter (Pole resonance frequency) =
-    let zr     = cos (2*pi*frequency)
-        zr1    = zr-1
-        q2     = resonance^2
-        sqrtQZ = sqrt (zr1*(-8*q2+zr1-4*q2*zr1))
-        pk1    = (-zr1+sqrtQZ) / (2*q2-zr1+sqrtQZ)
-        q21zr  = 4*q2*zr
-        a      = 2 * (zr1*zr1-q21zr*zr) / (zr1+q21zr+(1+2*zr1)*sqrtQZ)
-        pk2    = a+2-pk1
-        volHP  = (4-2*pk1-pk2) / 4
-        volLP  = pk2
-        volBP  = sqrt (volHP*volLP)
-    in  Parameter
-           (pk1*volHP/volBP)  (pk2*volHP/volLP)
-           volHP  (volBP/volHP)  (volLP/volBP)  (recip resonance)
+   let w      = sin (pi*frequency)
+       w2     = w^2
+       q2     = resonance^2
+       q21w2  = 4*q2*(1-w2)
+       sqrtQZ = w * sqrt (q21w2 + w2)
+       pk1    = (w2+sqrtQZ) / (q2+w2+sqrtQZ)
+       d      = (q21w2*w2 + w2^2 - q2)
+                  / (q21w2 - 2*q2 - w2 + (1-4*w2)*sqrtQZ)
+       volHP  = (2-pk1)/4 - d
+       volRel = sqrt ((2-pk1 + 4 * d) / volHP)
+   in  Parameter
+          (pk1/volRel)  volHP
+          volHP  volRel  volRel  (recip resonance)
+
+parameterAlt (Pole resonance frequency) =
+   let w      = sin (pi*frequency)
+       w2     = w^2
+       q2     = resonance^2
+       sqrtQZ = w * sqrt (4*q2 + w2 - 4*q2*w2)
+       pk1    = (w2+sqrtQZ) / (q2+w2+sqrtQZ)
+       zr     = 1 - 2 * w2
+       pk2    = 2-pk1 +
+                   4 * (w2^2-q2*zr^2) / (2*q2*zr-w2+(1-4*w2)*sqrtQZ)
+       volHP  = (4-2*pk1-pk2) / 4
+       volLP  = pk2
+       volBP  = sqrt (volHP*volLP)
+   in  Parameter
+          (pk1*volHP/volBP)  (pk2*volHP/volLP)
+          volHP  (volBP/volHP)  (volLP/volBP)  (recip resonance)
+
+{-
+This computation is more affected by cancelations
+for small frequencies, i.e. zr1 = cos eps - 1.
+-}
+parameterOld (Pole resonance frequency) =
+   let zr     = cos (2*pi*frequency)
+       zr1    = zr-1
+       q2     = resonance^2
+       sqrtQZ = sqrt (zr1*(-8*q2+zr1-4*q2*zr1))
+       pk1    = (-zr1+sqrtQZ) / (2*q2-zr1+sqrtQZ)
+       q21zr  = 4*q2*zr
+       a      = 2 * (zr1*zr1-q21zr*zr) / (zr1+q21zr+(1+2*zr1)*sqrtQZ)
+       pk2    = a+2-pk1
+       volHP  = (4-2*pk1-pk2) / 4
+       volLP  = pk2
+       volBP  = sqrt (volHP*volLP)
+   in  Parameter
+          (pk1*volHP/volBP)  (pk2*volHP/volLP)
+          volHP  (volBP/volHP)  (volLP/volBP)  (recip resonance)
 
 
 {-
diff --git a/src/Synthesizer/Plain/IO.hs b/src/Synthesizer/Plain/IO.hs
--- a/src/Synthesizer/Plain/IO.hs
+++ b/src/Synthesizer/Plain/IO.hs
@@ -18,7 +18,7 @@
 import Control.Exception (bracket, )
 import Control.Monad (liftM, )
 
-import Data.Monoid (Monoid, mconcat, )
+import Data.Monoid (mconcat, )
 
 import qualified Data.ByteString.Lazy as B
 import qualified Data.Binary.Builder as Builder
diff --git a/src/Synthesizer/Plain/Signal.hs b/src/Synthesizer/Plain/Signal.hs
--- a/src/Synthesizer/Plain/Signal.hs
+++ b/src/Synthesizer/Plain/Signal.hs
@@ -19,7 +19,7 @@
 import Data.Tuple.HT (forcePair, mapFst, mapSnd, )
 
 
-type T a = [a]
+type T = []
 
 
 {- * Generic routines that are useful for filters -}
diff --git a/src/Synthesizer/Plain/ToneModulation.hs b/src/Synthesizer/Plain/ToneModulation.hs
--- a/src/Synthesizer/Plain/ToneModulation.hs
+++ b/src/Synthesizer/Plain/ToneModulation.hs
@@ -120,10 +120,7 @@
        limits =
           if lower > upper
             then error "min>max"
-            else
-              (fromIntegral lower, fromIntegral upper)
-
-       arr = listArray (0, pred len) tone
+            else (fromIntegral lower, fromIntegral upper)
 
    in  Prototype {
           protoMarginLeap  = marginLeap,
@@ -132,7 +129,7 @@
           protoPeriod      = period,
           protoPeriodInt   = periodInt,
           protoShapeLimits = limits,
-          protoArray       = arr
+          protoArray       = listArray (0, pred len) tone
        }
 
 sampledToneCell :: (RealField.C t) =>
diff --git a/src/Synthesizer/State/Signal.hs b/src/Synthesizer/State/Signal.hs
--- a/src/Synthesizer/State/Signal.hs
+++ b/src/Synthesizer/State/Signal.hs
@@ -35,6 +35,7 @@
 
 import qualified Control.Applicative as App
 
+import Data.Foldable (Foldable, foldr, )
 import Data.Monoid (Monoid, mappend, mempty, )
 
 import qualified Synthesizer.Storable.Signal as SigSt
@@ -83,6 +84,9 @@
 
 instance Functor T where
    fmap g (Cons f s) = Cons (fmap g f) s
+
+instance Foldable T where
+   foldr = foldR
 
 instance App.Applicative T where
    pure = singleton
diff --git a/src/Synthesizer/State/ToneModulation.hs b/src/Synthesizer/State/ToneModulation.hs
--- a/src/Synthesizer/State/ToneModulation.hs
+++ b/src/Synthesizer/State/ToneModulation.hs
@@ -29,7 +29,10 @@
 
 type Cell sig y = SigS.T (sig y)
 
--- cells are organised in a transposed style, when compared with Plain.ToneModulation
+{- |
+cells are organised in a transposed style,
+when compared with Plain.ToneModulation
+-}
 {-# INLINE interpolateCell #-}
 interpolateCell ::
    (SigG.Read sig y) =>
@@ -70,8 +73,7 @@
        limits =
           if lower > upper
             then error "min>max"
-            else
-              (fromIntegral lower, fromIntegral upper)
+            else (fromIntegral lower, fromIntegral upper)
 
    in  Prototype {
           protoMarginLeap  = marginLeap,
diff --git a/src/Synthesizer/Utility.hs b/src/Synthesizer/Utility.hs
--- a/src/Synthesizer/Utility.hs
+++ b/src/Synthesizer/Utility.hs
@@ -2,6 +2,7 @@
 
 import qualified Algebra.Module    as Module
 import qualified Algebra.RealField as RealField
+import qualified Algebra.Ring      as Ring
 import qualified Algebra.Field     as Field
 
 import System.Random (Random, RandomGen, randomRs, )
@@ -43,9 +44,17 @@
 --   y /= 0 ==>
    fmod x y == fmodAlt x y
 
+{- |
+This one should be more precise than 'affineCombAlt' in floating computations
+whenever @x1@ is small and @x0@ is big.
+-}
 {-# INLINE affineComb #-}
 affineComb :: (Module.C t y) => t -> (y,y) -> y
-affineComb phase (x0,x1) = x0 + phase *> (x1-x0)
+affineComb phase (x0,x1) = (Ring.one-phase) *> x0 + phase *> x1
+
+affineCombAlt :: (Module.C t y) => t -> (y,y) -> y
+affineCombAlt phase (x0,x1) = x0 + phase *> (x1-x0)
+
 
 {-# INLINE balanceLevel #-}
 balanceLevel :: (Field.C y) =>
diff --git a/src/Synthesizer/Zip.hs b/src/Synthesizer/Zip.hs
--- a/src/Synthesizer/Zip.hs
+++ b/src/Synthesizer/Zip.hs
@@ -5,7 +5,7 @@
 import Data.Monoid (Monoid, mempty, mappend, )
 
 import qualified Control.Arrow as Arrow
-import Control.Arrow (Arrow, (^<<), (<<^), )
+import Control.Arrow (Arrow, (<<<), (^<<), (<<^), )
 
 
 {- |
@@ -93,6 +93,20 @@
    arrow a c -> arrow b d -> arrow (T a b) (T c d)
 arrowSplit x y =
    uncurry Cons  Arrow.^<<  x Arrow.*** y  Arrow.<<^  (\(Cons a b) -> (a,b))
+
+
+arrowFanoutShorten ::
+   (Arrow arrow, CutG.Transform a, CutG.Transform b, CutG.Transform c) =>
+   arrow a b -> arrow a c -> arrow a (T b c)
+arrowFanoutShorten a b =
+   arrowSplitShorten a b <<^ (\x -> Cons x x)
+
+arrowSplitShorten ::
+   (Arrow arrow,
+    CutG.Transform a, CutG.Transform b, CutG.Transform c, CutG.Transform d) =>
+   arrow a c -> arrow b d -> arrow (T a b) (T c d)
+arrowSplitShorten a b =
+   arrowFirstShorten a <<< arrowSecondShorten b
 
 
 instance (Monoid a, Monoid b) => Monoid (T a b) where
diff --git a/src/Test/Sound/Synthesizer/Plain/Analysis.hs b/src/Test/Sound/Synthesizer/Plain/Analysis.hs
--- a/src/Test/Sound/Synthesizer/Plain/Analysis.hs
+++ b/src/Test/Sound/Synthesizer/Plain/Analysis.hs
@@ -13,16 +13,12 @@
 
 import qualified MathObj.LaurentPolynomial as LPoly
 
--- import Algebra.Module((*>))
-
+import qualified Data.NonEmpty as NonEmpty
 import Data.List (genericLength)
 
 import Test.QuickCheck (quickCheck, Property, (==>))
 import Test.Utility (approxEqual)
 
--- import qualified Algebra.Ring                  as Ring
--- import qualified Algebra.Additive              as Additive
-
 import NumericPrelude.Numeric
 import NumericPrelude.Base
 import Prelude ()
@@ -32,27 +28,32 @@
 volumeVectorMaximum xs =
    Analysis.volumeVectorMaximum xs == Analysis.volumeMaximum xs
 
-volumeVectorEuclidean :: (NormedEuc.C y y, Algebraic.C y, Eq y) => y -> [y] -> Bool
-volumeVectorEuclidean x xs =
-   let ys = x:xs
+volumeVectorEuclidean ::
+   (NormedEuc.C y y, Algebraic.C y, Eq y) =>
+   NonEmpty.T [] y -> Bool
+volumeVectorEuclidean xs =
+   let ys = NonEmpty.flatten xs
    in  Analysis.volumeVectorEuclidean ys == Analysis.volumeEuclidean ys
 
-volumeVectorEuclideanSqr :: (NormedEuc.Sqr y y, Field.C y, Eq y) => y -> [y] -> Bool
-volumeVectorEuclideanSqr x xs =
-   let ys = x:xs
+volumeVectorEuclideanSqr ::
+   (NormedEuc.Sqr y y, Field.C y, Eq y) =>
+   NonEmpty.T [] y -> Bool
+volumeVectorEuclideanSqr xs =
+   let ys = NonEmpty.flatten xs
    in  Analysis.volumeVectorEuclideanSqr ys == Analysis.volumeEuclideanSqr ys
 
-volumeVectorSum :: (NormedSum.C y y, RealField.C y) => y -> [y] -> Bool
-volumeVectorSum x xs =
-   let ys = x:xs
+volumeVectorSum ::
+   (NormedSum.C y y, RealField.C y) =>
+   NonEmpty.T [] y -> Bool
+volumeVectorSum xs =
+   let ys = NonEmpty.flatten xs
    in  Analysis.volumeVectorSum ys == Analysis.volumeSum ys
 
 
 
-bounds :: Ord a => a -> [a] -> Bool
-bounds x xs =
-   let ys = x:xs
-   in  Analysis.bounds ys  ==  (minimum ys, maximum ys)
+bounds :: Ord a => NonEmpty.T [] a -> Bool
+bounds xs =
+   Analysis.bounds xs  ==  (NonEmpty.minimum xs, NonEmpty.maximum xs)
 
 
 spread :: RealField.C a => (a,a) -> Bool
@@ -60,45 +61,52 @@
    sum (map snd (Analysis.spread b)) == one
 
 
-histogramDiscrete :: Int -> [Int] -> Bool
-histogramDiscrete x xs =
-   let ys = x:xs
-   in  Analysis.histogramDiscreteArray ys ==
-       Analysis.histogramDiscreteIntMap ys
+histogramDiscrete :: NonEmpty.T [] Int -> Bool
+histogramDiscrete xs =
+   Analysis.histogramDiscreteArray xs ==
+   Analysis.histogramDiscreteIntMap xs
 
+withEmptyHistogram ::
+   (NonEmpty.T [] y -> (Int, [y])) ->
+   [y] -> (Int, [y])
+withEmptyHistogram f =
+   maybe (error "no bounds", []) f . NonEmpty.fetch
+
 histogramDiscreteLength :: [Int] -> Bool
 histogramDiscreteLength xs =
-   sum (snd (Analysis.histogramDiscreteIntMap xs)) == length xs
+   sum (snd (withEmptyHistogram Analysis.histogramDiscreteIntMap xs))
+   ==
+   length xs
 
 histogramDiscreteConcat :: [Int] -> [Int] -> Bool
 histogramDiscreteConcat xs ys =
-   let xHist = Analysis.histogramDiscreteIntMap xs
-       yHist = Analysis.histogramDiscreteIntMap ys
+   let xHist = withEmptyHistogram Analysis.histogramDiscreteIntMap xs
+       yHist = withEmptyHistogram Analysis.histogramDiscreteIntMap ys
        xyHist0 =
           LPoly.add
              (uncurry LPoly.Cons xHist)
              (uncurry LPoly.Cons yHist)
        xyHist1 =
           uncurry LPoly.Cons
-             (Analysis.histogramDiscreteIntMap (xs++ys))
+             (withEmptyHistogram Analysis.histogramDiscreteIntMap (xs++ys))
    in  if null (LPoly.coeffs xyHist0)
          then LPoly.coeffs xyHist0 == LPoly.coeffs xyHist1
          else xyHist0 == xyHist1
 
 
-histogramLinear :: Int -> [Int] -> Bool
-histogramLinear x xs =
-   let ys = map fromIntegral (x:xs) :: [Double]
+histogramLinear :: NonEmpty.T [] Int -> Bool
+histogramLinear xs =
+   let ys = fmap fromIntegral xs :: NonEmpty.T [] Double
    in  Analysis.histogramLinearArray ys ==
        Analysis.histogramLinearIntMap ys
 
 
-histogramLinearLength :: Int -> [Int] -> Bool
-histogramLinearLength x xs =
-   let ys = map fromIntegral (x:xs) :: [Double]
+histogramLinearLength :: NonEmpty.T [] Int -> Bool
+histogramLinearLength xs =
+   let ys = fmap fromIntegral xs :: NonEmpty.T [] Double
    in  approxEqual 1e-10
-          (genericLength ys)
-          (sum (snd (Analysis.histogramLinearIntMap ys)) + 1)
+          (genericLength $ NonEmpty.tail ys)
+          (sum (snd (Analysis.histogramLinearIntMap ys)))
 {-
 With eps = 1e-15
 
@@ -119,30 +127,34 @@
       Analysis.centroid xs == Analysis.centroidAlt xs
 -- Test.QuickCheck.quickCheck (\xs -> sum xs /= 0 Test.QuickCheck.==> propCentroid (xs::[Rational]))
 
-histogramDCOffset :: Int -> Int -> [Int] -> Property
-histogramDCOffset x0 x1 xs =
-   let x = x0:x1:xs
-       (offset, hist) = Analysis.histogramDiscreteArray x
+histogramDCOffset :: NonEmpty.T (NonEmpty.T []) Int -> Property
+histogramDCOffset xs =
+   let x1 = NonEmpty.flatten xs
+       x  = NonEmpty.flatten x1
+       (offset, hist) = Analysis.histogramDiscreteArray x1
    in  sum x /= 0 ==>
           fromIntegral offset + Analysis.centroid (map fromIntegral hist) ==
           (Analysis.directCurrentOffset (map fromIntegral x) :: Rational)
 
 
+small :: (Functor f) => f Int -> f Int
+small = fmap (flip mod 1000)
 
+
 tests :: [(String, IO ())]
 tests =
    ("volumeVectorMaximum", quickCheck (volumeVectorMaximum :: [Rational] -> Bool)) :
    -- quickCheck may fail due to rounding errors, but so far the computation is exactly the same
-   ("volumeVectorEuclidean", quickCheck (volumeVectorEuclidean :: Double -> [Double] -> Bool)) :
-   ("volumeVectorEuclideanSqr", quickCheck (volumeVectorEuclideanSqr :: Rational -> [Rational] -> Bool)) :
-   ("volumeVectorSum", quickCheck (volumeVectorSum :: Rational -> [Rational] -> Bool)) :
-   ("bounds", quickCheck (bounds :: Rational -> [Rational] -> Bool)) :
+   ("volumeVectorEuclidean", quickCheck (volumeVectorEuclidean :: NonEmpty.T [] Double -> Bool)) :
+   ("volumeVectorEuclideanSqr", quickCheck (volumeVectorEuclideanSqr :: NonEmpty.T [] Rational -> Bool)) :
+   ("volumeVectorSum", quickCheck (volumeVectorSum :: NonEmpty.T [] Rational -> Bool)) :
+   ("bounds", quickCheck (bounds :: NonEmpty.T [] Rational -> Bool)) :
    ("spread", quickCheck (spread :: (Rational,Rational) -> Bool)) :
-   ("histogramDiscrete", quickCheck (histogramDiscrete :: Int -> [Int] -> Bool)) :
-   ("histogramDiscreteLength", quickCheck (histogramDiscreteLength :: [Int] -> Bool)) :
-   ("histogramDiscreteConcat", quickCheck (histogramDiscreteConcat :: [Int] -> [Int] -> Bool)) :
-   ("histogramLinear", quickCheck (histogramLinear :: Int -> [Int] -> Bool)) :
-   ("histogramLinearLength", quickCheck (histogramLinearLength :: Int -> [Int] -> Bool)) :
+   ("histogramDiscrete", quickCheck (histogramDiscrete . small)) :
+   ("histogramDiscreteLength", quickCheck (histogramDiscreteLength . small)) :
+   ("histogramDiscreteConcat", quickCheck (\x y -> histogramDiscreteConcat (small x) (small y))) :
+   ("histogramLinear", quickCheck (histogramLinear . small)) :
+   ("histogramLinearLength", quickCheck (histogramLinearLength . small)) :
    ("centroid", quickCheck (centroid :: [Rational] -> Property)) :
-   ("histogramDCOffset", quickCheck (histogramDCOffset :: Int -> Int -> [Int] -> Property)) :
+   ("histogramDCOffset", quickCheck (histogramDCOffset . small)) :
    []
diff --git a/synthesizer-core.cabal b/synthesizer-core.cabal
--- a/synthesizer-core.cabal
+++ b/synthesizer-core.cabal
@@ -1,5 +1,5 @@
 Name:           synthesizer-core
-Version:        0.6
+Version:        0.7
 License:        GPL
 License-File:   LICENSE
 Author:         Henning Thielemann <haskell@henning-thielemann.de>
@@ -48,7 +48,7 @@
 
 
 Source-Repository this
-  Tag:         0.6
+  Tag:         0.7
   Type:        darcs
   Location:    http://code.haskell.org/synthesizer/core/
 
@@ -58,9 +58,10 @@
 
 Library
   Build-Depends:
-    sample-frame-np >=0.0.2 && <0.1,
+    sample-frame-np >=0.0.4 && <0.1,
     sox >=0.1 && <0.3,
     transformers >=0.2 && <0.4,
+    non-empty >=0.2 && <0.3,
     event-list >=0.1 && <0.2,
     non-negative >=0.1 && <0.2,
     explicit-exception >=0.1.6 && <0.2,
@@ -76,11 +77,11 @@
     storable-record >=0.0.1 && <0.1,
     storable-tuple >=0.0.1 && <0.1,
     QuickCheck >=1 && <3,
-    array >=0.1 && <0.5,
+    array >=0.1 && <0.6,
     containers >=0.1 && <0.6,
     random >=1.0 && <2.0,
-    process >=1.0 && <1.2,
-    base >= 4 && <6
+    process >=1.0 && <1.3,
+    base >= 4 && <5
 
   If impl(ghc>=7.0)
 -- also warns about NumericPrelude import:  -fwarn-missing-import-lists
@@ -106,6 +107,7 @@
     Synthesizer.Basic.Wave
     Synthesizer.Basic.WaveSmoothed
     Synthesizer.Interpolation
+    Synthesizer.Interpolation.Core
     Synthesizer.Interpolation.Class
     Synthesizer.Interpolation.Module
     Synthesizer.Interpolation.Custom
@@ -178,6 +180,7 @@
     Synthesizer.State.Signal
     Synthesizer.State.ToneModulation
     Synthesizer.Causal.Process
+    Synthesizer.Causal.Class
     Synthesizer.Causal.Arrow
     Synthesizer.Causal.Analysis
     Synthesizer.Causal.Cut
@@ -315,7 +318,7 @@
   If flag(splitBase)
     Build-Depends:
       old-time >= 1.0 && < 1.2,
-      directory >= 1.0 && < 1.2
+      directory >= 1.0 && < 1.3
 
 Executable speedtest-simple
   If !flag(buildProfilers)
