diff --git a/alsa/Synthesizer/LLVM/Server.hs b/alsa/Synthesizer/LLVM/Server.hs
--- a/alsa/Synthesizer/LLVM/Server.hs
+++ b/alsa/Synthesizer/LLVM/Server.hs
@@ -34,8 +34,12 @@
       151 -> ServerCausal.keyboardFM
       152 -> ServerCausal.keyboardDetuneFM
       153 -> ServerCausal.keyboardMultiChannel
-      154 -> ServerCausal.voder
+      154 -> ServerCausal.voderBand
       155 -> ServerCausal.formant
+      156 -> ServerCausal.voderMask
+      157 -> ServerCausal.voderMaskEnv
+      158 -> ServerCausal.voderMaskSeparated
+      159 -> ServerCausal.voderMaskMulti
       200 -> ServerScalarTest.pitchBend0
       201 -> ServerScalarTest.pitchBend1
       202 -> ServerScalarTest.pitchBend2
diff --git a/alsa/Synthesizer/LLVM/Server/CausalPacked/Run.hs b/alsa/Synthesizer/LLVM/Server/CausalPacked/Run.hs
--- a/alsa/Synthesizer/LLVM/Server/CausalPacked/Run.hs
+++ b/alsa/Synthesizer/LLVM/Server/CausalPacked/Run.hs
@@ -12,6 +12,8 @@
 import Synthesizer.LLVM.Server.Common
 
 import qualified Sound.ALSA.Sequencer.Event as Event
+import Sound.MIDI.ALSA.Query ()
+import Sound.MIDI.ALSA.Construct ()
 
 import qualified Synthesizer.MIDI.CausalIO.ControllerSet as MCS
 import qualified Synthesizer.MIDI.CausalIO.Process as MIO
@@ -32,7 +34,7 @@
 import qualified Sound.MIDI.Message.Channel.Voice as VoiceMsg
 import qualified Sound.MIDI.Message.Channel as ChannelMsg
 
-import Control.Arrow (Arrow, (<<<), (^<<), arr, )
+import Control.Arrow ((<<<), (^<<), arr, )
 import Control.Category (id, )
 
 import qualified Number.DimensionTerm as DN
@@ -106,26 +108,41 @@
 keyboardMultiChannel :: IO ()
 keyboardMultiChannel = do
    opt <- Option.get
-   proc <- keyboardDetuneFMCore opt
-   mix <- CausalP.processIO CausalP.mix
+   proc <- Arrange.keyboardMultiChannel (Option.sampleDirectory opt)
+   playFromEvents opt proc
 
+
+voderBand :: IO ()
+voderBand = do
+   opt <- Option.get
+   proc <-
+      Arrange.voderBand
+         (CausalP.mapSimple StereoInt.interleave)
+         (Option.sampleDirectory opt)
+
    playFromEvents opt $ \ sampleRate ->
       arr SigStL.unpackStereoStrict
       <<<
-      foldl1
-         (\x y -> mix () <<< Zip.arrowFanout x y)
-         (map
-             (\chan ->
-                proc (ChannelMsg.toChannel chan) (VoiceMsg.toProgram 0)
-                     sampleRate)
-             [0 .. 3])
+      proc (Option.channel opt) (VoiceMsg.toProgram 4) sampleRate
 
+voderMask :: IO ()
+voderMask = do
+   opt <- Option.get
+   proc <-
+      Arrange.voderMask
+         (CausalP.mapSimple StereoInt.interleave)
+         (Option.sampleDirectory opt)
 
-voder :: IO ()
-voder = do
+   playFromEvents opt $ \ sampleRate ->
+      arr SigStL.unpackStereoStrict
+      <<<
+      proc (Option.channel opt) (VoiceMsg.toProgram 4) sampleRate
+
+voderMaskEnv :: IO ()
+voderMaskEnv = do
    opt <- Option.get
    proc <-
-      Arrange.voder
+      Arrange.voderMaskEnv
          (CausalP.mapSimple StereoInt.interleave)
          (Option.sampleDirectory opt)
 
@@ -133,6 +150,27 @@
       arr SigStL.unpackStereoStrict
       <<<
       proc (Option.channel opt) (VoiceMsg.toProgram 4) sampleRate
+
+voderMaskSeparated :: IO ()
+voderMaskSeparated = do
+   opt <- Option.get
+   proc <-
+      Arrange.voderMaskSeparated
+         (CausalP.mapSimple StereoInt.interleave)
+         (Option.sampleDirectory opt)
+
+   playFromEvents opt $ \ sampleRate ->
+      arr SigStL.unpackStereoStrict
+      <<<
+      proc
+         (Option.channel opt) (Option.extraChannel opt)
+         (VoiceMsg.toProgram 4) sampleRate
+
+voderMaskMulti :: IO ()
+voderMaskMulti = do
+   opt <- Option.get
+   proc <- Arrange.voderMaskMulti $ Option.sampleDirectory opt
+   playFromEvents opt proc
 
 
 formant :: IO ()
diff --git a/alsa/Synthesizer/LLVM/Server/CausalPacked/Test.hs b/alsa/Synthesizer/LLVM/Server/CausalPacked/Test.hs
--- a/alsa/Synthesizer/LLVM/Server/CausalPacked/Test.hs
+++ b/alsa/Synthesizer/LLVM/Server/CausalPacked/Test.hs
@@ -1,5 +1,6 @@
 module Synthesizer.LLVM.Server.CausalPacked.Test where
 
+import qualified Synthesizer.LLVM.Server.CausalPacked.Speech as Speech
 import qualified Synthesizer.LLVM.Server.CausalPacked.InstrumentPlug as InstrFP
 import qualified Synthesizer.LLVM.Server.CausalPacked.Instrument as Instr
 import qualified Synthesizer.LLVM.Server.SampledSound as Sample
@@ -32,6 +33,7 @@
 import qualified Synthesizer.MIDI.PiecewiseConstant.ControllerSet as PCS
 import qualified Synthesizer.MIDI.CausalIO.ControllerSet as MCS
 import qualified Synthesizer.MIDI.CausalIO.Process as MIO
+import qualified Synthesizer.PiecewiseConstant.Signal as PC
 import qualified Synthesizer.CausalIO.Process as PIO
 
 import qualified Synthesizer.LLVM.CausalParameterized.FunctionalPlug as FP
@@ -56,7 +58,7 @@
 
 import Control.Arrow ((<<<), (<<^), (^<<), arr, first, )
 import Control.Category (id, )
-import Control.Applicative (pure, )
+import Control.Applicative (pure, liftA2, )
 import Control.Monad (when, )
 import Control.Monad.Trans.State (evalState, )
 
@@ -302,6 +304,17 @@
       map (ctrlEvent 0 1) [0..127]
 
 
+makeSampledSounds ::
+   Option.T ->
+   IO [SampleRate Real -> Real -> Real ->
+       PIO.T
+          (Zip.T MIO.GateChunk Instr.DetuneBendModControl)
+          Instr.StereoChunk]
+makeSampledSounds opt =
+   liftA2 map Instr.sampledSound $
+   Sample.loadRanges (Option.sampleDirectory opt) Sample.tomatensalat
+
+
 sampledSound :: IO ()
 sampledSound = do
    opt <- Option.get
@@ -310,8 +323,7 @@
       CausalP.processIO
          (CausalP.mapSimple StereoInt.interleave)
 
-   tomatoSmps <-
-      Instr.makeSampledSounds (Option.sampleDirectory opt) Sample.tomatensalat
+   tomatoSmps <- makeSampledSounds opt
 
    let tomato smp vel freq =
           smp sampleRate vel freq
@@ -336,19 +348,26 @@
       Just (100, VoiceMsg.normalVelocity) :
       replicate 4 Nothing
 
+loadTomato :: Option.T -> IO (SVL.Vector Real)
+loadTomato opt =
+   case Sample.tomatensalat of
+      Sample.Info name _sampleRate _positions ->
+         Sample.load (Option.sampleDirectory opt ++ "/" ++ name)
+
 sampledSoundMono :: IO ()
 sampledSoundMono = do
    opt <- Option.get
 
    case Sample.tomatensalat of
-      (name, positions, period) -> do
-         smp <- Sample.load (Option.sampleDirectory opt ++ "/" ++ name)
-         case Sample.parts (Sample.Cons smp (last positions) period) of
+      Sample.Info _name rate positions -> do
+         smp <- loadTomato opt
+         case Sample.parts (Sample.Cons smp (DN.frequency rate) (last positions)) of
             (_attack, _sustain, release) ->
                SVL.writeFile "/tmp/release.f32" release
 
    tomatoSmps <-
-      Instr.makeSampledSoundsMono (Option.sampleDirectory opt) Sample.tomatensalat
+      liftA2 map Instr.sampledSoundMono $
+      Sample.loadRanges (Option.sampleDirectory opt) Sample.tomatensalat
 
    let tomato smp vel freq =
           smp sampleRate vel freq
@@ -376,8 +395,7 @@
       CausalP.processIO
          (CausalP.mapSimple StereoInt.interleave)
 
-   tomatoSmps <-
-      Instr.makeSampledSounds (Option.sampleDirectory opt) Sample.tomatensalat
+   tomatoSmps <- makeSampledSounds opt
 
    let tomato smp vel freq =
           smp sampleRate vel freq
@@ -415,10 +433,7 @@
 frequencyModulation :: IO ()
 frequencyModulation = do
    opt <- Option.get
-   smp <-
-      case Sample.tomatensalat of
-         (name, _positions, _period) ->
-            Sample.load (Option.sampleDirectory opt ++ "/" ++ name)
+   smp <- loadTomato opt
 
    SVL.writeFile "/tmp/test.f32" .
       asMono .
@@ -431,10 +446,7 @@
 frequencyModulationIO :: IO ()
 frequencyModulationIO = do
    opt <- Option.get
-   smp <-
-      case Sample.tomatensalat of
-         (name, _positions, _period) ->
-            Sample.load (Option.sampleDirectory opt ++ "/" ++ name)
+   smp <- loadTomato opt
 
    proc <-
       CausalP.processIO
@@ -447,10 +459,7 @@
 frequencyModulationStrictIO :: IO ()
 frequencyModulationStrictIO = do
    opt <- Option.get
-   smp <-
-      case Sample.tomatensalat of
-         (name, _positions, _period) ->
-            Sample.load (Option.sampleDirectory opt ++ "/" ++ name)
+   smp <- loadTomato opt
 
    proc <-
       CausalP.processIO
@@ -475,10 +484,7 @@
 envelopeIO :: IO ()
 envelopeIO = do
    opt <- Option.get
-   smp <-
-      case Sample.tomatensalat of
-         (name, _positions, _period) ->
-            Sample.load (Option.sampleDirectory opt ++ "/" ++ name)
+   smp <- loadTomato opt
 
    proc <-
       CausalP.processIO
@@ -493,11 +499,9 @@
    phaser <-
       CausalP.processIO $ F.withArgs $ \ratio ->
          let freq = frequency id
-             noise =
-                F.lift $ CausalP.fromSignal $
-                SigP.noise 12 (recip freq)
+             noise = F.fromSignal $ SigP.noise 12 (recip freq)
          in  (1-ratio) * noise +
-             ratio * (CausalP.delay (pure (0::Float)) 100 F.$& noise)
+             ratio * (CausalP.delayZero 100 F.$& noise)
 
    writeTest
       (phaser (sampleRate, 200000) ::
@@ -514,7 +518,7 @@
              ratio = FP.plug ratio0
              noise = FP.fromSignal $ SigP.noise 12 (recip freq)
          in  (1-ratio) * noise +
-             ratio * (CausalP.delay (pure (0::Float)) 100 FP.$& noise)
+             ratio * (CausalP.delayZero 100 FP.$& noise)
 
    writeTest
       (phaser () (sampleRate, 200000) ::
@@ -536,44 +540,84 @@
    SigStL.makeUnpackGenericStrict
 -}
 
+functionalTineControl ::
+   Instr.WithEnvelopeControl
+      (Zip.T
+         (Zip.T (Instr.Control Real) (Instr.Control Real))
+         Instr.DetuneBendModControl)
+functionalTineControl =
+   let cs :: Num a => a
+       cs = 512
+   in  Zip.Cons
+          (Gate.chunk cs Nothing)
+          (Zip.Cons
+             (Zip.Cons
+                (EventListBT.singleton (DN.time 1) cs)
+                (EventListBT.singleton (DN.time 1) cs))
+             (Zip.Cons
+                (Zip.Cons
+                   (EventListBT.singleton 2 cs)
+                   (EventListBT.singleton 1 cs))
+                (Zip.Cons
+                   (EventListBT.singleton 0.001 cs)
+                   (EventListBT.singleton (BM.Cons 1 0.01) cs))))
+
 functionalTine :: IO ()
 functionalTine = do
    ping <- Instr.tineStereoFM
    unpack <- makeUnpackStereoStrict
-   let cs = 512
    writeTest (unpack <<< ping sampleRate 0 440) $
-      replicate 100 $
-      Zip.Cons
-         (Gate.chunk 512 Nothing)
-         (Zip.Cons
-            (Zip.Cons
-               (EventListBT.singleton (DN.time 1) cs)
-               (EventListBT.singleton (DN.time 1) cs))
-            (Zip.Cons
-               (Zip.Cons
-                  (EventListBT.singleton 2 cs)
-                  (EventListBT.singleton 1 cs))
-               (Zip.Cons
-                  (EventListBT.singleton 0.001 cs)
-                  (EventListBT.singleton (BM.Cons 1 0.01) cs))))
+      replicate 100 functionalTineControl
 
 functionalPlugTine :: IO ()
 functionalPlugTine = do
    ping <- InstrFP.tineStereoFM
    unpack <- makeUnpackStereoStrict
-   let cs = 512
    writeTest (unpack <<< ping sampleRate 0 440) $
-      replicate 100 $
-      Zip.Cons
-         (Gate.chunk 512 Nothing)
+      replicate 100 functionalTineControl
+
+
+stringControl ::
+   PC.ShortStrictTime ->
+   Instr.WithEnvelopeControl
+      (Zip.T (Instr.Control Real) Instr.DetuneBendModControl)
+stringControl cs =
+   Zip.Cons
+      (Gate.chunk (PC.longFromShortTime cs) Nothing)
+      (Zip.Cons
          (Zip.Cons
-            (Zip.Cons
-               (EventListBT.singleton (DN.time 1) cs)
-               (EventListBT.singleton (DN.time 1) cs))
+            (EventListBT.singleton (DN.time 0.5) cs)
+            (EventListBT.singleton (DN.time 1) cs))
+         (Zip.Cons
+            (EventListBT.singleton 10 cs)
             (Zip.Cons
-               (Zip.Cons
-                  (EventListBT.singleton 2 cs)
-                  (EventListBT.singleton 1 cs))
-               (Zip.Cons
-                  (EventListBT.singleton 0.001 cs)
-                  (EventListBT.singleton (BM.Cons 1 0.01) cs))))
+               (EventListBT.singleton 0.001 cs)
+               (EventListBT.singleton (BM.Cons 1 0) cs))))
+
+phonemeControl ::
+   PC.ShortStrictTime ->
+   (PC.ShortStrictTime -> ctrl) ->
+   Instr.WithEnvelopeControl ctrl
+phonemeControl cs ctrl =
+   Zip.Cons
+      (Gate.chunk (PC.longFromShortTime cs) Nothing)
+      (Zip.Cons
+         (Zip.Cons
+            (EventListBT.singleton (DN.time 0.5) cs)
+            (EventListBT.singleton (DN.time 0.02) cs))
+         (ctrl cs))
+
+speech :: IO ()
+speech = do
+   string <- Instr.softStringShapeFM
+   unpack <- makeUnpackStereoStrict
+   when False $
+      writeTest (unpack <<< string sampleRate 0 440) $
+         replicate 100 $ stringControl 512
+
+   phoneme <- Speech.phonemeMask
+   masks <- Speech.loadMasks Speech.maskNamesGrouped
+   writeTest
+      (unpack <<< phoneme masks sampleRate 0 (VoiceMsg.toPitch 64) <<<
+       Zip.arrowSecond (Zip.arrowSecond (string sampleRate 0 440))) $
+      replicate 100 $ phonemeControl 512 stringControl
diff --git a/alsa/Synthesizer/LLVM/Server/Packed/Run.hs b/alsa/Synthesizer/LLVM/Server/Packed/Run.hs
--- a/alsa/Synthesizer/LLVM/Server/Packed/Run.hs
+++ b/alsa/Synthesizer/LLVM/Server/Packed/Run.hs
@@ -26,7 +26,7 @@
 import qualified Synthesizer.LLVM.Storable.Signal as SigStL
 import qualified Synthesizer.LLVM.Wave as WaveL
 import Synthesizer.LLVM.CausalParameterized.Process (($<), ($*), )
-import Synthesizer.LLVM.Parameterized.Signal (($#), )
+import Synthesizer.LLVM.Parameter (($#), )
 
 import qualified Synthesizer.Storable.Signal as SigSt
 import qualified Data.StorableVector.Lazy as SVL
@@ -43,7 +43,7 @@
 
 import Synthesizer.ApplicativeUtility (liftA4, liftA5, liftA6, )
 import Control.Arrow ((<<<), (^<<), arr, )
-import Control.Applicative (pure, {- liftA, liftA2, -} liftA3, (<*>), )
+import Control.Applicative (pure, liftA2, liftA3, (<*>), )
 import Control.Monad.Trans.State (evalState, )
 
 import Control.Exception (bracket, )
@@ -230,11 +230,17 @@
    ben0 <- Instr.bellNoiseStereoFM
    flt0 <- Instr.filterSawStereoFM
    brs0 <- Instr.brass
-   tmt0 <- Instr.makeSampledSounds smpDir Sample.tomatensalat
-   hal0 <- Instr.makeSampledSounds smpDir Sample.hal
-   grp0 <- Instr.makeSampledSounds smpDir Sample.graphentheorie
 
+   syllables <-
+      liftA2 map Instr.sampledSound $
+      fmap concat $
+      mapM (Sample.loadRanges smpDir) $
+      Sample.tomatensalat :
+      Sample.hal :
+      Sample.graphentheorie :
+      []
 
+
    arrange <- SigStL.makeArranger
    amp <-
       CausalP.runStorableChunky
@@ -424,9 +430,7 @@
             (map (\sound fm -> sound fm $ sr) $
              [tnc, fnd, pngFM, flt, bel, ben, sqr, brs,
               ssh, fms, css, asn, atr, asq, asw, wnp] ++
-             map (.freqMod) tmt0 ++
-             map (.freqMod) hal0 ++
-             map (.freqMod) grp0 ++
+             map (.freqMod) syllables ++
              [str, wnd, png, rfm, tin, tnb])
 
 
@@ -455,7 +459,7 @@
 --      CausalPS.amplifyStereo 0.1 <<<
       CausalPS.pack
          (CausalP.stereoFromMonoControlled
-             (UniFilter.lowpass ^<< UniFilterL.causalP) $<
+             (UniFilter.lowpass ^<< UniFilterL.causal) $<
           (SigP.interpolateConstant $# (fromIntegral vectorSize :: Real))
              (piecewiseConstant (arr id)))
       <<<
diff --git a/alsa/Synthesizer/LLVM/Server/Packed/Test.hs b/alsa/Synthesizer/LLVM/Server/Packed/Test.hs
--- a/alsa/Synthesizer/LLVM/Server/Packed/Test.hs
+++ b/alsa/Synthesizer/LLVM/Server/Packed/Test.hs
@@ -52,6 +52,8 @@
 import qualified Algebra.Additive  as Additive
 -}
 
+import qualified Number.DimensionTerm as DN
+
 -- import NumericPrelude.Numeric (zero, round, (^?), )
 import Prelude hiding (Real, round, break, )
 
@@ -255,7 +257,7 @@
                 Sample.body smp
          in  SVP.take (chunkSizesFromLazyTime dur) $
              osc Option.defaultChunkSize
-                (sampleRate, (body, (fm, freq * Sample.period smp))))
+                (sampleRate, (body, (fm, freq * Sample.period pos))))
       (SigP.runChunky
          (let smp = signal fst
               fm = Instr.modulation snd
@@ -285,7 +287,7 @@
          let (sustainFM, releaseFM) =
                 SVP.splitAt (chunkSizesFromLazyTime dur) $
                 (SigSt.repeat Option.defaultChunkSize
-                   (Serial.fromList [freq*Sample.period smp/sampleRatePlain])
+                   (Serial.fromList [freq*Sample.period pos/sampleRatePlain])
                       :: SigSt.T Vector)
              pos = Sample.positions smp
              amp = 2 * amplitudeFromVelocity vel
@@ -328,7 +330,8 @@
                 SVP.splitAt (chunkSizesFromLazyTime dur) $
                 (freqMod
                    (chunkSizesFromLazyTime (PC.duration fm))
-                   (sampleRate, (fm, freq*Sample.period smp)) :: SigSt.T Vector)
+                   (sampleRate, (fm, freq*Sample.period pos)) :: SigSt.T Vector)
+             pos = Sample.positions smp
          in  SigSt.map
                 (\x -> Stereo.cons x x)
                 (sustainFM `SigSt.append` releaseFM))
@@ -353,7 +356,7 @@
                 SVP.splitAt (chunkSizesFromLazyTime dur) $
                 (freqMod
                    (chunkSizesFromLazyTime (PC.duration fm))
-                   (sampleRate, (fm, freq*Sample.period smp)) :: SigSt.T Vector)
+                   (sampleRate, (fm, freq*Sample.period pos)) :: SigSt.T Vector)
              pos = Sample.positions smp
              amp = 2 * amplitudeFromVelocity vel
              (attack, sustain, release) = Sample.parts smp
@@ -381,8 +384,9 @@
          let (sustainFM, releaseFM) =
                 SVP.splitAt (chunkSizesFromLazyTime dur) $
                 (SigSt.repeat Option.defaultChunkSize
-                   (Serial.fromList [freq*Sample.period smp/sampleRatePlain])
+                   (Serial.fromList [freq*Sample.period pos/sampleRatePlain])
                       :: SigSt.T Vector)
+             pos = Sample.positions smp
          in  osc () sustainFM
              `SigSt.append`
              SigSt.map (\x -> Stereo.cons x x) releaseFM)
@@ -398,7 +402,7 @@
       (\osc smp _fm _vel freq dur ->
          case SVP.splitAt (chunkSizesFromLazyTime dur) $
                 (SigSt.repeat Option.defaultChunkSize
-                   (Serial.fromList [freq*Sample.period smp/sampleRatePlain])
+                   (Serial.fromList [freq*Sample.period (Sample.positions smp) / sampleRatePlain])
                       :: SigSt.T Vector) of
             (sustainFM, releaseFM) ->
                osc () sustainFM
@@ -417,8 +421,9 @@
          let (sustainFM, releaseFM) =
                 SVP.splitAt (chunkSizesFromLazyTime dur) $
                 (SigSt.repeat Option.defaultChunkSize
-                   (Serial.fromList [freq*Sample.period smp/sampleRatePlain])
+                   (Serial.fromList [freq*Sample.period pos/sampleRatePlain])
                       :: SigSt.T Vector)
+             pos = Sample.positions smp
          in  SigSt.map (\x -> Stereo.cons x x) sustainFM
              `SigSt.append`
              SigSt.map (\x -> Stereo.cons x x) releaseFM)
@@ -437,8 +442,9 @@
          let (sustainFM, releaseFM) =
                 SVP.splitAt (chunkSizesFromLazyTime dur) $
                 (SigSt.repeat Option.defaultChunkSize
-                   (Serial.fromList [freq*Sample.period smp/sampleRatePlain])
+                   (Serial.fromList [freq*Sample.period pos/sampleRatePlain])
                       :: SigSt.T Vector)
+             pos = Sample.positions smp
          in  osc ()
                 (amplifySVL sustainFM
                  `SigSt.append`
@@ -456,8 +462,9 @@
          let (sustainFM, releaseFM) =
                 SVP.splitAt (chunkSizesFromLazyTime dur) $
                 (SigSt.repeat Option.defaultChunkSize
-                   (Serial.fromList [freq*Sample.period smp/sampleRatePlain])
+                   (Serial.fromList [freq*Sample.period pos/sampleRatePlain])
                       :: SigSt.T Vector)
+             pos = Sample.positions smp
          in  osc () sustainFM
              `SigSt.append`
              osc () releaseFM)
@@ -480,7 +487,7 @@
          let (sustainFM, releaseFM) =
                 SVP.splitAt (chunkSizesFromLazyTime dur) $
                 (SigSt.repeat Option.defaultChunkSize
-                   (Serial.fromList [freq*Sample.period smp/sampleRatePlain])
+                   (Serial.fromList [freq*Sample.period pos/sampleRatePlain])
                       :: SigSt.T Vector)
              pos = Sample.positions smp
              amp = 2 * amplitudeFromVelocity vel
@@ -495,16 +502,18 @@
       (CausalP.runStorableChunky
          (arr (\x -> Stereo.cons x x)))
 
-
+makeSample :: Int -> Sample.T
+makeSample size =
+   Sample.Cons
+      (SigSt.replicate Option.defaultChunkSize size 0)
+      (DN.frequency 44100)
+      (Sample.Positions 0 100000 50000 50000 100)
 
 sequenceSample :: IO ()
 sequenceSample = do
    arrange <- SigStL.makeArranger
    sampler <- sampledSoundTest2
-   let sound =
-          sampler (Sample.Cons (SigSt.replicate Option.defaultChunkSize 100000 0)
-                      (Sample.Positions 0 100000 50000 50000)
-                      100)
+   let sound = sampler $ makeSample 100000
    SVL.writeFile "test.f32" $
       arrange vectorChunkSize $
       evalState
@@ -547,10 +556,7 @@
 sequenceSample1 :: IO ()
 sequenceSample1 = do
    sampler <- sampledSoundSmallSpaceLeak4a
-   let sound =
-          sampler (Sample.Cons (SigSt.replicate Option.defaultChunkSize 100000 0)
-                      (Sample.Positions 0 100000 50000 50000)
-                      100)
+   let sound = sampler $ makeSample 100000
    SVL.writeFile "test.f32" $
       sound
          (let evs = EventListBT.cons (BM.Cons 0.01 0.001) 1 evs
@@ -594,10 +600,7 @@
 sequenceSample2 = do
    arrange <- SigStL.makeArranger
    sampler <- sampledSoundTest2
-   let sound =
-          sampler (Sample.Cons (SigSt.replicate Option.defaultChunkSize 100000 0)
-                      (Sample.Positions 0 100000 50000 50000)
-                      100)
+   let sound = sampler $ makeSample 100000
    SVL.writeFile "test.f32" $
       arrange vectorChunkSize $
       evalState
@@ -617,10 +620,7 @@
 sequenceSample3 = do
    arrange <- SigStL.makeArranger
    sampler <- sampledSoundTest2
-   let sound =
-          sampler (Sample.Cons (SigSt.replicate Option.defaultChunkSize 100000 0)
-                      (Sample.Positions 0 100000 50000 50000)
-                      100)
+   let sound = sampler $ makeSample 100000
    SVL.writeFile "test.f32" $
       arrange vectorChunkSize $
       evalState
@@ -635,10 +635,7 @@
    arrange <- SigStL.makeArranger
    sampler <- Instr.sampledSound
 --   sampler <- sampledSoundTest2
-   let sound =
-          sampler (Sample.Cons (SigSt.replicate Option.defaultChunkSize 100000 0)
-                      (Sample.Positions 0 100000 50000 50000)
-                      100)
+   let sound = sampler $ makeSample 100000
    SVL.writeFile "test.f32" $
       arrange vectorChunkSize $
       evalState
diff --git a/example/Synthesizer/LLVM/LAC2011.hs b/example/Synthesizer/LLVM/LAC2011.hs
--- a/example/Synthesizer/LLVM/LAC2011.hs
+++ b/example/Synthesizer/LLVM/LAC2011.hs
@@ -14,7 +14,9 @@
 import qualified Synthesizer.LLVM.CausalParameterized.Controlled as CtrlP
 import qualified Synthesizer.LLVM.CausalParameterized.ControlledPacked as CtrlPS
 import qualified Synthesizer.LLVM.CausalParameterized.ProcessPacked as CausalPS
+import qualified Synthesizer.LLVM.CausalParameterized.ProcessValue as CausalPV
 import qualified Synthesizer.LLVM.CausalParameterized.Process as CausalP
+import qualified Synthesizer.LLVM.Causal.ProcessValue as CausalV
 import qualified Synthesizer.LLVM.Causal.Process as Causal
 import qualified Synthesizer.LLVM.Simple.Signal as Gen
 import qualified Synthesizer.LLVM.Storable.Signal as SigStL
@@ -36,7 +38,7 @@
 import qualified Synthesizer.LLVM.Parameterized.SignalPacked as GenPS
 import qualified Synthesizer.LLVM.Parameterized.Signal as GenP
 import Synthesizer.LLVM.CausalParameterized.Process (($<), ($*), ($*#), )
-import Synthesizer.LLVM.Parameterized.Signal (($#), )
+import Synthesizer.LLVM.Parameter (($#), )
 
 import qualified Synthesizer.Plain.Filter.Recursive as FiltR
 import qualified Synthesizer.Plain.Filter.Recursive.FirstOrder as Filt1Core
@@ -250,7 +252,7 @@
 retard :: GenP.T p (Value Float) -> GenP.T p (Value Float)
 retard xs =
    CausalP.frequencyModulationLinear xs .
-   CausalP.mapSimple (A.fdiv (LLVM.valueOf 1)) $*
+   CausalV.map Field.recip $*
    GenP.rampCore (1 / secondP 10) 1
 
 playRetarded :: IO ()
@@ -265,11 +267,8 @@
    GenP.exponential2 (second 0.5) 0.7 *
    GenP.osciSimple Wave.triangle 0 (hertzP 440)
 
-zerop :: Param.T p Float
-zerop = pure zero
-
 delayp :: Param.T p Int -> CausalP.T p (Value Float) (Value Float)
-delayp = CausalP.delay zerop
+delayp = CausalP.delayZero
 
 delay :: IO ()
 delay =
@@ -284,7 +283,7 @@
 comb :: IO ()
 comb =
    playMonoParam $
-      (CausalP.loop zerop
+      (CausalP.loopZero
           (id  &&&  0.7 * delayp (intSecond 0.5)
              <<< CausalP.mix) $*
        pingGen)
@@ -294,7 +293,7 @@
    Param.T p Float ->
    GenP.T p (Moog.Parameter D8 (Value Float))
 lfoSine reduct =
-   CausalP.mapSimple (Moog.parameter d8 (valueOf (30::Float))) .
+   Causal.map (Moog.parameter d8 (valueOf (30::Float))) .
    CausalP.mapExponential 2 (hertz 700) $*
    GenP.osciSimple Wave.sine 0 (reduct * hertz 0.1)
 
diff --git a/example/Synthesizer/LLVM/LNdW2011.hs b/example/Synthesizer/LLVM/LNdW2011.hs
--- a/example/Synthesizer/LLVM/LNdW2011.hs
+++ b/example/Synthesizer/LLVM/LNdW2011.hs
@@ -52,7 +52,7 @@
 import qualified Synthesizer.LLVM.Parameterized.SignalPacked as GenPS
 import qualified Synthesizer.LLVM.Parameterized.Signal as GenP
 import Synthesizer.LLVM.CausalParameterized.Process (($<), ($*), ($*#), ($<#), )
-import Synthesizer.LLVM.Parameterized.Signal (($#), )
+import Synthesizer.LLVM.Parameter (($#), )
 
 import qualified Synthesizer.Plain.Filter.Recursive as FiltR
 import qualified Synthesizer.Plain.Filter.Recursive.FirstOrder as Filt1Core
@@ -259,7 +259,7 @@
       CausalP.processIO
          (0.95 * (CausalPS.osciSimple Wave.approxSine4 $< 0)
           .
-          CausalP.mapSimple Serial.upsample)
+          Causal.map Serial.upsample)
    playFromEvents 0.01 (vectorBlockSize/sampleRate)
       (arr SigStL.unpackStrict
        .
@@ -388,23 +388,20 @@
 that cannot be satisfied with @LLVM.Vector@s.
 -}
 moveAround2dLifted ::
-   (A.Transcendental v, A.PseudoModule v v,
+   (A.Transcendental v, v ~ A.Scalar v, A.PseudoModule v,
     A.Real v, A.RationalConstant v) =>
    Value.T v -> Value.T v -> (Value.T v, Value.T v) ->
    CausalP.T p (v, v) (v, v)
 moveAround2dLifted att sonicDelay ear =
-   CausalP.mapSimple
-      (uncurry (liftM2 (,)) .
-       mapPair (Value.decons, Value.decons) .
-       Spatial.moveAround att sonicDelay ear .
-       mapPair (Value.constantValue, Value.constantValue))
+   Causal.map
+      (uncurry $ Value.unlift2 $ curry $ Spatial.moveAround att sonicDelay ear)
 
 moveAround2d ::
    (A.Algebraic v, A.RationalConstant v) =>
    Value.T v -> Value.T v -> (Value.T v, Value.T v) ->
    CausalP.T p (v, v) (v, v)
 moveAround2d att sonicDelay ear =
-   CausalP.mapSimple $ Value.flattenFunction $
+   Causal.map $ Value.flattenFunction $
       (\dist -> (sonicDelay*dist, 1/(att+dist)^2)) .
       euclideanNorm2d . subtract ear
 
@@ -419,7 +416,7 @@
    (a -> b) ->
    CausalP.T p (Value.Registers a) (Value.Registers b)
 mapFunc f =
-   CausalP.mapSimple (Value.flattenFunction f)
+   Causal.map (Value.flattenFunction f)
 
 flyChannel ::
    (Value.T (Value Float), Value.T (Value Float)) ->
@@ -443,10 +440,10 @@
 fly :: IO ()
 fly = do
    let slow =
-          Filt1.lowpassCausalP $<#
+          Filt1.lowpassCausal $<#
           Filt1Core.parameter (1/sampleRate::Float)
    let fast =
-          Filt1.lowpassCausalP $<#
+          Filt1.lowpassCausal $<#
           Filt1Core.parameter (30/sampleRate::Float)
    proc <-
       CausalP.processIOCore
@@ -508,10 +505,10 @@
 flyPacked :: IO ()
 flyPacked = do
    let slow =
-          Filt1.lowpassCausalPackedP $<#
+          Filt1.lowpassCausalPacked $<#
           Filt1Core.parameter (1/sampleRate::Float)
    let fast =
-          Filt1.lowpassCausalPackedP $<#
+          Filt1.lowpassCausalPacked $<#
           Filt1Core.parameter (30/sampleRate::Float)
    proc <-
       CausalP.processIOCore
@@ -535,7 +532,7 @@
           >>>
           CausalP.envelopeStereo
           >>>
-          CausalP.mapSimple StereoInt.interleave)
+          Causal.map StereoInt.interleave)
          POut.storableVector
    playFromEvents 0.01 (vectorBlockSize/sampleRate)
       (arr SigStL.unpackStereoStrict
diff --git a/example/Synthesizer/LLVM/Test.hs b/example/Synthesizer/LLVM/Test.hs
--- a/example/Synthesizer/LLVM/Test.hs
+++ b/example/Synthesizer/LLVM/Test.hs
@@ -2,7 +2,7 @@
 module Main where
 
 import Synthesizer.LLVM.LAC2011 ()
-import qualified Synthesizer.LLVM.LNdW2011 as LNdW2011
+import Synthesizer.LLVM.LNdW2011 ()
 
 import qualified Synthesizer.LLVM.Filter.ComplexFirstOrderPacked as BandPass
 import qualified Synthesizer.LLVM.Filter.Allpass as Allpass
@@ -13,19 +13,29 @@
 import qualified Synthesizer.LLVM.Filter.SecondOrderPacked as Filt2P
 import qualified Synthesizer.LLVM.Filter.Moog as Moog
 import qualified Synthesizer.LLVM.Filter.Universal as UniFilter
+import qualified Synthesizer.LLVM.Filter.NonRecursive as FiltNR
 import qualified Synthesizer.LLVM.CausalParameterized.Controlled as CtrlP
 import qualified Synthesizer.LLVM.CausalParameterized.ControlledPacked as CtrlPS
 import qualified Synthesizer.LLVM.CausalParameterized.ProcessPacked as CausalPS
+import qualified Synthesizer.LLVM.CausalParameterized.ProcessValue as CausalPV
 import qualified Synthesizer.LLVM.CausalParameterized.Process as CausalP
 import qualified Synthesizer.LLVM.CausalParameterized.Functional as Func
+import qualified Synthesizer.LLVM.CausalParameterized.Helix as Helix
+import qualified Synthesizer.LLVM.Causal.ProcessValue as CausalV
 import qualified Synthesizer.LLVM.Causal.Process as Causal
+import qualified Synthesizer.LLVM.Interpolation as Interpolation
 import qualified Synthesizer.LLVM.Simple.Signal as Sig
 import qualified Synthesizer.LLVM.Storable.Signal as SigStL
-import qualified Synthesizer.LLVM.Frame as Frame
 import qualified Synthesizer.LLVM.Wave as Wave
-import qualified Synthesizer.LLVM.Frame.SerialVector as Serial
 import qualified Synthesizer.LLVM.Parameter as Param
 
+import qualified Synthesizer.LLVM.Server.SampledSound as Sample
+
+import qualified Synthesizer.LLVM.Frame.StereoInterleaved as StereoInt
+import qualified Synthesizer.LLVM.Frame.Stereo as Stereo
+import qualified Synthesizer.LLVM.Frame.SerialVector as Serial
+import qualified Synthesizer.LLVM.Frame as Frame
+
 import qualified LLVM.Extra.Memory as Memory
 import qualified LLVM.Extra.Arithmetic as A
 import LLVM.Core (Value, value, valueOf, Vector, constVector, constOf, )
@@ -36,20 +46,30 @@
 
 import qualified Synthesizer.LLVM.Parameterized.SignalPacked as SigPS
 import qualified Synthesizer.LLVM.Parameterized.Signal as SigP
-import Synthesizer.LLVM.CausalParameterized.Process (($<), ($*), ($*#), )
-import Synthesizer.LLVM.Parameterized.Signal (($#), )
+import Synthesizer.LLVM.CausalParameterized.Process (($*#), )
+import Synthesizer.LLVM.CausalParameterized.Functional (($&), (&|&), )
+import Synthesizer.LLVM.Simple.Value ((%>), )
+import Synthesizer.LLVM.Parameter (($#), )
 
+import qualified Synthesizer.CausalIO.Process as PIO
+import qualified Synthesizer.Zip as Zip
+import qualified Synthesizer.State.Control as CtrlS
+import qualified Synthesizer.State.Signal as SigS
+import Synthesizer.Causal.Class (($<), ($*), )
+
 import qualified Synthesizer.Plain.Filter.Recursive as FiltR
 import qualified Synthesizer.Plain.Filter.Recursive.FirstOrder as Filt1Core
 import qualified Synthesizer.Plain.Filter.Recursive.SecondOrder as Filt2Core
 
-import Control.Arrow (Arrow, arr, (&&&), (^<<), (***), )
+import Control.Arrow (Arrow, arr, (&&&), (^<<), (<<^), (***), )
 import Control.Category ((<<<), (.), id, )
 import Control.Applicative (pure, liftA2, )
 import Control.Functor.HT (void, )
+import Control.Monad (when, )
 
 import qualified Data.StorableVector.Lazy as SVL
 import qualified Data.StorableVector as SV
+import Foreign.Storable (Storable, )
 
 import qualified Data.EventList.Relative.TimeBody  as EventList
 import qualified Data.EventList.Relative.BodyTime  as EventListBT
@@ -61,18 +81,21 @@
 import qualified Sound.Sox.Play as SoxPlay
 -- import qualified Synthesizer.ALSA.Storable.Play as Play
 
-import qualified Synthesizer.LLVM.Frame.Stereo as Stereo
-import qualified Synthesizer.LLVM.Frame.StereoInterleaved as StereoInt
-
+import qualified Data.NonEmpty as NonEmpty
+import Data.NonEmpty ((!:), )
+import Data.Traversable (sequenceA, )
 import Data.Word (Word32, )
 -- import qualified Data.Function.HT as F
 import Data.List (genericLength, )
+import System.FilePath ((</>), )
 import System.Random (randomRs, mkStdGen, )
 
 import qualified System.IO as IO
+import Control.Exception (bracket, )
 -- import System.Exit (ExitCode, )
 
 import Prelude hiding (fst, snd, id, (.), )
+import qualified NumericPrelude.Numeric as NP
 import qualified Prelude as P
 
 
@@ -267,10 +290,9 @@
    SV.writeFile "speedtest-scalar.f32" $
    asMono $
    (\xs -> SigP.render xs 10000000 ()) $
-   (Filt1.lowpassCausalP
+   (Filt1.lowpassCausal
      $< (fmap Filt1Core.Parameter $
-         SigP.mapSimple (A.sub (valueOf 1))
-            (SigP.exponential2 50000 $# (1::Float)))
+         1 - (SigP.exponential2 50000 $# (1::Float)))
      $* SigP.osciSimple Wave.triangle 0 (frequency 0.01))
 
 pingSmoothPacked :: IO ()
@@ -278,11 +300,10 @@
    SV.writeFile "speedtest-vector.f32" $
    asMonoPacked $
    (\xs -> SigP.render xs (div 10000000 4) ()) $
-   (Filt1.lowpassCausalPackedP
+   (Filt1.lowpassCausalPacked
      $< (fmap Filt1Core.Parameter $
-         SigP.mapSimple (A.sub (valueOf 1))
-            (SigP.exponential2 (50000/4) $# (1::Float)))
-     $* SigPS.osciSimple Wave.triangle 0 0.01)
+         1 - (SigP.exponential2 (50000/4) $# (1::Float)))
+     $* SigPS.osciSimple Wave.triangle 0 (frequency 0.01))
 
 stereoOsciSaw :: Float -> Sig.T (Stereo.T (Value Float))
 stereoOsciSaw freq =
@@ -370,9 +391,9 @@
 
    foldl1 (Sig.zipWith Frame.mixStereoV) $
    -}
-   foldl1 Sig.mix $
-   map (\f -> stereoOsciSawPacked2 (base*f)) $
-   0.25 : 1.00 : 1.25 : 1.50 : []
+   NonEmpty.foldBalanced Sig.mix $
+   fmap (\f -> stereoOsciSawPacked2 (base*f)) $
+   0.25 !: 1.00 : 1.25 : 1.50 : []
 
 lazyChord :: IO ()
 lazyChord =
@@ -435,7 +456,7 @@
    SVL.take (div 10000000 16) $
    asMonoPacked16 $
    flip (SigP.renderChunky (SVL.chunkSize 10000)) () $
-   (Filt2.causalPackedP
+   (Filt2.causalPacked
       $< (SigP.constant $#
              Filt2Core.Parameter (1::Float) 0 0   0 0.99)
       $* (
@@ -489,7 +510,7 @@
    SVL.take (div 10000000 4) $
    asMonoPacked $
    flip (SigP.renderChunky (SVL.chunkSize 10000)) () $
-   (CausalPS.amplify 0.2 . Filt2.causalPackedP
+   (CausalPS.amplify 0.2 . Filt2.causalPacked
       $< (SigP.mapSimple (const $ Memory.load =<< LLVM.alloca) $
             (SigP.constant $# (0::Float)))
       $* SigPS.noise 0 0.3)
@@ -500,7 +521,7 @@
    SVL.take 10000000 $
    asMono $
    flip (SigP.renderChunky (SVL.chunkSize 10000)) () $
-   (0.2 * Filt2.causalP
+   (0.2 * Filt2.causal
       $< (SigP.mapSimple (const $
              (Memory.load =<< LLVM.alloca ::
                  LLVM.CodeGenFunction r (Filt2.Parameter (Value Float)))) $
@@ -556,15 +577,15 @@
 
 
 filterSweepMusic :: IO ()
-filterSweepMusic =
-   do music <- SV.readFile "lichter.f32"
-      SVL.writeFile "speedtest.f32" $
-         asStereo $
-         Sig.renderChunky (SVL.chunkSize 100000) $
-         Sig.amplifyStereo 20 $
-         filterSweepControlRateProc $
-         Sig.fromStorableVector $
-         (music :: SV.Vector (Stereo.T Float))
+filterSweepMusic = do
+   music <- SV.readFile "lichter.f32"
+   SVL.writeFile "speedtest.f32" $
+      asStereo $
+      Sig.renderChunky (SVL.chunkSize 100000) $
+      Sig.amplifyStereo 20 $
+      filterSweepControlRateProc $
+      Sig.fromStorableVector $
+      (music :: SV.Vector (Stereo.T Float))
 
 
 playFilterSweepMusicLazy :: IO ()
@@ -581,13 +602,13 @@
 
 playFilterSweepMusicCausal :: IO ()
 playFilterSweepMusicCausal = do
-   do music <- SV.readFile "lichter.f32"
-      _ <- SoxPlay.simple SV.hPut SoxOption.none 44100 $
-         asStereo $
-         Causal.applyStorable
-            (Causal.amplifyStereo 20 <<< filterSweepControlRateCausal) $
-         (music :: SV.Vector (Stereo.T Float))
-      return ()
+   music <- SV.readFile "lichter.f32"
+   _ <- SoxPlay.simple SV.hPut SoxOption.none 44100 $
+      asStereo $
+      Causal.applyStorable
+         (Causal.amplifyStereo 20 <<< filterSweepControlRateCausal) $
+      (music :: SV.Vector (Stereo.T Float))
+   return ()
 
 playFilterSweepMusicCausalLazy :: IO ()
 playFilterSweepMusicCausalLazy = do
@@ -599,6 +620,254 @@
        =<< SVL.hGetContentsAsync (SVL.chunkSize 43210) h
    return ()
 
+deinterleaveProc ::
+   IO (Float ->
+       PIO.T
+         (SV.Vector (StereoInt.T D4 Float))
+         (Zip.T
+            (SV.Vector (StereoInt.T D4 Float))
+            (SV.Vector (StereoInt.T D4 Float))))
+deinterleaveProc =
+   CausalP.processIO deinterleaveCausal
+
+deinterleaveCausal ::
+   CausalP.T Float
+      (StereoInt.Value D4 Float)
+      (StereoInt.Value D4 Float, StereoInt.Value D4 Float)
+deinterleaveCausal =
+   Func.withArgs $ \input ->
+      let env =
+             Func.fromSignal $
+                0.5 * (1 + SigPS.osciSimple (Wave.triangleSquarePower 4) 0 id)
+      in  (Causal.zipWith StereoInt.envelope $& env &|& input)
+          &|&
+          (Causal.zipWith StereoInt.envelope $& (1-env) &|& input)
+
+deinterleave :: IO ()
+deinterleave = do
+   proc <- deinterleaveProc
+   runSplitProcess (proc (2/44100))
+
+
+disturbProc, disturbFMProc ::
+   IO (PIO.T
+         (SV.Vector (StereoInt.T D4 Float))
+         (Zip.T
+            (SV.Vector (StereoInt.T D4 Float))
+            (SV.Vector (StereoInt.T D4 Float))))
+disturbProc =
+   fmap ($()) $ CausalP.processIO $ crossMix disturbCausal
+
+disturbCausal, disturbFMCausal ::
+   CausalP.T p (StereoInt.Value D4 Float) (StereoInt.Value D4 Float)
+disturbCausal =
+   Func.withArgs $ \inputInt ->
+      let tone =
+             Func.fromSignal $
+                SigPS.osciSimple Wave.triangle 0 (440/44100)
+          getEnvelope x =
+             Filt1.lowpassCausalPacked $&
+                (Func.fromSignal $
+                 (SigP.constant $# Filt1Core.parameter (1/44100::Float)))
+                &|&
+                (CausalV.map abs $& x)
+          envelopedTone x = getEnvelope x * tone
+      in  Causal.map StereoInt.interleave $&
+          CausalPS.amplifyStereo 5 $&
+          Stereo.liftApplicative envelopedTone
+             (Causal.map StereoInt.deinterleave $& inputInt)
+
+disturbFMProc =
+   fmap ($()) $ CausalP.processIO $ crossMix disturbFMCausal
+
+disturbFMCausal =
+   Func.withArgs $ \inputInt ->
+      let getEnvelope x =
+             Filt1.lowpassCausalPacked $&
+                (Func.fromSignal $
+                 (SigP.constant $# Filt1Core.parameter (1/44100::Float)))
+                &|&
+                (CausalV.map abs $& x)
+          modulatedTone x =
+             getEnvelope x *
+             (CausalPS.osciSimple Wave.triangle $&
+                NP.zero
+                &|&
+                10 *
+                getEnvelope
+                   ((CausalPS.differentiate $# (0 :: Float)) $& x))
+      in  Causal.map StereoInt.interleave $&
+          CausalPS.amplifyStereo 5 $&
+          Stereo.liftApplicative modulatedTone
+             (Causal.map StereoInt.deinterleave $& inputInt)
+
+disturb :: IO ()
+disturb =
+   runSplitProcess =<< disturbFMProc
+
+
+wowFlutterProc ::
+   IO (PIO.T
+         (SV.Vector (StereoInt.T D4 Float))
+         (Zip.T
+            (SV.Vector (StereoInt.T D4 Float))
+            (SV.Vector (StereoInt.T D4 Float))))
+wowFlutterProc =
+   fmap ($()) $ CausalP.processIO $ crossMix wowFlutterCausal
+
+wowFlutterCausal ::
+   CausalP.T p (StereoInt.Value D4 Float) (StereoInt.Value D4 Float)
+wowFlutterCausal =
+   Func.withArgs $ \inputInt ->
+      let freq =
+             Func.fromSignal $ (44100*) $
+                0.01 * (1 + SigPS.osciSimple Wave.triangle 0 (1/44100 :: Param.T p Float)) +
+                0.01 * (1 + SigPS.osciSimple Wave.approxSine2 0 (1.23/44100 :: Param.T p Float))
+          modulatedTone x =
+             CausalPS.pack
+                (CausalP.delayControlledInterpolated Interpolation.linear
+                    (0 :: Param.T p Float) (441*2*2+10))
+             $&
+             freq &|& x
+      in  Causal.map StereoInt.interleave $&
+          Stereo.liftApplicative modulatedTone
+             (Causal.map StereoInt.deinterleave $& inputInt)
+
+crossMix ::
+   CausalP.T p (StereoInt.Value D4 Float) (StereoInt.Value D4 Float) ->
+   CausalP.T p
+      (StereoInt.Value D4 Float)
+      (StereoInt.Value D4 Float, StereoInt.Value D4 Float)
+crossMix proc =
+   ((fst NP.+ snd)  &&&  (fst NP.- snd))
+   .
+   (id &&& proc)
+   .
+   Causal.map (StereoInt.amplify 0.5)
+
+
+wowFlutter :: IO ()
+wowFlutter =
+   runSplitProcess =<< wowFlutterProc
+
+
+
+scrambleProc0, scrambleProc1 ::
+   IO (Float ->
+       PIO.T
+         (SV.Vector (StereoInt.T D4 Float))
+         (Zip.T
+            (SV.Vector (StereoInt.T D4 Float))
+            (SV.Vector (StereoInt.T D4 Float))))
+scrambleProc0 =
+   CausalP.processIO $
+      deinterleaveCausal NP.+
+      (id &&& NP.negate id) .
+         Causal.map (StereoInt.amplify 0.5) . wowFlutterCausal
+
+scrambleProc1 =
+   CausalP.processIO $
+      deinterleaveCausal NP.+
+      (id &&& NP.negate id) .
+         Causal.map (StereoInt.amplify 0.3) .
+         (wowFlutterCausal NP.+ disturbFMCausal)
+
+scramble :: IO ()
+scramble = do
+   proc <- scrambleProc1
+   runSplitProcess (proc (2/44100))
+
+
+runSplitProcess ::
+   (Storable a) =>
+   PIO.T (SV.Vector a) (Zip.T (SV.Vector a) (SV.Vector a)) ->
+   IO ()
+runSplitProcess proc = do
+   void $
+      IO.withFile "/tmp/test.f32" IO.ReadMode $ \h ->
+      IO.withFile "/tmp/even.f32" IO.WriteMode $ \h0 ->
+      IO.withFile "/tmp/odd.f32"  IO.WriteMode $ \h1 ->
+
+      case proc of
+         PIO.Cons next create delete ->
+            {-
+            Is the use of 'bracket' correct?
+            I think 'delete' must be called with the final state,
+            not with the initial one.
+            -}
+            bracket create delete $
+               let chunkSize = 543210
+                   loop s0 = do
+                      chunk <- SV.hGet h chunkSize
+                      (Zip.Cons y0 y1, s1) <- next chunk s0
+                      SV.hPut h0 y0
+                      SV.hPut h1 y1
+                      when
+                         (SV.length y0 >= SV.length chunk &&
+                          SV.length y1 >= SV.length chunk &&
+                          SV.length chunk >= chunkSize)
+                         (loop s1)
+               in  loop
+
+
+antimixProc ::
+   IO (SVL.Vector (StereoInt.T D4 Float) ->
+       PIO.T
+         (SV.Vector (StereoInt.T D4 Float))
+         (Zip.T
+            (SV.Vector (StereoInt.T D4 Float))
+            (SV.Vector (StereoInt.T D4 Float))))
+antimixProc =
+   CausalP.processIO $ crossMix $
+      Causal.map (StereoInt.amplify 0.5) .
+      (CausalP.fromSignal $ SigP.fromStorableVectorLazy id)
+
+antimix :: IO ()
+antimix = do
+   proc <- antimixProc
+   void $
+      IO.withFile "/tmp/test.f32" IO.ReadMode $ \h ->
+      IO.withFile "/tmp/even.f32" IO.WriteMode $ \h0 ->
+      IO.withFile "/tmp/odd.f32"  IO.WriteMode $ \h1 -> do
+         let chunkSize = SVL.chunkSize 543210
+         input <- fmap snd $ SVL.hGetContentsAsync chunkSize h
+         let vectorSize = 4
+             additive = SVL.drop (div 44100 vectorSize) input
+{-
+             additive =
+                case SVL.splitAt (div 44100 vectorSize) input of
+                   (prefix, suffix) ->
+                      SVL.append suffix $
+                      SVL.replicate chunkSize (SVL.length prefix) StereoInt.zero
+-}
+{-
+             additive =
+                case SVL.splitAt (div 44100 vectorSize) input of
+                   (prefix, suffix) -> SVL.append suffix prefix
+-}
+
+         case proc additive of
+            PIO.Cons next create delete ->
+               {-
+               Is the use of 'bracket' correct?
+               I think 'delete' must be called with the final state,
+               not with the initial one.
+               -}
+               bracket create delete $ \state ->
+                  let loop cs0 s0 =
+                         case cs0 of
+                            [] -> return ()
+                            c : cs -> do
+                               (Zip.Cons y0 y1, s1) <- next c s0
+                               SV.hPut h0 y0
+                               SV.hPut h1 y1
+                               when
+                                  (SV.length y0 >= SV.length c &&
+                                   SV.length y1 >= SV.length c)
+                                  (loop cs s1)
+                  in  loop (SVL.chunks input) state
+
+
 arrangeLazy :: IO ()
 arrangeLazy = do
    IO.hSetBuffering IO.stdout IO.NoBuffering
@@ -820,7 +1089,7 @@
    playMonoVector $
       CausalP.applyStorableChunky
          (CausalP.amplify id <<<
-          CausalP.comb 0.5 7000)
+          CausalP.comb (0.5 :: Param.T p Float) 7000)
          (0.2::Float) sig
    return ()
 
@@ -834,18 +1103,31 @@
          (0.3::Float) sig
    return ()
 
+vibesReverbEfficient :: IO ()
+vibesReverbEfficient = do
+   sig <- vibesCycleVector =<< makeVibes
+   playMonoVector $
+      CausalP.applyStorableChunky
+         (CausalP.amplify id <<<
+          (CausalP.reverbEfficient $# mkStdGen 142 $# 16 $# (0.9,0.97) $# (400,1000)))
+         (0.3::Float) sig
+   return ()
+
 vibesReverbStereo :: IO ()
 vibesReverbStereo = do
    sig <- vibesCycleVector =<< makeVibes
-   playStereoVector $
+   void $ playStereoVector $
       CausalP.applyStorableChunky
-         (CausalP.amplifyStereo id <<<
-          CausalP.stereoFromChannels
-             (CausalP.reverb (mkStdGen 142) 16 (0.9,0.97) (400,1000))
-             (CausalP.reverb (mkStdGen 857) 16 (0.9,0.97) (400,1000)) <<<
-          CausalP.mapSimple Frame.stereoFromMono)
+         (CausalP.stereoFromMonoParameterized
+             (\amp seed ->
+                CausalP.amplify amp
+                <<<
+                CausalP.reverbEfficient (fmap mkStdGen seed)
+                   16 (pure (0.9,0.97)) (pure (400,1000)))
+             (pure $ Stereo.cons 142 857)
+          <<^
+          (\x -> Stereo.cons x x))
          (0.3::Float) sig
-   return ()
 
 
 
@@ -864,27 +1146,26 @@
 
 
 filterBass :: IO ()
-filterBass = do
+filterBass =
+   void $
    playStereoVector $
       asStereo $
       flip (SigP.renderChunky tonesChunkSize) () $
       CausalP.apply
-         (BandPass.causalP
+         (BandPass.causal
           <<<
           CausalP.feedSnd
              (liftA2 Stereo.cons
                  (SigP.osciSimple Wave.saw 0 (frequency 0.001499))
                  (SigP.osciSimple Wave.saw 0 (frequency 0.001501)))
           <<<
-          CausalP.mapSimple (BandPass.parameter (valueOf (100::Float)))) $
+          Causal.map (BandPass.parameter (valueOf (100::Float)))) $
       SigP.piecewiseConstant $
       return $ EventListBT.fromPairList $
       zip
-         (map (((0.03::Float)*) . (2**) . (/12) . fromInteger) $
-          randomRs (0,12) (mkStdGen 998))
-         (repeat (10000::NonNeg.Int))
-
-   return ()
+         (map (((0.01::Float)*) . (2**) . (/12) . fromInteger) $
+          randomRs (0,24) (mkStdGen 998))
+         (repeat (6300::NonNeg.Int))
 
 
 {- |
@@ -930,8 +1211,7 @@
    SVL.Vector (Stereo.T Float)
 mixVectorStereo =
    CausalP.applyStorableChunky
-      (CausalP.mix $<
-       SigP.fromStorableVectorLazy id)
+      (CausalP.mix $< SigP.fromStorableVectorLazy id)
 
 mixVectorStereoIO ::
    IO (SVL.Vector (Stereo.T Float) ->
@@ -939,8 +1219,7 @@
        SVL.Vector (Stereo.T Float))
 mixVectorStereoIO =
    CausalP.runStorableChunky
-      (CausalP.mix $<
-       SigP.fromStorableVectorLazy id)
+      (CausalP.mix $< SigP.fromStorableVectorLazy id)
 
 {-
 slightly slower than mixVectorParam
@@ -988,34 +1267,64 @@
 
 stereoOsciSawP :: SigP.T Float (Stereo.T (Value Float))
 stereoOsciSawP =
-   let freq = id
-       n = 5
-       volume = pure $ recip $ sqrt $ fromIntegral n :: Param.T p Float
+   let n = 5
+       volume :: Float
+       volume = recip $ sqrt $ fromIntegral n
+       detunes :: [Float]
        detunes =
           normalizeLevel 1 $ take (2*n) $
              randomRs (0,0.03) $ mkStdGen 912
-       phases =
-          randomRs (0,1) $ mkStdGen 54
-       tones =
-          zipWith
-             (\phase detune ->
-                 (SigP.osciSaw $# phase) (fmap (detune*) freq))
-             phases detunes
-       (tonesLeft,tonesRight) = splitAt n tones
-   in  SigP.amplifyStereo volume $
-       liftA2 Stereo.cons
-          (foldl1 SigP.mix tonesLeft)
-          (foldl1 SigP.mix tonesRight)
+       phases :: [Float]
+       phases = randomRs (0,1) $ mkStdGen 54
+   in  stereoFromMonoParameterizedSignal
+          (\_ params ->
+              (SigP.amplify $# volume) $
+              multiMixSignal
+                 (\_ phaseFreq ->
+                     SigP.osciSaw
+                        (fmap fst phaseFreq)
+                        (fmap snd phaseFreq))
+                 params)
+          (arr
+              (\freq ->
+                 uncurry Stereo.cons $ splitAt n $
+                 zipWith
+                    (\phase detune -> (phase, detune*freq))
+                    phases detunes))
 
+stereoFromMonoParameterizedSignal ::
+   (forall q. Param.T q p -> Param.T q x -> SigP.T q (Value Float)) ->
+   Param.T p (Stereo.T x) -> SigP.T p (Stereo.T (Value Float))
+stereoFromMonoParameterizedSignal f ps =
+   CausalP.toSignal $
+      CausalP.stereoFromMonoParameterized (\p -> CausalP.fromSignal . f p) ps
+      <<^
+      (\() -> Stereo.cons () ())
+
+multiMixSignal ::
+   (forall q. Param.T q p -> Param.T q x -> SigP.T q (Value Float)) ->
+   Param.T p [x] -> SigP.T p (Value Float)
+multiMixSignal f =
+   CausalP.toSignal . multiMix (\p x -> CausalP.fromSignal $ f p x)
+
+multiMix ::
+   (forall q. Param.T q p -> Param.T q x -> CausalP.T q a (Value Float)) ->
+   Param.T p [x] -> CausalP.T p a (Value Float)
+multiMix f ps =
+   CausalP.replicateControlledParam
+      (\p x -> CausalP.mix <<< CausalP.first (f p x)) ps
+   <<^
+   (\a -> (a, A.zero))
+
 stereoOsciSawVector :: Float -> SVL.Vector (Stereo.T Float)
 stereoOsciSawVector =
    SigP.renderChunky tonesChunkSize stereoOsciSawP
 
-stereoOsciSawChord :: [Float] -> SVL.Vector (Stereo.T Float)
+stereoOsciSawChord :: NonEmpty.T [] Float -> SVL.Vector (Stereo.T Float)
 stereoOsciSawChord =
-   foldl1 mixVectorStereo . map stereoOsciSawVector
+   NonEmpty.foldBalanced mixVectorStereo . fmap stereoOsciSawVector
 
-stereoOsciSawPad :: Int -> [Float] -> SVL.Vector (Stereo.T Float)
+stereoOsciSawPad :: Int -> NonEmpty.T [] Float -> SVL.Vector (Stereo.T Float)
 stereoOsciSawPad dur pitches =
    let attack = 20000
    in  CausalP.applyStorableChunky
@@ -1034,27 +1343,27 @@
   iterate ((2 ** recip 12) *) (55/44100)
 
 
-chordSequence :: [(Int, [Float])]
+chordSequence :: [(Int, NonEmpty.T [] Float)]
 chordSequence =
-   (2, [f1,  f2,  a2, c3]) :
-   (1, [g1,  g2,  b2, d3]) :
-   (2, [c2,  g2,  c3, e3]) :
-   (1, [f1,  a2,  c3, f3]) :
-   (2, [g1,  g2,  b2, d3]) :
-   (1, [gs1, gs2, b2, e3]) :
-   (2, [a1,  e2,  a2, c3]) :
-   (1, [g1,  g2,  b2, d3]) :
-   (3, [c2,  g2,  c3, e3]) :
+   (2, f1  !: f2  : a2 : c3 : []) :
+   (1, g1  !: g2  : b2 : d3 : []) :
+   (2, c2  !: g2  : c3 : e3 : []) :
+   (1, f1  !: a2  : c3 : f3 : []) :
+   (2, g1  !: g2  : b2 : d3 : []) :
+   (1, gs1 !: gs2 : b2 : e3 : []) :
+   (2, a1  !: e2  : a2 : c3 : []) :
+   (1, g1  !: g2  : b2 : d3 : []) :
+   (3, c2  !: g2  : c3 : e3 : []) :
 
-   (2, [f1,  f2,  a2, c3]) :
-   (1, [g1,  g2,  b2, d3]) :
-   (2, [c2,  g2,  c3, e3]) :
-   (1, [f1,  a2,  c3, f3]) :
-   (2, [g1,  g2,  b2, d3]) :
-   (1, [gs1, gs2, b2, e3]) :
-   (2, [a1,  e2,  a2, c3]) :
-   (1, [g1,  g2,  b2, e3]) :
-   (3, [c2,  e2,  g2, c3]) :
+   (2, f1  !: f2  : a2 : c3 : []) :
+   (1, g1  !: g2  : b2 : d3 : []) :
+   (2, c2  !: g2  : c3 : e3 : []) :
+   (1, f1  !: a2  : c3 : f3 : []) :
+   (2, g1  !: g2  : b2 : d3 : []) :
+   (1, gs1 !: gs2 : b2 : e3 : []) :
+   (2, a1  !: e2  : a2 : c3 : []) :
+   (1, g1  !: g2  : b2 : e3 : []) :
+   (3, c2  !: e2  : g2 : c3 : []) :
    []
 
 
@@ -1104,7 +1413,8 @@
 filterMusic :: IO ()
 filterMusic = do
    arrange <- SigStL.makeArranger
-   playStereoVector $
+   pad <- stereoOsciSawPadIO
+   void $ playStereoVector $
       CausalP.applyStorableChunky
          (CausalP.amplifyStereo id <<<
           moogSweepControlRateCausal) (0.05::Float) $
@@ -1112,9 +1422,8 @@
       EventListTM.switchTimeR const $
       EventListMT.consTime 0 $
       EventListBT.fromPairList $
-      map (\(d,ps) -> withDur stereoOsciSawPad d ps)
+      map (\(d,ps) -> withDur pad d ps)
       chordSequence
-   return ()
 
 
 
@@ -1134,13 +1443,14 @@
       (CausalP.runStorableChunky
          (CausalP.envelopeStereo $< fadeEnvelope))
 
-stereoOsciSawChordIO :: IO ([Float] -> SVL.Vector (Stereo.T Float))
+stereoOsciSawChordIO :: IO (NonEmpty.T [] Float -> SVL.Vector (Stereo.T Float))
 stereoOsciSawChordIO = do
    sawv <- stereoOsciSawVectorIO
    mix <- mixVectorStereoIO
-   return (foldl1 mix . map sawv)
+   return (NonEmpty.foldBalanced mix . fmap sawv)
 
-stereoOsciSawPadIO :: IO (Int -> [Float] -> SVL.Vector (Stereo.T Float))
+stereoOsciSawPadIO ::
+   IO (Int -> NonEmpty.T [] Float -> SVL.Vector (Stereo.T Float))
 stereoOsciSawPadIO = do
    chrd <- stereoOsciSawChordIO
    envelope <- applyFadeEnvelopeIO
@@ -1177,7 +1487,8 @@
       EventListTM.switchTimeR const $
       EventListMT.consTime 0 $
       EventListBT.fromPairList $
-      map (uncurry (withDur (\d ps -> map (\p -> env d (osci p)) ps))) $
+      map (uncurry (withDur (\d ps ->
+         map (\p -> env d (osci p)) $ NonEmpty.flatten ps))) $
       chordSequence
    return ()
 
@@ -1187,25 +1498,39 @@
    SVL.writeFile "speedtest.f32" $
    asMono $
    flip (SigP.renderChunky tonesChunkSize) (0, 10000) $
-   CausalP.apply
-      ((CausalP.delay $# (0::Float)) fst
-          <<< CausalP.take snd) $
-   SigP.osciSaw 0 (frequency 0.01)
+   (CausalP.delayZero fst . CausalP.take snd
+    $*
+    SigP.osciSaw 0 (frequency 0.01))
 
 delayStereo :: IO ()
 delayStereo =
    SVL.writeFile "speedtest.f32" $
    asStereo $
    flip (SigP.renderChunky tonesChunkSize) (7, 10000) $
-   CausalP.apply
-      (CausalP.take snd
-       <<<
-       liftA2 Stereo.cons
-          id ((CausalP.delay $# (0::Float)) fst)) $
-   SigP.osciSaw 0 (frequency 0.01)
+   (CausalP.take snd . liftA2 Stereo.cons id (CausalP.delayZero fst)
+    $*
+    SigP.osciSaw 0 (frequency 0.01))
 
+delayPhaser :: IO ()
+delayPhaser =
+   SVL.writeFile "speedtest.f32" $
+   asStereo $
+   flip (SigP.renderChunky tonesChunkSize) 40000 $
+   Func.compileSignal $
+      let osci = Func.fromSignal $ SigP.osciSaw 0 (frequency 0.01)
+          ctrl =
+             Func.fromSignal $
+             SigP.osciSimple Wave.triangle 0 $ frequency (1/20000)
+      in  CausalP.take id $&
+          liftA2 Stereo.cons
+             osci
+             (CausalP.delayControlledInterpolated Interpolation.cubic
+                 (0 :: Param.T p Float) 100
+              $&
+              (50+50*ctrl) &|& osci)
 
 
+
 allpassControl ::
    (TypeNum.NaturalT n) =>
    n ->
@@ -1220,19 +1545,15 @@
    SigP.T Float (Value Float)
 allpassPhaserCausal =
    let order = TypeNum.d16
-   in  CausalP.apply $
-       0.5 *
-       Allpass.phaserP <<<
-       CausalP.feedFst (allpassControl order)
+   in  CausalP.apply
+          (0.5 * Allpass.phaser $< allpassControl order)
 
 allpassPhaserPipeline =
    let order = TypeNum.d16
    in  -- (F.nest (TypeNum.fromIntegerT order) SigP.tail .) $
-       (SigP.drop (return $ TypeNum.fromIntegerT order) .) $
-       CausalP.apply $
-       0.5 *
-       Allpass.phaserPipelineP <<<
-       CausalP.feedFst (allpassControl order)
+       SigP.drop (return $ TypeNum.fromIntegerT order) .
+       CausalP.apply
+          (0.5 * Allpass.phaserPipeline $< allpassControl order)
 
 allpassPhaser :: IO ()
 allpassPhaser =
@@ -1335,9 +1656,9 @@
    CausalP.apply (0.3 * (UniFilter.lowpass ^<< CtrlP.process)) $
    SigP.zip
       ((CausalP.quantizeLift $# (128::Float))
-         (CausalP.mapSimple (UniFilter.parameter (valueOf 100)) <<<
---         (CausalP.mapSimple (Moog.parameter TypeNum.d8 (valueOf 100)) <<<
-          CausalP.mapSimple (\x -> 0.01 * exp (2 * return x)))
+         (Causal.map (UniFilter.parameter (valueOf 100)) <<<
+--         (Causal.map (Moog.parameter TypeNum.d8 (valueOf 100)) <<<
+          CausalV.map (\x -> 0.01 * exp (2 * x)))
          $* SigP.osciSimple Wave.approxSine2 0 (frequency (0.1/44100))) $
    SigP.osciSaw 0 (frequency 0.01)
 
@@ -1371,12 +1692,243 @@
    (let osci = CausalP.osciSimple Wave.approxSine2
     in  Func.compile
           (fmap (uncurry Stereo.cons)  $
-           osci *** osci  Func.$&
+           osci *** osci  $&
            Func.lift id) $*
         SigP.constant (return ((0::Float, 0.01::Float), (0.25::Float, 0.01001::Float))))
 
 
+rampDown :: Int -> SV.Vector Float
+rampDown n =
+   SigS.toStrictStorableSignal n $
+   CtrlS.line n (1, 0)
+
+impulses :: Int -> Float -> SVL.Vector Float
+impulses n x =
+   SVL.fromChunks $
+   concatMap (\k -> [SV.singleton x, SV.replicate k 0]) $
+   take n $ iterate (2*) 1
+
+convolution :: IO ()
+convolution =
+   SVL.writeFile "speedtest.f32" $
+   asMono $
+   CausalP.applyStorableChunky
+      (FiltNR.convolve id)
+      (rampDown 1000)
+      (impulses 18 0.1)
+
+convolutionPacked :: IO ()
+convolutionPacked =
+   SVL.writeFile "speedtest.f32" $
+   asMonoPacked $
+   CausalP.applyStorableChunky
+      (FiltNR.convolvePacked id)
+      (rampDown 1000)
+      (asMonoPacked $
+       (\xs -> SigP.renderChunky SVL.defaultChunkSize xs ()) $
+       SigPS.pack $
+       SigP.fromStorableVectorLazy $
+       pure $ impulses 18 0.1)
+
+
+
+helixSaw :: IO ()
+helixSaw = do
+   let srcFreq = 0.01
+       srcLength :: Float
+       srcLength = 40000
+   osci <- SigP.run $ SigP.osciSaw 0 (pure srcFreq) * (1-SigP.ramp id)
+   let perc = asMono $ osci (round srcLength) srcLength
+   SV.writeFile "osci-saw.f32" perc
+   stretched <-
+      SigP.runChunky $
+      Func.compileSignal $
+      (Helix.static Interpolation.cubic Interpolation.cubic
+          100 (pure $ recip srcFreq) snd
+       $&
+       (Func.fromSignal $ SigP.amplify (pure srcLength) $ SigP.ramp fst)
+       &|&
+       (CausalP.osciCore $& 0 &|& 0.01))
+   SVL.writeFile "osci-stretched.f32" $ asMono $
+      stretched SVL.defaultChunkSize (80000 :: Float, perc)
+
+
+loadTomato :: IO (Float, SVL.Vector Float)
+loadTomato = do
+   let Sample.Info name _sampleRate positions = Sample.tomatensalat
+   word <- Sample.load ("speech" </> name)
+   return (Sample.period $ head positions, word)
+
+helixOsci :: Param.T p Float -> Func.T p a (Value Float)
+helixOsci period =
+   CausalP.osciCore $&
+      0 &|& Func.fromSignal (SigP.constant (recip period))
+
+helixSpeechStaticSig ::
+   Func.T p () (Value Float) ->
+   Param.T p (SVL.Vector Float) ->
+   Param.T p Float ->
+   SigP.T p (Value Float)
+helixSpeechStaticSig shape word period =
+   Func.compileSignal
+      (Helix.static Interpolation.linear Interpolation.linear
+          (fmap round period) period
+          (fmap (SV.concat . SVL.chunks) word)
+       $&
+       shape
+       &|&
+       helixOsci period)
+
+helixSpeechStaticSpeed ::
+   Param.T p Float ->
+   Param.T p (SVL.Vector Float) ->
+   Param.T p Float ->
+   SigP.T p (Value Float)
+helixSpeechStaticSpeed speed word =
+   helixSpeechStaticSig
+      (Func.fromSignal
+         (CausalPV.takeWhile (%>)
+             (fmap ((fromIntegral :: Int -> Float) . SVL.length) word) $*
+          SigP.rampSlope speed))
+      word
+
+helixSpeechStatic :: IO ()
+helixSpeechStatic = do
+   let speed = fst
+       word = snd . snd
+       period = fst . snd
+   smp <- loadTomato
+   stretched <- SigP.runChunky $ helixSpeechStaticSpeed speed word period
+   SVL.writeFile "speech-stretched.f32" $ asMono $
+      stretched SVL.defaultChunkSize (0.5, smp)
+
+helixSpeechDynamicSig ::
+   Func.T p () (Value Float) ->
+   Param.T p (SVL.Vector Float) ->
+   Param.T p Float ->
+   SigP.T p (Value Float)
+helixSpeechDynamicSig shape word period =
+   Func.compileSignal
+      (Helix.dynamicLimited Interpolation.linear Interpolation.linear
+          (fmap round period) period (SigP.fromStorableVectorLazy word)
+       $&
+       shape
+       &|&
+       helixOsci period)
+
+helixSpeechDynamicSpeed ::
+   Param.T p Float ->
+   Param.T p (SVL.Vector Float) ->
+   Param.T p Float ->
+   SigP.T p (Value Float)
+helixSpeechDynamicSpeed speed =
+   helixSpeechDynamicSig (Func.fromSignal $ SigP.constant speed)
+
+helixSpeechDynamic :: IO ()
+helixSpeechDynamic = do
+   let speed = fst
+       word = snd . snd
+       period = fst . snd
+   smp <- loadTomato
+   stretched <- SigP.runChunky $ helixSpeechDynamicSpeed speed word period
+   SVL.writeFile "speech-stretched.f32" $ asMono $
+      stretched SVL.defaultChunkSize (0.5, smp)
+
+helixSpeechCompare :: IO ()
+helixSpeechCompare = do
+   let speed = fst
+       word = snd . snd
+       period = fst . snd
+   smp <- loadTomato
+   stretched <-
+      SigP.runChunky $ sequenceA $
+      Stereo.cons
+         (helixSpeechStaticSpeed speed word period)
+         (helixSpeechDynamicSpeed speed word period)
+   SVL.writeFile "speech-stretched.f32" $ asStereo $
+      stretched SVL.defaultChunkSize (0.5, smp)
+
+helixSpeechVariCompare :: IO ()
+helixSpeechVariCompare = do
+   let word = snd
+       period = fst
+   smp <- loadTomato
+   stretched <-
+      SigP.runChunky $ sequenceA $
+      let speed =
+             Func.fromSignal $ SigP.cycle $
+             SigP.fromStorableVector $ pure $
+             SV.pack [0.2, 0.5, 1, 1.5, 1.8 :: Float]
+      in  Stereo.cons
+             (helixSpeechStaticSig
+                 ((CausalP.integrate $# (0::Float)) $& speed) word period)
+             (helixSpeechDynamicSig speed word period)
+   SVL.writeFile "speech-stretched.f32" $ asStereo $
+      stretched SVL.defaultChunkSize smp
+
+
+helixLimited :: IO ()
+helixLimited = do
+   let period = 100
+       srcLength = 500
+       dstLength = 5000
+       speed :: Param.T p Float
+       speed = 0.5
+       osci =
+          0.5
+          *
+          SigP.ramp (pure (fromIntegral srcLength :: Float))
+          *
+          SigP.osciSimple Wave.approxSine2 0 (recip period)
+   renderOsci <- SigP.run osci
+   let osciVec = renderOsci srcLength ()
+   SV.writeFile "helix-orig.f32" $ asMono osciVec
+
+   let stretchedStatic =
+          Helix.static Interpolation.linear Interpolation.linear
+             (fmap round period) period (pure osciVec)
+          $&
+          Func.fromSignal (SigP.rampSlope speed)
+          &|&
+          helixOsci period
+       stretchedDynamic =
+          Helix.dynamic Interpolation.linear Interpolation.linear
+             (fmap round period) period osci
+          $&
+          Func.fromSignal (SigP.constant speed)
+          &|&
+          helixOsci period
+       stretched = liftA2 Stereo.cons stretchedStatic stretchedDynamic
+   renderHelix <- SigP.run $ Func.compileSignal stretched
+   SV.writeFile "helix-stretched.f32" $ asStereo $ renderHelix dstLength ()
+
+
+cycleRamp :: IO ()
+cycleRamp =
+   SVL.writeFile "speedtest.f32" . asMono .
+         (\f -> f SVL.defaultChunkSize (10000::Float)) =<<
+      SigP.runChunky
+         (CausalP.take 100000 $*
+          (SigP.cycle $ SigP.append (SigP.ramp id) (1 - SigP.ramp id)))
+
+zigZag :: IO ()
+zigZag =
+   SVL.writeFile "speedtest.f32" . asMono .
+         (\f -> f SVL.defaultChunkSize (-3::Float)) =<<
+      SigP.runChunky
+         (CausalP.take 100000 $* (Helix.zigZag id $* 0.0001))
+
+zigZagPacked :: IO ()
+zigZagPacked =
+   SVL.writeFile "speedtest.f32" . asMonoPacked .
+         (\f -> f SVL.defaultChunkSize (-3::Float)) =<<
+      SigP.runChunky
+         (let vectorSize = 4
+          in  CausalP.take (pure $ div 100000 vectorSize) $*
+              (Helix.zigZagPacked id $* 0.0001))
+
+
 main :: IO ()
 main = do
    LLVM.initializeNativeTarget
-   arrowIndependent
+   convolutionPacked
diff --git a/jack/Synthesizer/LLVM/Server/JACK.hs b/jack/Synthesizer/LLVM/Server/JACK.hs
--- a/jack/Synthesizer/LLVM/Server/JACK.hs
+++ b/jack/Synthesizer/LLVM/Server/JACK.hs
@@ -11,6 +11,7 @@
 import qualified Synthesizer.MIDI.CausalIO.Process as MIO
 import qualified Synthesizer.CausalIO.Process as PIO
 
+import qualified Synthesizer.LLVM.CausalParameterized.ProcessPacked as CausalPS
 import qualified Synthesizer.LLVM.CausalParameterized.Process as CausalP
 import qualified Synthesizer.LLVM.Storable.Signal as SigStL
 
@@ -42,7 +43,10 @@
 import qualified Control.Monad.Trans.Class as MT
 
 import Control.Arrow (Arrow, (<<<), (^<<), arr, )
+import Control.Category (id, )
+import Control.Applicative (pure, )
 
+import qualified System.Random as Random
 {-
 import qualified Numeric.NonNegative.Class   as NonNeg
 import qualified Numeric.NonNegative.Chunky  as NonNegChunky
@@ -211,16 +215,39 @@
              [0 .. 3])
 
 
-voder :: IO ()
-voder = do
+voderBand :: IO ()
+voderBand = do
    opt <- Option.get
    proc <-
-      Arrange.voder
+      Arrange.voderBand
          (arr unconsStereo)
          (Option.sampleDirectory opt)
 
    playStereoFromEvents opt $ \ sampleRate ->
       proc (Option.channel opt) (VoiceMsg.toProgram 5) sampleRate
+
+
+voderMaskSeparated :: IO ()
+voderMaskSeparated = do
+   opt <- Option.get
+   let postProcessing =
+          if True
+            then
+               let reverb seed =
+                      CausalP.reverbEfficient
+                         (pure $ Random.mkStdGen seed) 16 (pure (0.92,0.98))
+                         (fmap (\(SampleRate rate) -> (round (rate/200), round (rate/40))) id)
+               in  CausalPS.pack (Stereo.arrowFromChannels (reverb 42) (reverb 23))
+            else id
+   proc <-
+      Arrange.voderMaskSeparated
+         (arr unconsStereo <<< postProcessing)
+         (Option.sampleDirectory opt)
+
+   playStereoFromEvents opt $ \ sampleRate ->
+      proc
+         (Option.channel opt) (Option.extraChannel opt)
+         (VoiceMsg.toProgram 4) sampleRate
 
 
 main :: IO ()
diff --git a/render/Synthesizer/LLVM/Server/Render.hs b/render/Synthesizer/LLVM/Server/Render.hs
--- a/render/Synthesizer/LLVM/Server/Render.hs
+++ b/render/Synthesizer/LLVM/Server/Render.hs
@@ -6,29 +6,17 @@
           (vectorSize, vectorRate, )
 
 import qualified Synthesizer.LLVM.Server.Option as Option
+import qualified Synthesizer.LLVM.Frame.Stereo as Stereo
 import Synthesizer.LLVM.Server.Common
 
-import qualified Synthesizer.MIDI.CausalIO.Process as MIO
 import qualified Synthesizer.CausalIO.Process as PIO
 import qualified Synthesizer.PiecewiseConstant.Signal as PC
 
-import qualified Synthesizer.LLVM.CausalParameterized.Process as CausalP
-import qualified Synthesizer.LLVM.Storable.Signal as SigStL
-
-import qualified Synthesizer.LLVM.Frame.StereoInterleaved as StereoInt
-import qualified Synthesizer.LLVM.Frame.Stereo as Stereo
-
 import qualified Data.StorableVector.Lazy as SVL
-import qualified Data.StorableVector as SV
 
 import qualified Data.EventList.Relative.TimeBody  as EventList
 import qualified Data.EventList.Relative.TimeMixed as EventListTM
 
-import qualified Synthesizer.Zip as Zip
-
-import qualified Sound.MIDI.Message.Channel.Voice as VoiceMsg
-import qualified Sound.MIDI.Message.Channel as ChannelMsg
-
 import qualified Sound.MIDI.File as MidiFile
 import qualified Sound.MIDI.File.Event as FileEvent
 import qualified Sound.MIDI.File.Load as Load
@@ -36,7 +24,6 @@
 import qualified Sound.Sox.Write as SoxWrite
 import qualified Sound.Sox.Play  as SoxPlay
 
-import Control.Arrow (Arrow, (<<<), arr, )
 import Control.Applicative ((<*>), )
 
 import Data.Monoid (mempty, )
@@ -59,28 +46,6 @@
    NonNegW.fromNumberMsg "strictTimeFromNFrames" $ fromIntegral n
 
 
-keyboardMultiChannel ::
-   Option.T ->
-   IO (SampleRate Real ->
-       PIO.T (MIO.Events ChannelMsg.T) (SV.Vector (Stereo.T Real)))
-keyboardMultiChannel opt = do
-   proc <-
-      Arrange.keyboardDetuneFMCore
-         (CausalP.mapSimple StereoInt.interleave)
-         (Option.sampleDirectory opt)
-   mix <- CausalP.processIO CausalP.mix
-
-   return $ \ sampleRate ->
-      arr SigStL.unpackStereoStrict
-      <<<
-      foldl1
-         (\x y -> mix () <<< Zip.arrowFanout x y)
-         (map
-             (\chan ->
-                proc (ChannelMsg.toChannel chan) (VoiceMsg.toProgram 0)
-                     sampleRate)
-             [0 .. 3])
-
 {-
 This is the duration of rendering after the last MIDI event.
 
@@ -98,7 +63,10 @@
    Option.T ->
    IO (MidiFile.T -> SVL.Vector (Stereo.T Real))
 render opt = do
-   proc <- keyboardMultiChannel opt
+   proc <-
+      case 0::Int of
+         0 -> Arrange.keyboardMultiChannel $ Option.sampleDirectory opt
+         _ -> Arrange.voderMaskMulti $ Option.sampleDirectory opt
    run <- PIO.runCont $ proc $ fmap fromIntegral $ Option.sampleRate opt
    return $
       SVL.fromChunks .
diff --git a/src/Synthesizer/LLVM/Causal/Process.hs b/src/Synthesizer/LLVM/Causal/Process.hs
--- a/src/Synthesizer/LLVM/Causal/Process.hs
+++ b/src/Synthesizer/LLVM/Causal/Process.hs
@@ -2,40 +2,89 @@
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE ExistentialQuantification #-}
 {-# LANGUAGE Rank2Types #-}
+{-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE ForeignFunctionInterface #-}
-module Synthesizer.LLVM.Causal.Process where
+module Synthesizer.LLVM.Causal.Process (
+   C(simple, loopConst, replicateControlled),
+   T,
+   amplify,
+   amplifyStereo,
+   apply,
+   applyFst,
+   applySnd,
+   compose,
+   envelope,
+   envelopeStereo,
+   feedFst,
+   feedSnd,
+   fromModifier,
+   fromSignal,
+   toSignal,
+   loopZero,
+   feedbackControlledZero,
+   map,
+   mapAccum,
+   zipWith,
+   mix,
+   pipeline,
+   stereoFromVector,
+   vectorize,
+   replaceChannel,
+   arrayElement,
+   element,
+   applyStorable,
+   applyStorableChunky,
+   runStorableChunky,
+   ) where
 
 import qualified Synthesizer.LLVM.Simple.Signal as Sig
+import qualified Synthesizer.LLVM.Simple.Value as Value
+import qualified Synthesizer.LLVM.Causal.ProcessPrivate as Causal
+import qualified Synthesizer.LLVM.Frame.Stereo as Stereo
 import qualified Synthesizer.LLVM.Frame as Frame
 import qualified Synthesizer.LLVM.Execution as Exec
 
-import qualified LLVM.Extra.Arithmetic as A
-import qualified LLVM.Extra.MaybeContinuation as Maybe
-import qualified LLVM.Extra.ForeignPtr as ForeignPtr
-import qualified LLVM.Extra.Memory as Memory
--- import qualified LLVM.Extra.Control as U
-import LLVM.Extra.Class (MakeValueTuple, ValueTuple, )
+import qualified Synthesizer.Plain.Modifier as Modifier
+import qualified Synthesizer.Causal.Class as CausalClass
 
 import qualified Data.StorableVector.Lazy as SVL
 import qualified Data.StorableVector as SV
 import qualified Data.StorableVector.Base as SVB
 
-import qualified Synthesizer.LLVM.Frame.Stereo as Stereo
+import qualified LLVM.Extra.Class as Class
+import qualified LLVM.Extra.Arithmetic as A
+import qualified LLVM.Extra.Vector as Vector
+import qualified LLVM.Extra.MaybeContinuation as MaybeCont
+import qualified LLVM.Extra.Maybe as Maybe
+import qualified LLVM.Extra.ForeignPtr as ForeignPtr
+import qualified LLVM.Extra.Memory as Memory
+import LLVM.Extra.Class (Undefined, MakeValueTuple, ValueTuple, )
 
-import LLVM.Core as LLVM
-import LLVM.Util.Loop (Phi, )
+import qualified LLVM.Core as LLVM
 import LLVM.ExecutionEngine (simpleFunction, )
+import LLVM.Util.Loop (Phi, )
+import LLVM.Core
+          (CodeGenFunction, ret, Value, valueOf,
+           IsConst, IsFirstClass, IsArithmetic, IsPrimitive,
+           Linkage(ExternalLinkage), createNamedFunction)
 
+import qualified Types.Data.Num as TypeNum
+import qualified Types.Data.Bool as TypeBool
+import Types.Data.Num (D2, )
+import Types.Data.Ord ((:<:), )
+
 import qualified Control.Arrow    as Arr
 import qualified Control.Category as Cat
-import Control.Arrow ((<<<), (^<<), (&&&), )
+import Control.Monad.Trans.State (runState, )
+import Control.Arrow ((<<<), (^<<), (>>>), (&&&), )
 import Control.Monad (liftM2, liftM3, )
 import Control.Applicative (Applicative, pure, (<*>), )
 
+import qualified Data.List as List
 import Data.Word (Word32, )
 import Foreign.Storable (Storable, )
 import Foreign.ForeignPtr (withForeignPtr, touchForeignPtr, )
-import Foreign.Ptr (FunPtr, )
+import Foreign.Ptr (FunPtr, Ptr, )
 import Control.Exception (bracket, )
 import qualified System.Unsafe as Unsafe
 
@@ -45,7 +94,7 @@
 import qualified Algebra.Additive as Additive
 
 import NumericPrelude.Numeric
-import NumericPrelude.Base hiding (and, map, zip, zipWith, )
+import NumericPrelude.Base hiding (and, map, zip, zipWith, init, )
 
 import qualified Prelude as P
 
@@ -56,7 +105,7 @@
       Cons (forall r c.
             (Phi c) =>
             ioContext ->
-            a -> state -> Maybe.T r c (b, state))
+            a -> state -> MaybeCont.T r c (b, state))
                -- compute next value
            (forall r.
             ioContext ->
@@ -67,20 +116,52 @@
            (ioContext -> IO ())
                -- finalization from IO monad
 
-simple ::
-   (Memory.C state) =>
-   (forall r c.
-    (Phi c) =>
-    a -> state -> Maybe.T r c (b, state)) ->
-   (forall r. CodeGenFunction r state) ->
-   T a b
-simple next start =
-   Cons
-      (const next)
-      (const start)
-      (return ())
-      (const $ return ())
 
+class CausalClass.C process => C process where
+   simple ::
+      (Memory.C state) =>
+      (forall r c.
+       (Phi c) =>
+       a -> state -> MaybeCont.T r c (b, state)) ->
+      (forall r. CodeGenFunction r state) ->
+      process a b
+   {- |
+   Like 'Synthesizer.LLVM.CausalParameterized.loop'
+   but uses zero as initial value
+   and it does not need a zero as Haskell value.
+   -}
+   loopConst ::
+      (Memory.C c) =>
+      c -> process (a,c) (b,c) -> process a b
+   replicateControlled ::
+      (Undefined x, Phi x) =>
+      Int -> process (c,x) x -> process (c,x) x
+
+instance CausalClass.C T where
+   type SignalOf T = Sig.T
+   type ProcessOf Sig.T = T
+   toSignal = toSignal
+   fromSignal = fromSignal
+
+instance C T where
+   simple next start =
+      Cons
+         (const next)
+         (const start)
+         (return ())
+         (const $ return ())
+   loopConst init (Cons next start create delete) =
+      Cons
+         (Causal.loopNext next)
+         (fmap ((,) init) . start)
+         create
+         delete
+   {-
+   Could be implemented with a machine code loop like in CausalParameterized.
+   But to this end we would need a 'stop' function.
+   -}
+   replicateControlled = CausalClass.replicateControlled
+
 toSignal :: T () a -> Sig.T a
 toSignal (Cons next start createIOContext deleteIOContext) = Sig.Cons
    (\ioContext -> next ioContext ())
@@ -95,47 +176,61 @@
 
 
 map ::
+   (C process) =>
    (forall r. a -> CodeGenFunction r b) ->
-   T a b
+   process a b
 map f =
    mapAccum (\a s -> fmap (flip (,) s) $ f a) (return ())
 
 mapAccum ::
-   (Memory.C state) =>
+   (C process, Memory.C state) =>
    (forall r.
     a -> state -> CodeGenFunction r (b, state)) ->
    (forall r. CodeGenFunction r state) ->
-   T a b
+   process a b
 mapAccum next =
-   simple (\a s -> Maybe.lift $ next a s)
+   simple (\a s -> MaybeCont.lift $ next a s)
 
 zipWith ::
+   (C process) =>
    (forall r. a -> b -> CodeGenFunction r c) ->
-   T (a,b) c
+   process (a,b) c
 zipWith f = map (uncurry f)
 
 
-apply ::
-   T a b -> Sig.T a -> Sig.T b
-apply proc sig =
-   toSignal (proc <<< fromSignal sig)
+fromModifier ::
+   (C process) =>
+   (Value.Flatten ah, Value.Registers ah ~ al,
+    Value.Flatten bh, Value.Registers bh ~ bl,
+    Value.Flatten ch, Value.Registers ch ~ cl,
+    Value.Flatten sh, Value.Registers sh ~ sl,
+    Memory.C sl) =>
+   Modifier.Simple sh ch ah bh -> process (cl,al) bl
+fromModifier (Modifier.Simple initial step) =
+   mapAccum
+      (\(c,a) s ->
+         Value.flatten $
+         runState
+            (step (Value.unfold c) (Value.unfold a))
+            (Value.unfold s))
+      (Value.flatten initial)
 
+
+apply :: T a b -> Sig.T a -> Sig.T b
+apply = CausalClass.apply
+
 feedFst :: Sig.T a -> T b (a,b)
-feedFst sig =
-   fromSignal sig &&& Cat.id
+feedFst = CausalClass.feedFst
 
 feedSnd :: Sig.T a -> T b (b,a)
-feedSnd sig =
-   Cat.id &&& fromSignal sig
+feedSnd = CausalClass.feedSnd
 
 
 applyFst :: T (a,b) c -> Sig.T a -> T b c
-applyFst proc sig =
-   proc <<< feedFst sig
+applyFst = CausalClass.applyFst
 
 applySnd :: T (a,b) c -> Sig.T b -> T a c
-applySnd proc sig =
-   proc <<< feedSnd sig
+applySnd = CausalClass.applySnd
 
 compose :: T a b -> T b c -> T a c
 compose
@@ -216,35 +311,136 @@
 
 
 mix ::
-   (A.Additive a) =>
-   T (a, a) a
+   (C process, A.Additive a) =>
+   process (a, a) a
 mix = zipWith Frame.mix
 
 
 envelope ::
-   (A.PseudoRing a) =>
-   T (a, a) a
+   (C process, A.PseudoRing a) =>
+   process (a, a) a
 envelope = zipWith Frame.amplifyMono
 
 envelopeStereo ::
-   (A.PseudoRing a) =>
-   T (a, Stereo.T a) (Stereo.T a)
+   (C process, A.PseudoRing a) =>
+   process (a, Stereo.T a) (Stereo.T a)
 envelopeStereo = zipWith Frame.amplifyStereo
 
 amplify ::
-   (IsArithmetic a, IsConst a) =>
-   a -> T (Value a) (Value a)
+   (C process, IsArithmetic a, IsConst a) =>
+   a -> process (Value a) (Value a)
 amplify x =
    map (Frame.amplifyMono (valueOf x))
 
 amplifyStereo ::
-   (IsArithmetic a, IsConst a) =>
-   a -> T (Stereo.T (Value a)) (Stereo.T (Value a))
+   (C process, IsArithmetic a, IsConst a) =>
+   a -> process (Stereo.T (Value a)) (Stereo.T (Value a))
 amplifyStereo x =
    map (Frame.amplifyStereo (valueOf x))
 
 
 
+loopZero ::
+   (C process, A.Additive c, Memory.C c) =>
+   process (a,c) (b,c) -> process a b
+loopZero = loopConst A.zero
+
+pipeline ::
+   (C process,
+    Vector.C v, a ~ Vector.Element v,
+    Class.Zero v, Memory.C v) =>
+   process v v -> process a a
+pipeline vectorProcess =
+   loopConst Class.zeroTuple $
+      map (uncurry Vector.shiftUp)
+      >>>
+      Arr.second vectorProcess
+
+
+feedbackControlledZero ::
+   (C process, A.Additive c, Memory.C c) =>
+   process ((ctrl,a),c) b -> process (ctrl,b) c -> process (ctrl,a) b
+feedbackControlledZero forth back =
+   loopZero (Causal.feedbackControlledAux forth back)
+
+
+{-
+In order to let this work we have to give the disable-mmx option somewhere,
+but where?
+-}
+stereoFromVector ::
+   (C process, IsPrimitive a, IsPrimitive b) =>
+   process (Value (LLVM.Vector D2 a)) (Value (LLVM.Vector D2 b)) ->
+   process (Stereo.T (Value a)) (Stereo.T (Value b))
+stereoFromVector proc =
+   map Frame.stereoFromVector <<<
+   proc <<<
+   map Frame.vectorFromStereo
+
+
+{-
+insert and extract instructions will be in opposite order,
+no matter whether we use foldr or foldl
+and independent from the order of proc and channel in replaceChannel.
+However, LLVM neglects the order anyway.
+-}
+vectorize ::
+   (C process,
+    Vector.C va, n ~ Vector.Size va, a ~ Vector.Element va,
+    Vector.C vb, n ~ Vector.Size vb, b ~ Vector.Element vb) =>
+   process a b -> process va vb
+vectorize proc =
+   withSize $ \n ->
+      foldl
+         (\acc i -> replaceChannel i proc acc)
+         (Arr.arr (const $ Class.undefTuple)) $
+      List.take (TypeNum.fromIntegerT n) [0 ..]
+
+withSize ::
+   (Vector.Size bv -> f bv) ->
+   f bv
+withSize f = f undefined
+
+{- |
+Given a vector process, replace the i-th output by output
+that is generated by a scalar process from the i-th input.
+-}
+replaceChannel ::
+   (C process,
+    Vector.C va, n ~ Vector.Size va, a ~ Vector.Element va,
+    Vector.C vb, n ~ Vector.Size vb, b ~ Vector.Element vb) =>
+   Int -> process a b -> process va vb -> process va vb
+replaceChannel i channel proc =
+   let li = valueOf $ fromIntegral i
+   in  zipWith (Vector.insert li) <<<
+          (channel <<< map (Vector.extract li)) &&&
+          proc
+
+{- |
+Read the i-th element from each array.
+-}
+arrayElement ::
+   (C process,
+    LLVM.Array dim a ~ array,
+    LLVM.GetValue array index, IsFirstClass a,
+    LLVM.ValueType array index ~ a,
+    TypeNum.NaturalT index, TypeNum.NaturalT dim,
+    (index :<: dim) ~ TypeBool.True) =>
+   index -> process (Value (LLVM.Array dim a)) (Value a)
+arrayElement i =
+   map (\array -> LLVM.extractvalue array i)
+
+{- |
+Read the i-th element from an aggregate type.
+-}
+element ::
+   (C process, IsFirstClass a, LLVM.GetValue agg index,
+    LLVM.ValueType agg index ~ a) =>
+   index -> process (Value agg) (Value a)
+element i =
+   map (\array -> LLVM.extractvalue array i)
+
+
 applyStorable ::
    (Storable a, MakeValueTuple a, ValueTuple a ~ valueA, Memory.C valueA,
     Storable b, MakeValueTuple b, ValueTuple b ~ valueB, Memory.C valueB) =>
@@ -258,11 +454,11 @@
          simpleFunction $
          createNamedFunction ExternalLinkage "fillprocessblock" $ \ size alPtr blPtr -> do
             s <- start ioContext
-            (pos,_) <- Maybe.arrayLoop2 size alPtr blPtr s $
+            (pos,_) <- MaybeCont.arrayLoop2 size alPtr blPtr s $
                   \ aPtri bPtri s0 -> do
-               a <- Maybe.lift $ Memory.load aPtri
+               a <- MaybeCont.lift $ Memory.load aPtri
                (b,s1) <- next ioContext a s0
-               Maybe.lift $ Memory.store b bPtri
+               MaybeCont.lift $ Memory.store b bPtri
                return s1
             ret (pos :: Value Word32)
       fmap (fromIntegral :: Word32 -> Int) $
@@ -271,12 +467,6 @@
             (Memory.castStorablePtr bPtr)
 
 
-foreign import ccall safe "dynamic" derefStartPtr ::
-   Exec.Importer (IO (Ptr stateStruct))
-
-foreign import ccall safe "dynamic" derefStopPtr ::
-   Exec.Importer (Ptr stateStruct -> IO ())
-
 foreign import ccall safe "dynamic" derefChunkPtr ::
    Exec.Importer (Ptr stateStruct -> Word32 ->
              Ptr aStruct -> Ptr bStruct -> IO Word32)
@@ -286,9 +476,10 @@
    (Memory.C aValue, Memory.Struct aValue ~ aStruct,
     Memory.C bValue, Memory.Struct bValue ~ bStruct,
     Memory.C state, Memory.Struct state ~ stateStruct) =>
-   (forall r.
+   (forall r z.
+    (Phi z) =>
     aValue -> state ->
-    Maybe.T r (Value Bool, (Value (Ptr bStruct), state)) (bValue, state)) ->
+    MaybeCont.T r z (bValue, state)) ->
    (forall r.
     CodeGenFunction r state) ->
    IO (FunPtr (IO (Ptr stateStruct)),
@@ -307,13 +498,13 @@
          (createNamedFunction ExternalLinkage "fillprocess" $
           \ sptr loopLen aPtr bPtr -> do
              sInit <- Memory.load sptr
-             (pos,sExit) <- Maybe.arrayLoop2 loopLen aPtr bPtr sInit $
+             (pos,sExit) <- MaybeCont.arrayLoop2 loopLen aPtr bPtr sInit $
                    \ aPtri bPtri s0 -> do
-                a <- Maybe.lift $ Memory.load aPtri
+                a <- MaybeCont.lift $ Memory.load aPtri
                 (b,s1) <- next a s0
-                Maybe.lift $ Memory.store b bPtri
+                MaybeCont.lift $ Memory.store b bPtri
                 return s1
-             Memory.store sExit sptr
+             Memory.store (Maybe.fromJust sExit) sptr
              ret (pos :: Value Word32))
 
 
diff --git a/src/Synthesizer/LLVM/Causal/ProcessPrivate.hs b/src/Synthesizer/LLVM/Causal/ProcessPrivate.hs
new file mode 100644
--- /dev/null
+++ b/src/Synthesizer/LLVM/Causal/ProcessPrivate.hs
@@ -0,0 +1,20 @@
+module Synthesizer.LLVM.Causal.ProcessPrivate where
+
+import Control.Arrow (Arrow, arr, (>>>), (&&&), )
+
+
+loopNext ::
+   (Monad m) =>
+   (context -> (a,c) -> state -> m ((b,c), state)) ->
+   context -> a -> (c, state) -> m (b, (c, state))
+loopNext next ctx a0 (c0,s0) = do
+   ((b1,c1), s1) <- next ctx (a0,c0) s0
+   return (b1,(c1,s1))
+
+feedbackControlledAux ::
+   Arrow arrow =>
+   arrow ((ctrl,a),c) b ->
+   arrow (ctrl,b) c ->
+   arrow ((ctrl,a),c) (b,c)
+feedbackControlledAux forth back =
+   arr (fst.fst) &&& forth  >>>  arr snd &&& back
diff --git a/src/Synthesizer/LLVM/Causal/ProcessValue.hs b/src/Synthesizer/LLVM/Causal/ProcessValue.hs
new file mode 100644
--- /dev/null
+++ b/src/Synthesizer/LLVM/Causal/ProcessValue.hs
@@ -0,0 +1,44 @@
+{- |
+This module provides functions similar to
+"Synthesizer.LLVM.Causal.Process"
+but expects functions that operate on 'Value.T'.
+This way you can use common arithmetic operators
+instead of LLVM assembly functions.
+-}
+module Synthesizer.LLVM.Causal.ProcessValue (
+   map, zipWith, mapAccum,
+   ) where
+
+import qualified Synthesizer.LLVM.Causal.Process as Causal
+import qualified Synthesizer.LLVM.Simple.Value as Value
+
+import qualified LLVM.Extra.Memory as Memory
+
+import Foreign.Storable.Tuple ()
+
+import Prelude ()
+
+
+map ::
+   (Causal.C process) =>
+   (Value.T a -> Value.T b) ->
+   process a b
+map f =
+   Causal.map (Value.unlift1 f)
+
+zipWith ::
+   (Causal.C process) =>
+   (Value.T a -> Value.T b -> Value.T c) ->
+   process (a,b) c
+zipWith f =
+   Causal.zipWith (Value.unlift2 f)
+
+mapAccum ::
+   (Causal.C process, Memory.C s) =>
+   (Value.T a -> Value.T s -> (Value.T b, Value.T s)) ->
+   Value.T s ->
+   process a b
+mapAccum next start =
+   Causal.mapAccum
+      (Value.unlift2 next)
+      (Value.unlift0 start)
diff --git a/src/Synthesizer/LLVM/CausalParameterized/Controlled.hs b/src/Synthesizer/LLVM/CausalParameterized/Controlled.hs
--- a/src/Synthesizer/LLVM/CausalParameterized/Controlled.hs
+++ b/src/Synthesizer/LLVM/CausalParameterized/Controlled.hs
@@ -34,8 +34,7 @@
 import LLVM.Extra.Class (MakeValueTuple, ValueTuple, )
 
 import qualified LLVM.Core as LLVM
-import LLVM.Core
-   (Value, IsFloating, IsConst, IsSized, )
+import LLVM.Core (Value, IsFloating, IsConst, IsSized, )
 
 import qualified Synthesizer.LLVM.Frame.Stereo as Stereo
 
@@ -44,12 +43,7 @@
 
 import Foreign.Storable (Storable, )
 
--- import qualified Algebra.Field as Field
--- import qualified Algebra.Module as Module
-import qualified Algebra.Ring as Ring
-import qualified Algebra.Additive as Additive
 
-
 {- |
 A filter parameter type uniquely selects a filter function.
 However it does not uniquely determine the input and output type,
@@ -65,7 +59,7 @@
    (C parameter a b,
     Memory.C parameter,
     Memory.FirstClass r, IsSized r, IsSized (Memory.Stored r),
-    Ring.C r, IsFloating r, Storable r, IsConst r,
+    IsFloating r, Storable r, SoV.IntegerConstant r,
     MakeValueTuple r, ValueTuple r ~ (Value r),
     LLVM.CmpRet r, LLVM.CmpResult r ~ Bool) =>
    Param.T p r ->
@@ -82,20 +76,20 @@
 -}
 
 instance
-   (A.PseudoModule a v, A.IntegerConstant a,
+   (a ~ A.Scalar v, A.PseudoModule v, A.IntegerConstant a,
     Memory.C a, Memory.C v) =>
       C (Filt1.Parameter a) v (Filt1.Result v) where
    type Input  (Filt1.Parameter a) (Filt1.Result v) = v
    type Output (Filt1.Parameter a) v = Filt1.Result v
-   process = Filt1.causalP
+   process = Filt1.causal
 
 instance
-   (A.PseudoModule a v, A.RationalConstant a,
+   (a ~ A.Scalar v, A.PseudoModule v, A.RationalConstant a,
     Memory.C a, Memory.C v) =>
       C (Filt2.Parameter a) v v where
    type Input  (Filt2.Parameter a) v = v
    type Output (Filt2.Parameter a) v = v
-   process = Filt2.causalP
+   process = Filt2.causal
 
 instance
    (Vector.Arithmetic a, SoV.RationalConstant a,
@@ -106,10 +100,10 @@
         (Value a) (Value a) where
    type Input  (Filt2P.Parameter a) (Value a) = Value a
    type Output (Filt2P.Parameter a) (Value a) = Value a
-   process = Filt2P.causalP
+   process = Filt2P.causal
 
 instance
-   (SoV.PseudoModule a v, SoV.IntegerConstant a,
+   (a ~ SoV.Scalar v, SoV.PseudoModule v, SoV.IntegerConstant a,
     Memory.FirstClass a, IsSized a, IsSized (Memory.Stored a),
     Memory.FirstClass v, IsSized v, IsSized (Memory.Stored v),
     TypeNum.NaturalT n,
@@ -118,67 +112,50 @@
         (Value v) (Value v) where
    type Input  (Cascade.ParameterValue n a) (Value v) = Value v
    type Output (Cascade.ParameterValue n a) (Value v) = Value v
-   process = Cascade.causalP
+   process = Cascade.causal
 
 
 instance
-   (A.PseudoModule a v, A.RationalConstant a,
+   (a ~ A.Scalar v, A.PseudoModule v, A.RationalConstant a,
     Memory.C a, Memory.C v) =>
       C (Allpass.Parameter a) v v where
    type Input  (Allpass.Parameter a) v = v
    type Output (Allpass.Parameter a) v = v
-   process = Allpass.causalP
+   process = Allpass.causal
 
 instance
-   (A.PseudoModule a v, A.RationalConstant a,
+   (a ~ A.Scalar v, A.PseudoModule v, A.RationalConstant a,
     Memory.C a, Memory.C v,
     TypeNum.NaturalT n) =>
       C (Allpass.CascadeParameter n a) v v where
    type Input  (Allpass.CascadeParameter n a) v = v
    type Output (Allpass.CascadeParameter n a) v = v
-   process = Allpass.cascadeP
+   process = Allpass.cascade
 
 
 instance
-   (SoV.PseudoModule a v, SoV.IntegerConstant a,
-    Additive.C v, IsConst v,
-    Memory.FirstClass a, IsSized a, IsSized (Memory.Stored a),
-    Memory.FirstClass v, IsSized v, IsSized (Memory.Stored v),
-    MakeValueTuple a, ValueTuple a ~ (Value a),
-    MakeValueTuple v, ValueTuple v ~ (Value v),
-    Storable v,
-    TypeNum.NaturalT n) =>
-      C (Moog.Parameter n (Value a))
-        (Value v) (Value v) where
-   type Input  (Moog.Parameter n (Value a)) (Value v) = Value v
-   type Output (Moog.Parameter n (Value a)) (Value v) = Value v
-   process = Moog.causalP
-
-{-
-instance
-   (A.PseudoModule a v, A.RationalConstant a,
-    Memory.C a, Memory.C v,
-    TypeNum.NaturalT n) =>
+   (A.PseudoModule v, A.Scalar v ~ a, A.IntegerConstant a,
+    Memory.C v, TypeNum.NaturalT n) =>
       C (Moog.Parameter n a) v v where
    type Input  (Moog.Parameter n a) v = v
    type Output (Moog.Parameter n a) v = v
-   process = Moog.causalP
--}
+   process = Moog.causal
 
+
 instance
-   (A.PseudoModule a v, A.RationalConstant a,
+   (a ~ A.Scalar v, A.PseudoModule v, A.RationalConstant a,
     Memory.C a, Memory.C v) =>
       C (UniFilter.Parameter a) v (UniFilter.Result v) where
    type Input  (UniFilter.Parameter a) (UniFilter.Result v) = v
    type Output (UniFilter.Parameter a) v = UniFilter.Result v
-   process = UniFilter.causalP
+   process = UniFilter.causal
 
 instance
    (A.PseudoRing a, A.RationalConstant a, Memory.C a) =>
       C (ComplexFilt.Parameter a) (Stereo.T a) (Stereo.T a) where
    type Input  (ComplexFilt.Parameter a) (Stereo.T a) = Stereo.T a
    type Output (ComplexFilt.Parameter a) (Stereo.T a) = Stereo.T a
-   process = ComplexFilt.causalP
+   process = ComplexFilt.causal
 
 instance
    (Vector.Arithmetic a, IsConst a,
@@ -192,4 +169,4 @@
         (Stereo.T (Value a)) (Stereo.T (Value a)) where
    type Input  (ComplexFiltPack.Parameter a) (Stereo.T (Value a)) = Stereo.T (Value a)
    type Output (ComplexFiltPack.Parameter a) (Stereo.T (Value a)) = Stereo.T (Value a)
-   process = ComplexFiltPack.causalP
+   process = ComplexFiltPack.causal
diff --git a/src/Synthesizer/LLVM/CausalParameterized/ControlledPacked.hs b/src/Synthesizer/LLVM/CausalParameterized/ControlledPacked.hs
--- a/src/Synthesizer/LLVM/CausalParameterized/ControlledPacked.hs
+++ b/src/Synthesizer/LLVM/CausalParameterized/ControlledPacked.hs
@@ -33,8 +33,7 @@
 
 import qualified LLVM.Core as LLVM
 import LLVM.Util.Loop (Phi, )
-import LLVM.Core
-   (Value, IsFloating, IsConst, IsSized, )
+import LLVM.Core (Value, IsFloating, IsSized, )
 
 import qualified Types.Data.Num as TypeNum
 import Types.Data.Num.Ops ((:*:), )
@@ -44,9 +43,6 @@
 import Control.Arrow ((<<<), arr, first, )
 
 import qualified Algebra.Field as Field
--- import qualified Algebra.Module as Module
--- import qualified Algebra.Ring as Ring
-import qualified Algebra.Additive as Additive
 
 import NumericPrelude.Numeric
 import NumericPrelude.Base
@@ -65,29 +61,22 @@
 processCtrlRate ::
    (C parameter av bv,
     Serial.Read av, n ~ Serial.Size av, a ~ Serial.Element av,
-    Serial.C      bv, n ~ Serial.Size bv, b ~ Serial.Element bv,
+    Serial.C    bv, n ~ Serial.Size bv, b ~ Serial.Element bv,
     Memory.C parameter,
-    Field.C r, Storable r, IsFloating r,
-    Memory.FirstClass r, Memory.Stored r ~ rm, IsSized r, IsSized rm, IsConst r,
+    Field.C r, Storable r, IsFloating r, SoV.IntegerConstant r,
+    Memory.FirstClass r, Memory.Stored r ~ rm, IsSized r, IsSized rm,
     MakeValueTuple r, ValueTuple r ~ (Value r),
     LLVM.CmpRet r, LLVM.CmpResult r ~ Bool) =>
    Param.T p r ->
    (Param.T p r -> SigP.T p parameter) ->
    CausalP.T p av bv
-processCtrlRate reduct ctrlGen = withSize $ \n ->
+processCtrlRate reduct ctrlGen = Serial.withSize $ \n ->
    CausalP.applyFst process
       (SigP.interpolateConstant
-         (fmap (/ fromInteger (TypeNum.fromIntegerT n)) reduct)
+         (fmap (/ fromIntegral n) reduct)
          (ctrlGen reduct))
 
-withSize ::
-   (Serial.Read av, n ~ Serial.Size av,
-    Serial.Read bv, n ~ Serial.Size bv) =>
-   (n -> CausalP.T p av bv) ->
-   CausalP.T p av bv
-withSize f = f undefined
 
-
 {-
 Instances for the particular filters shall be defined here
 in order to avoid orphan instances.
@@ -100,7 +89,7 @@
       C (Filt1.Parameter a) v (Filt1.Result v) where
    type Input  (Filt1.Parameter a) (Filt1.Result v) = v
    type Output (Filt1.Parameter a) v = Filt1.Result v
-   process = Filt1.causalPackedP
+   process = Filt1.causalPacked
 
 instance
    (Serial.C v, Serial.Element v ~ a,
@@ -109,10 +98,10 @@
       C (Filt2.Parameter a) v v where
    type Input  (Filt2.Parameter a) v = v
    type Output (Filt2.Parameter a) v = v
-   process = Filt2.causalPackedP
+   process = Filt2.causalPacked
 
 instance
-   (A.PseudoModule (LLVM.Value a) v,
+   (LLVM.Value a ~ A.Scalar v, A.PseudoModule v,
     Serial.C v, Serial.Element v ~ LLVM.Value a,
     SoV.IntegerConstant a,
     A.PseudoRing v, A.IntegerConstant v, Memory.C v,
@@ -124,7 +113,7 @@
       C (Cascade.ParameterValue n a) v v where
    type Input  (Cascade.ParameterValue n a) v = v
    type Output (Cascade.ParameterValue n a) v = v
-   process = Cascade.causalPackedP
+   process = Cascade.causalPacked
 
 
 instance
@@ -134,7 +123,7 @@
       C (Allpass.Parameter a) v v where
    type Input  (Allpass.Parameter a) v = v
    type Output (Allpass.Parameter a) v = v
-   process = Allpass.causalPackedP
+   process = Allpass.causalPacked
 
 instance
    (TypeNum.NaturalT n,
@@ -144,30 +133,27 @@
       C (Allpass.CascadeParameter n a) v v where
    type Input  (Allpass.CascadeParameter n a) v = v
    type Output (Allpass.CascadeParameter n a) v = v
-   process = Allpass.cascadePackedP
+   process = Allpass.cascadePacked
 
 
 instance
-   (SoV.PseudoModule a a, SoV.IntegerConstant a, Additive.C a,
-    Memory.FirstClass a, Memory.Stored a ~ am, IsSized a, IsSized am,
-    MakeValueTuple a, ValueTuple a ~ (Value a), Storable a,
-    TypeNum.PositiveT d, LLVM.IsPrimitive a,
+   (Serial.C v, Serial.Element v ~ b, Phi a, Class.Undefined a,
+    a ~ A.Scalar b, A.PseudoModule b, A.IntegerConstant a, Memory.C b,
     TypeNum.NaturalT n) =>
-      C (Moog.Parameter n (Value a))
-        (Serial.Value d a) (Serial.Value d a) where
-   type Input  (Moog.Parameter n (Value a)) (Serial.Value d a) = (Serial.Value d a)
-   type Output (Moog.Parameter n (Value a)) (Serial.Value d a) = (Serial.Value d a)
+      C (Moog.Parameter n a) v v where
+   type Input  (Moog.Parameter n a) v = v
+   type Output (Moog.Parameter n a) v = v
    process =
-      CausalPS.pack Moog.causalP <<<
+      CausalPS.pack Moog.causal <<<
       first (arr Serial.constant)
 
 
 instance
    (Serial.C v, Serial.Element v ~ b, Phi a, Class.Undefined a,
-    A.PseudoModule a b, A.IntegerConstant a, Memory.C b) =>
+    a ~ A.Scalar b, A.PseudoModule b, A.IntegerConstant a, Memory.C b) =>
       C (UniFilter.Parameter a) v (UniFilter.Result v) where
    type Input  (UniFilter.Parameter a) (UniFilter.Result v) = v
    type Output (UniFilter.Parameter a) v = UniFilter.Result v
    process =
-      CausalPS.pack UniFilter.causalP <<<
+      CausalPS.pack UniFilter.causal <<<
       first (arr Serial.constant)
diff --git a/src/Synthesizer/LLVM/CausalParameterized/Functional.hs b/src/Synthesizer/LLVM/CausalParameterized/Functional.hs
--- a/src/Synthesizer/LLVM/CausalParameterized/Functional.hs
+++ b/src/Synthesizer/LLVM/CausalParameterized/Functional.hs
@@ -4,13 +4,15 @@
 {-# LANGUAGE Rank2Types #-}
 module Synthesizer.LLVM.CausalParameterized.Functional (
    T,
-   lift,
+   lift, fromSignal,
    ($&), (&|&),
    compile,
-   withArgs, MakeArguments, Arguments, makeArgs,
+   withArgs, compileSignal, MakeArguments, Arguments, makeArgs,
+   AnyArg(..),
    ) where
 
-import qualified Synthesizer.LLVM.CausalParameterized.Process as Causal
+import qualified Synthesizer.LLVM.CausalParameterized.ProcessPrivate as CausalP
+import qualified Synthesizer.LLVM.Parameterized.Signal as Signal
 import qualified Synthesizer.LLVM.Frame.Stereo as Stereo
 
 import qualified LLVM.Extra.MaybeContinuation as Maybe
@@ -38,7 +40,6 @@
 import qualified Control.Category as Cat
 import Control.Arrow (Arrow, (>>^), (&&&), arr, first, )
 import Control.Category (Category, (.), )
-import Control.Monad (liftM2, )
 import Control.Applicative (Applicative, (<*>), pure, )
 
 import Foreign.Storable (Storable, )
@@ -53,28 +54,29 @@
 newtype T p inp out = Cons (Code p inp out)
 
 
--- | similar to @Causal.T p a b@
+-- | similar to @CausalP.T p a b@
 data Code p a b =
-   forall state ioContext startParamTuple nextParamTuple.
-      (Storable startParamTuple,
-       Storable nextParamTuple,
-       MakeValueTuple startParamTuple,
-       MakeValueTuple nextParamTuple,
-       Memory.C (ValueTuple startParamTuple),
-       Memory.C (ValueTuple nextParamTuple),
+   forall context state ioContext parameters.
+      (Storable parameters,
+       MakeValueTuple parameters,
+       Memory.C (ValueTuple parameters),
+       Memory.C context,
        Memory.C state) =>
    Code
       (forall r c.
        (Phi c) =>
-       ValueTuple nextParamTuple ->
-       a -> state ->
+       context -> a -> state ->
        StateT Vault (Maybe.T r c) (b, state))
           -- compute next value
       (forall r.
-       ValueTuple startParamTuple ->
-       CodeGenFunction r state)
+       ValueTuple parameters ->
+       CodeGenFunction r (context, state))
           -- initial state
-      (p -> IO (ioContext, (nextParamTuple, startParamTuple)))
+      (forall r.
+       context -> state ->
+       CodeGenFunction r ())
+          -- cleanup
+      (p -> IO (ioContext, parameters))
           {- initialization from IO monad
           This will be run within Unsafe.performIO,
           so no observable In/Out actions please!
@@ -86,37 +88,27 @@
 
 instance Category (Code p) where
    id = arr id
-   Code nextB startB createIOContextB deleteIOContextB .
-      Code nextA startA createIOContextA deleteIOContextA = Code
-         (\(paramA, paramB) a (sa0,sb0) ->
-            do (b,sa1) <- nextA paramA a sa0
-               (c,sb1) <- nextB paramB b sb0
-               return (c, (sa1,sb1)))
-         (\(paramA, paramB) ->
-            liftM2 (,)
-               (startA paramA)
-               (startB paramB))
-         (\p -> do
-            (ca,(nextParamA,startParamA)) <- createIOContextA p
-            (cb,(nextParamB,startParamB)) <- createIOContextB p
-            return ((ca,cb),
-               ((nextParamA,  nextParamB),
-                (startParamA, startParamB))))
-         (\(ca,cb) ->
-            deleteIOContextA ca >>
-            deleteIOContextB cb)
+   Code nextB startB stopB createIOContextB deleteIOContextB .
+      Code nextA startA stopA createIOContextA deleteIOContextA = Code
+         (CausalP.composeNext
+             (State.mapStateT . Maybe.onFail)
+             stopA stopB nextA nextB)
+         (CausalP.composeStart startA startB)
+         (CausalP.composeStop stopA stopB)
+         (CausalP.composeCreate createIOContextA createIOContextB)
+         (CausalP.composeDelete deleteIOContextA deleteIOContextB)
 
+
 instance Arrow (Code p) where
    arr f = Code
-      (\ _p a state -> return (f a, state))
-      (const $ return ())
-      (const $ return ((),((),())))
+      (\ _p a () -> return (f a, ()))
+      (\() -> return ((),()))
+      (\() () -> return ())
+      (const $ return ((),()))
       (const $ return ())
-   first (Code next start create delete) = Code
-      (\ioContext (b,d) sa0 ->
-         do (c,sa1) <- next ioContext b sa0
-            return ((c,d), sa1))
-      start create delete
+   first (Code next start stop create delete) = Code
+      (CausalP.firstNext next) start stop
+      create delete
 
 
 {-
@@ -143,13 +135,13 @@
 
 
 lift0 :: (forall r. CodeGenFunction r out) -> T p inp out
-lift0 f = lift (Causal.mapSimple (const f))
+lift0 f = lift (CausalP.mapSimple (const f))
 
 lift1 :: (forall r. a -> CodeGenFunction r out) -> T p inp a -> T p inp out
-lift1 f x = Causal.mapSimple f $& x
+lift1 f x = CausalP.mapSimple f $& x
 
 lift2 :: (forall r. a -> b -> CodeGenFunction r out) -> T p inp a -> T p inp b -> T p inp out
-lift2 f x y = Causal.zipWithSimple f $& x&|&y
+lift2 f x y = CausalP.zipWithSimple f $& x&|&y
 
 
 instance (A.PseudoRing b, A.Real b, A.IntegerConstant b) => Num (T p a b) where
@@ -160,7 +152,11 @@
    abs = lift1 A.abs
    signum = lift1 A.signum
 
+instance (A.Field b, A.Real b, A.RationalConstant b) => Fractional (T p a b) where
+   fromRational x = pure (A.fromRational' x)
+   (/) = lift2 A.fdiv
 
+
 instance (A.Additive b) => Additive.C (T p a b) where
    zero = pure A.zero
    (+) = lift2 A.add
@@ -196,7 +192,7 @@
 
 infixr 0 $&
 
-($&) :: Causal.T p b c -> T p a b -> T p a c
+($&) :: CausalP.T p b c -> T p a b -> T p a c
 f $& (Cons b) =
    tagUnique $  liftCode f . b
 
@@ -208,17 +204,20 @@
    tagUnique $  b &&& c
 
 
-liftCode :: Causal.T p inp out -> Code p inp out
-liftCode (Causal.Cons next start create delete) =
+liftCode :: CausalP.T p inp out -> Code p inp out
+liftCode (CausalP.Cons next start stop create delete) =
    Code
       (\p a state -> Trans.lift (next p a state))
-      start create delete
+      start stop create delete
 
-lift :: Causal.T p inp out -> T p inp out
+lift :: CausalP.T p inp out -> T p inp out
 lift = tagUnique . liftCode
 
+fromSignal :: Signal.T p out -> T p inp out
+fromSignal = lift . CausalP.fromSignal
+
 tag :: Vault.Key out -> Code p inp out -> T p inp out
-tag key (Code next start create delete) =
+tag key (Code next start stop create delete) =
    Cons $
    Code
       (\p a s0 -> do
@@ -229,7 +228,7 @@
                bs@(b,_) <- next p a s0
                State.modify (Vault.insert key b)
                return bs)
-      start create delete
+      start stop create delete
 
 -- dummy for debugging
 _tag :: Vault.Key out -> Code p inp out -> T p inp out
@@ -240,16 +239,19 @@
    Unsafe.performIO $
    fmap (flip tag code) Vault.newKey
 
-initialize :: Code p inp out -> Causal.T p inp out
-initialize (Code next start create delete) =
-   Causal.Cons
+initialize :: Code p inp out -> CausalP.T p inp out
+initialize (Code next start stop create delete) =
+   CausalP.Cons
       (\p a state -> State.evalStateT (next p a state) Vault.empty)
-      start create delete
+      start stop create delete
 
-compile :: T p inp out -> Causal.T p inp out
+compile :: T p inp out -> CausalP.T p inp out
 compile (Cons code) = initialize code
 
+compileSignal :: T p () out -> Signal.T p out
+compileSignal f = CausalP.toSignal $ compile f
 
+
 {- |
 Using 'withArgs' you can simplify
 
@@ -264,12 +266,12 @@
 -}
 withArgs ::
    (MakeArguments inp) =>
-   (Arguments (T p inp) inp -> T p inp out) -> Causal.T p inp out
+   (Arguments (T p inp) inp -> T p inp out) -> CausalP.T p inp out
 withArgs = withArgsStart (lift Cat.id)
 
 withArgsStart ::
    (MakeArguments inp) =>
-   T p inp inp -> (Arguments (T p inp) inp -> T p inp out) -> Causal.T p inp out
+   T p inp inp -> (Arguments (T p inp) inp -> T p inp out) -> CausalP.T p inp out
 withArgsStart fid f = compile (f (makeArgs fid))
 
 
@@ -296,6 +298,10 @@
 instance MakeArguments (Stereo.T a) where
    makeArgs = id
 
+type instance Arguments f () = f ()
+instance MakeArguments () where
+   makeArgs = id
+
 type instance Arguments f (a,b) = (Arguments f a, Arguments f b)
 instance (MakeArguments a, MakeArguments b) =>
       MakeArguments (a,b) where
@@ -305,3 +311,10 @@
 instance (MakeArguments a, MakeArguments b, MakeArguments c) =>
       MakeArguments (a,b,c) where
    makeArgs f = (makeArgs $ fmap fst3 f, makeArgs $ fmap snd3 f, makeArgs $ fmap thd3 f)
+
+
+newtype AnyArg a = AnyArg {getAnyArg :: a}
+
+type instance Arguments f (AnyArg a) = f a
+instance MakeArguments (AnyArg a) where
+   makeArgs = fmap getAnyArg
diff --git a/src/Synthesizer/LLVM/CausalParameterized/FunctionalPlug.hs b/src/Synthesizer/LLVM/CausalParameterized/FunctionalPlug.hs
--- a/src/Synthesizer/LLVM/CausalParameterized/FunctionalPlug.hs
+++ b/src/Synthesizer/LLVM/CausalParameterized/FunctionalPlug.hs
@@ -14,7 +14,7 @@
 import qualified Synthesizer.LLVM.Plug.Input as PIn
 import qualified Synthesizer.LLVM.Plug.Output as POut
 
-import qualified Synthesizer.LLVM.CausalParameterized.Process as Causal
+import qualified Synthesizer.LLVM.CausalParameterized.Process as CausalP
 import qualified Synthesizer.LLVM.Parameterized.Signal as Sig
 
 import qualified Synthesizer.CausalIO.Process as PIO
@@ -43,9 +43,9 @@
 import Data.Unique (Unique, newUnique, )
 import Data.Maybe (fromMaybe, )
 
-import Control.Arrow (Arrow, (^<<), (<<^), arr, first, second, )
-import Control.Category (Category, id, (.), )
-import Control.Applicative (Applicative, (<*>), pure, liftA2, )
+import Control.Arrow ((^<<), (<<^), arr, first, second, )
+import Control.Category (id, (.), )
+import Control.Applicative (Applicative, (<*>), pure, liftA2, liftA3, )
 
 import qualified System.Unsafe as Unsafe
 
@@ -62,7 +62,7 @@
 whether we have already seen a certain object.
 If we encounter a known object
 then we use the Simple constructor
-and fetch the stored Causal output
+and fetch the stored CausalP output
 within the causal process enclosed in Simple.
 This and the causal process in the Plugged constructor
 are the second level.
@@ -82,23 +82,23 @@
    Plugged
       (pp -> inp -> x)
       (PIn.T x y)
-      (Causal.T pl (y, Vault) (out, Vault))
+      (CausalP.T pl (y, Vault) (out, Vault))
    |
    {-
-   The Simple constructor is needed for reusing shared Causal processes
+   The Simple constructor is needed for reusing shared CausalP processes
    and for input without external representation. (a Plug.Input)
    -}
-   Simple (Causal.T pl Vault (out, Vault))
+   Simple (CausalP.T pl Vault (out, Vault))
 
 
 applyCore ::
-   Causal.T pl a b ->
+   CausalP.T pl (a, Vault) (b, Vault) ->
    Core pp pl inp a ->
    Core pp pl inp b
-applyCore f (Plugged prep plg process) =
-   Plugged prep plg (first f . process)
-applyCore f (Simple process) =
-   Simple (first f . process)
+applyCore f core =
+   case core of
+      Plugged prep plg process -> Plugged prep plg (f . process)
+      Simple process -> Simple (f . process)
 
 combineCore ::
    Core pp pl inp a ->
@@ -123,9 +123,9 @@
 
 reuseCore :: Vault.Key out -> Core pp pl inp out
 reuseCore key =
-   Simple (arr (\vault ->
+   Simple $ arr $ \vault ->
       (fromMaybe (error "key must have been lost") $ Vault.lookup key vault,
-       vault)))
+       vault)
 
 
 tag ::
@@ -138,31 +138,24 @@
       then return $ reuseCore key
       else do
          MS.modify (Set.insert unique)
-         core <- stateCore
-         let store (a,v) = (a, Vault.insert key a v)
-         return $
-            case core of
-               Plugged prep plg process ->
-                  Plugged prep plg (store ^<< process)
-               Simple process ->
-                  Simple (store ^<< process)
+         fmap (applyCore (arr $ \(a,v) -> (a, Vault.insert key a v))) stateCore
 
 tagUnique ::
    MS.State (Set.Set Unique) (Core pp pl inp out) ->
    T pp pl inp out
 tagUnique core =
    Unsafe.performIO $
-   fmap ($ core) $ liftA2 tag newUnique Vault.newKey
+   liftA3 tag newUnique Vault.newKey (pure core)
 
 
 infixr 0 $&
 
 ($&) ::
-   Causal.T pl a b ->
+   CausalP.T pl a b ->
    T pp pl inp a ->
    T pp pl inp b
 f  $&  Cons core =
-   tagUnique $ fmap (applyCore f) core
+   tagUnique $ fmap (applyCore $ first f) core
 
 
 infixr 3 &|&
@@ -184,7 +177,7 @@
    f <*> x = fmap (uncurry ($))  $  combineCore f x
 
 lift0Core :: (forall r. CodeGenFunction r out) -> Core pp pl inp out
-lift0Core f = Simple (Causal.mapSimple (\v -> fmap (flip (,) v) f))
+lift0Core f = Simple (CausalP.mapSimple (\v -> fmap (flip (,) v) f))
 
 
 instance Functor (T pp pl inp) where
@@ -199,10 +192,10 @@
 lift0 f = tagUnique $ pure $ lift0Core f
 
 lift1 :: (forall r. a -> CodeGenFunction r out) -> T pp pl inp a -> T pp pl inp out
-lift1 f x = Causal.mapSimple f $& x
+lift1 f x = CausalP.mapSimple f $& x
 
 lift2 :: (forall r. a -> b -> CodeGenFunction r out) -> T pp pl inp a -> T pp pl inp b -> T pp pl inp out
-lift2 f x y = Causal.zipWithSimple f $& x&|&y
+lift2 f x y = CausalP.zipWithSimple f $& x&|&y
 
 
 instance (A.PseudoRing b, A.Real b, A.IntegerConstant b) => Num (T pp pl a b) where
@@ -213,7 +206,11 @@
    abs = lift1 A.abs
    signum = lift1 A.signum
 
+instance (A.Field b, A.Real b, A.RationalConstant b) => Fractional (T pp pl a b) where
+   fromRational x = pure (A.fromRational' x)
+   (/) = lift2 A.fdiv
 
+
 instance (A.Additive b) => Additive.C (T pp pl a b) where
    zero = pure A.zero
    (+) = lift2 A.add
@@ -252,7 +249,7 @@
    Sig.T pl a ->
    T pp pl inp a
 fromSignal sig =
-   tagUnique $ pure $ Simple (Causal.feedFst sig)
+   tagUnique $ pure $ Simple (CausalP.feedFst sig)
 
 
 
@@ -280,14 +277,14 @@
    case MS.evalState core Set.empty of
       Plugged prep pin process ->
          fmap (\f pp pl -> f pl <<^ prep pp) $
-         Causal.processIOCore
+         CausalP.processIOCore
             pin
             (fst ^<< process <<^ flip (,) Vault.empty)
             pout
       Simple _ ->
          error "FunctionalPlug.runPlugOut: no substantial input available"
          -- Simple process ->
-         --    Causal.processIOCore pin process pout
+         --    CausalP.processIOCore pin process pout
 
 run ::
    (POut.Default b) =>
diff --git a/src/Synthesizer/LLVM/CausalParameterized/Helix.hs b/src/Synthesizer/LLVM/CausalParameterized/Helix.hs
new file mode 100644
--- /dev/null
+++ b/src/Synthesizer/LLVM/CausalParameterized/Helix.hs
@@ -0,0 +1,646 @@
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE Rank2Types #-}
+{- |
+<http://arxiv.org/abs/0911.5171>
+-}
+module Synthesizer.LLVM.CausalParameterized.Helix (
+   -- * time and phase control based on the helix model
+   static,
+   staticPacked,
+   dynamic,
+   dynamicLimited,
+
+   -- * useful control curves
+   zigZag,
+   zigZagPacked,
+   zigZagLong,
+   zigZagLongPacked,
+   ) where
+
+import qualified Synthesizer.LLVM.CausalParameterized.ProcessValue as CausalPV
+import qualified Synthesizer.LLVM.CausalParameterized.ProcessPacked as CausalPS
+import qualified Synthesizer.LLVM.CausalParameterized.Process as CausalP
+import qualified Synthesizer.LLVM.CausalParameterized.Functional as Func
+import qualified Synthesizer.LLVM.Parameterized.SignalPacked as SigPS
+import qualified Synthesizer.LLVM.Parameterized.Signal as SigP
+import qualified Synthesizer.LLVM.RingBufferForward as RingBuffer
+import qualified Synthesizer.LLVM.Frame.SerialVector as Serial
+import qualified Synthesizer.LLVM.Simple.Value as Value
+import qualified Synthesizer.LLVM.Interpolation as Ip
+import qualified Synthesizer.LLVM.Parameter as Param
+import Synthesizer.LLVM.CausalParameterized.Functional (($&), (&|&), )
+import Synthesizer.LLVM.CausalParameterized.Process (($*), ($<), )
+import Synthesizer.LLVM.Simple.Value ((%>), (%>=), (?), (??), )
+
+import qualified Synthesizer.LLVM.Storable.Vector as SVU
+import qualified Data.StorableVector as SV
+
+import qualified LLVM.Extra.ScalarOrVector as SoV
+import qualified LLVM.Extra.Vector as Vector
+import qualified LLVM.Extra.Arithmetic as A
+import qualified LLVM.Extra.Memory as Memory
+import qualified LLVM.Extra.MaybeContinuation as MaybeCont
+import LLVM.Extra.Class (MakeValueTuple, ValueTuple, )
+
+import qualified LLVM.Core as LLVM
+import LLVM.Core (CodeGenFunction, Value, IsSized, IsFloating, )
+
+import qualified Types.Data.Num as TypeNum
+import Types.Data.Num (D1, )
+
+import Data.Word (Word32, )
+
+import Foreign.ForeignPtr (touchForeignPtr, )
+import Foreign.Storable (Storable, )
+
+import Control.Arrow (first, (<<<), (^<<), (<<^), )
+import Control.Category (id, )
+import Control.Applicative (liftA2, )
+import Control.Functor.HT (unzip, )
+import Data.Traversable (mapM, )
+import Data.Tuple.HT (mapFst, )
+
+import qualified Algebra.Field as Field
+import qualified Algebra.Ring as Ring
+
+import NumericPrelude.Numeric hiding (splitFraction, )
+import NumericPrelude.Base hiding (unzip, zip, mapM, id, )
+
+import Prelude ()
+
+
+{- |
+Inputs are @(shape, phase)@.
+
+The shape parameter is limited at the beginning and at the end
+such that only available data is used for interpolation.
+Actually, we allow almost one step less than possible,
+since the right boundary of the interval of admissible @shape@ values is open.
+-}
+static ::
+   (Storable vh, MakeValueTuple vh, ValueTuple vh ~ v, Memory.C v,
+    Ip.C nodesStep, Ip.C nodesLeap,
+    SoV.RationalConstant a, SoV.Fraction a,
+    Storable a, MakeValueTuple a, ValueTuple a ~ Value a,
+    Memory.FirstClass a, Memory.Stored a ~ am, IsSized am,
+    LLVM.NumberOfElements a ~ D1) =>
+   (forall r. Ip.T r nodesLeap (Value a) v) ->
+   (forall r. Ip.T r nodesStep (Value a) v) ->
+   Param.T p Int ->
+   Param.T p a ->
+   Param.T p (SV.Vector vh) ->
+   CausalP.T p (Value a, Value a) v
+static ipLeap ipStep periodInt period vec =
+   let period32 = Param.word32 periodInt
+       cellMargin = combineMarginParams ipLeap ipStep periodInt
+   in  interpolateCell ipLeap ipStep
+       <<<
+       first (peekCell cellMargin period32 vec)
+       <<<
+       flattenShapePhaseProc period32 period
+       <<<
+       first
+          (limitShape cellMargin period32
+              (Param.word32 $ fmap SV.length vec))
+
+
+staticPacked ::
+   (Storable vh, MakeValueTuple vh, ValueTuple vh ~ ve,
+    Serial.Element v ~ ve, Memory.C ve,
+    Ip.C nodesStep, Ip.C nodesLeap,
+    Serial.Size (nodesLeap (nodesStep v)) ~ n,
+    Serial.C (nodesLeap (nodesStep v)),
+    Serial.Element (nodesLeap (nodesStep v)) ~
+       nodesLeap (nodesStep (Serial.Element v)),
+    TypeNum.PositiveT n,
+    SoV.RationalConstant a, SoV.Fraction a, Vector.Real a,
+    Storable a, MakeValueTuple a, ValueTuple a ~ Value a,
+    Memory.FirstClass a, Memory.Stored a ~ am, IsSized am,
+    LLVM.IsPrimitive a, LLVM.IsPrimitive am) =>
+   (forall r. Ip.T r nodesLeap (Serial.Value n a) v) ->
+   (forall r. Ip.T r nodesStep (Serial.Value n a) v) ->
+   Param.T p Int ->
+   Param.T p a ->
+   Param.T p (SV.Vector vh) ->
+   CausalP.T p (Serial.Value n a, Serial.Value n a) v
+staticPacked ipLeap ipStep periodInt period vec =
+   let period32 = Param.word32 periodInt
+       cellMargin = combineMarginParams ipLeap ipStep periodInt
+   in  interpolateCell ipLeap ipStep
+       <<<
+       first (CausalPS.pack
+          (peekCell (fmap elementMargin cellMargin) period32 vec))
+       <<<
+       flattenShapePhaseProcPacked period32 period
+       <<<
+       first
+          (limitShapePacked cellMargin period32
+              (Param.word32 $ fmap SV.length vec))
+
+
+{- |
+In contrast to 'dynamic' this one ends
+when the end of the manipulated signal is reached.
+-}
+dynamicLimited ::
+   (Ip.C nodesStep, Ip.C nodesLeap,
+    A.Additive v, Memory.C v,
+    SoV.RationalConstant a, SoV.Fraction a,
+    LLVM.CmpRet a, LLVM.CmpResult a ~ Bool,
+    Storable a, MakeValueTuple a, ValueTuple a ~ Value a,
+    Memory.FirstClass a, Memory.Stored a ~ am, IsSized am,
+    LLVM.NumberOfElements a ~ D1) =>
+   (forall r. Ip.T r nodesLeap (Value a) v) ->
+   (forall r. Ip.T r nodesStep (Value a) v) ->
+   Param.T p Int ->
+   Param.T p a ->
+   SigP.T p v ->
+   CausalP.T p (Value a, Value a) v
+dynamicLimited ipLeap ipStep periodInt period sig =
+   dynamicGen
+      (\cellMargin (skips, fracs) ->
+         let windows =
+                RingBuffer.trackSkip (fmap Ip.marginNumber cellMargin) sig $& skips
+         in  (windows,
+              CausalP.delay1Zero $& skips,
+              CausalP.delay1Zero $& fracs))
+      ipLeap ipStep periodInt period
+
+{- |
+If the time control exceeds the end of the input signal,
+then the last waveform is locked.
+This is analogous to 'static'.
+-}
+dynamic ::
+   (Ip.C nodesStep, Ip.C nodesLeap,
+    A.Additive v, Memory.C v,
+    SoV.RationalConstant a, SoV.Fraction a,
+    LLVM.CmpRet a, LLVM.CmpResult a ~ Bool,
+    Storable a, MakeValueTuple a, ValueTuple a ~ Value a,
+    Memory.FirstClass a, Memory.Stored a ~ am, IsSized am,
+    LLVM.NumberOfElements a ~ D1) =>
+   (forall r. Ip.T r nodesLeap (Value a) v) ->
+   (forall r. Ip.T r nodesStep (Value a) v) ->
+   Param.T p Int ->
+   Param.T p a ->
+   SigP.T p v ->
+   CausalP.T p (Value a, Value a) v
+dynamic ipLeap ipStep periodInt period sig =
+   dynamicGen
+      (\cellMargin (skips, fracs) ->
+         let {-
+             For conformance with 'static'
+             we stop one step before the definite end.
+             We achieve this by using a buffer
+             that is one step longer than necessary.
+             -}
+             ((running, actualSkips), windows) =
+                mapFst unzip $ unzip $
+                RingBuffer.trackSkipHold
+                   (fmap (succ . Ip.marginNumber) cellMargin) sig $& skips
+             holdFracs =
+                CausalPV.zipWithSimple (\r fr -> r ? (fr, 1))
+                $&
+                running &|& (CausalP.delay1Zero $& fracs)
+         in  (windows, actualSkips, holdFracs))
+      ipLeap ipStep periodInt period
+
+dynamicGen ::
+   (Ip.C nodesStep, Ip.C nodesLeap,
+    A.Additive v, Memory.C v,
+    SoV.RationalConstant a, SoV.Fraction a,
+    LLVM.CmpRet a, LLVM.CmpResult a ~ Bool,
+    Storable a, MakeValueTuple a, ValueTuple a ~ Value a,
+    Memory.FirstClass a, Memory.Stored a ~ am, IsSized am,
+    LLVM.NumberOfElements a ~ D1) =>
+   (Param.T p (Ip.Margin (nodesLeap (nodesStep v))) ->
+    (Func.T p (Value a, Value a) (Value Word32),
+     Func.T p (Value a, Value a) (Value a)) ->
+    (Func.T p (Value a, Value a) (RingBuffer.T v),
+     Func.T p (Value a, Value a) (Value Word32),
+     Func.T p (Value a, Value a) (Value a))) ->
+   (forall r. Ip.T r nodesLeap (Value a) v) ->
+   (forall r. Ip.T r nodesStep (Value a) v) ->
+   Param.T p Int ->
+   Param.T p a ->
+   CausalP.T p (Value a, Value a) v
+dynamicGen limitMaxShape ipLeap ipStep periodInt period =
+   let period32 = Param.word32 periodInt
+       cellMargin = combineMarginParams ipLeap ipStep periodInt
+       minShape =
+          Param.word32 $ fmap fst $
+          liftA2 shapeMargin cellMargin periodInt
+
+   in  Func.withArgs $ \(shape, phase) ->
+          let (windows, skips, fracs) =
+                 limitMaxShape cellMargin $
+                 unzip (integrateFrac $& (limitMinShape minShape $& shape))
+              (offsets, shapePhases) =
+                 unzip
+                    (flattenShapePhaseProc period32 period $&
+                       (constantFromWord32 minShape + fracs)
+                       &|&
+                       (CausalP.osciCoreSync $&
+                          phase
+                          &|&
+                          negate
+                             (CausalPV.map (flip (/)) period $&
+                                (CausalP.mapSimple LLVM.inttofp $& skips))))
+          in  interpolateCell ipLeap ipStep $&
+                 (CausalP.map (uncurry . cellFromBuffer) period32
+                  $&
+                  windows
+                  &|&
+                  offsets)
+                 &|&
+                 shapePhases
+
+constantFromWord32 ::
+   (IsFloating a, LLVM.NumberOfElements a ~ TypeNum.D1) =>
+   Param.T p Word32 -> Func.T p inp (Value a)
+constantFromWord32 x =
+   Func.fromSignal
+      (CausalP.mapSimple LLVM.inttofp $* SigP.constant x)
+
+limitMinShape ::
+   (Storable a, Memory.FirstClass a, Memory.Stored a ~ am, IsSized am,
+    LLVM.NumberOfElements a ~ TypeNum.D1,
+    LLVM.IsFloating a, LLVM.CmpRet a, LLVM.CmpResult a ~ Bool) =>
+   Param.T p Word32 ->
+   CausalP.T p (Value a) (Value a)
+limitMinShape xLim =
+   CausalPV.mapAccum
+      (\_ x lim -> (x%>=lim) ? ((x-lim,zero), (zero,lim-x)))
+      (Value.lift1 LLVM.inttofp) (return ()) xLim
+
+integrateFrac ::
+   (IsFloating a,
+    Memory.FirstClass a, Memory.Stored a ~ am, IsSized am,
+    LLVM.NumberOfElements a ~ TypeNum.D1) =>
+   CausalP.T p (Value a) (Value Word32, Value a)
+integrateFrac =
+   CausalP.mapAccumSimple
+      (\a (_n,frac) -> do
+         s <- splitFraction =<< A.add a frac
+         return (s, s))
+      (return (A.zero, A.zero))
+
+
+interpolateCell ::
+   (Ip.C nodesStep, Ip.C nodesLeap) =>
+   (forall r. Ip.T r nodesLeap a v) ->
+   (forall r. Ip.T r nodesStep a v) ->
+   CausalP.T p (nodesLeap (nodesStep v), (a, a)) v
+interpolateCell ipLeap ipStep =
+   CausalP.mapSimple
+      (\(nodes, (leap,step)) ->
+         ipLeap leap =<< mapM (ipStep step) nodes)
+
+cellFromBuffer ::
+   (Memory.C a, Ip.C nodesLeap, Ip.C nodesStep) =>
+   Value Word32 ->
+   RingBuffer.T a ->
+   Value Word32 ->
+   CodeGenFunction r (nodesLeap (nodesStep a))
+cellFromBuffer periodInt buffer offset =
+   Ip.indexNodes
+      (Ip.indexNodes (flip RingBuffer.index buffer) A.one)
+      periodInt offset
+
+elementMargin ::
+   Ip.Margin (nodesLeap (nodesStep v)) ->
+   Ip.Margin (nodesLeap (nodesStep (Serial.Element v)))
+elementMargin (Ip.Margin x y) = Ip.Margin x y
+
+peekCell ::
+   (Storable a, MakeValueTuple a, ValueTuple a ~ value, Memory.C value,
+    Ip.C nodesLeap, Ip.C nodesStep) =>
+   Param.T p (Ip.Margin (nodesLeap (nodesStep value))) ->
+   Param.T p Word32 ->
+   Param.T p (SV.Vector a) ->
+   CausalP.T p (Value Word32) (nodesLeap (nodesStep value))
+peekCell margin period32 vec =
+   Param.with (Param.word32 $ fmap Ip.marginOffset margin) $ \getOffset valueOffset ->
+   Param.with period32 $ \getPeriod valuePeriod -> CausalP.Cons
+      (\(p,off,per) n () -> MaybeCont.lift $ do
+         offset <- A.sub n (valueOffset off)
+         nodes <-
+            Ip.loadNodes (Ip.loadNodes Memory.load A.one) (valuePeriod per)
+               =<< LLVM.getElementPtr p (offset, ())
+         return (nodes, ()))
+      (return . flip (,) ())
+      (const $ const $ return ())
+      (\p ->
+         let (fp,ptr,_l) = SVU.unsafeToPointers $ Param.get vec p
+         in  return (fp, (ptr, getOffset p, getPeriod p)))
+      touchForeignPtr
+
+
+flattenShapePhaseProc ::
+   (IsFloating a, SoV.Fraction a, SoV.RationalConstant a,
+    Storable ah, MakeValueTuple ah, ValueTuple ah ~ Value a,
+    Memory.FirstClass a, Memory.Stored a ~ am, IsSized am,
+    LLVM.NumberOfElements a ~ D1) =>
+   Param.T p Word32 ->
+   Param.T p ah ->
+   CausalP.T p
+      (Value a, Value a)
+      (Value Word32, (Value a, Value a))
+flattenShapePhaseProc period32 period =
+   CausalP.map
+      (\(perInt, per) (shape, phase) ->
+         flattenShapePhase perInt per shape phase)
+      (liftA2 (,) period32 period)
+
+flattenShapePhaseProcPacked ::
+   (IsFloating a, Vector.Real a, SoV.RationalConstant a,
+    Storable ah, MakeValueTuple ah, ValueTuple ah ~ Value a,
+    Memory.FirstClass a, Memory.Stored a ~ am, IsSized am,
+    TypeNum.PositiveT n) =>
+   Param.T p Word32 ->
+   Param.T p ah ->
+   CausalP.T p
+      (Serial.Value n a, Serial.Value n a)
+      (Serial.Value n Word32,
+       (Serial.Value n a, Serial.Value n a))
+flattenShapePhaseProcPacked period32 period =
+   CausalP.map
+      (\(perInt, per) (Serial.Cons shape, Serial.Cons phase) -> do
+         perIntVec <- SoV.replicate perInt
+         perVec <- SoV.replicate per
+         (i, (leap, step)) <-
+            flattenShapePhase perIntVec perVec shape phase
+         return (Serial.Cons i, (Serial.Cons leap, Serial.Cons step)))
+      (liftA2 (,) period32 period)
+
+flattenShapePhase ::
+   (IsFloating a, SoV.Fraction a, SoV.RationalConstant a,
+    LLVM.NumberOfElements a ~ LLVM.NumberOfElements i,
+    LLVM.IsInteger i) =>
+   Value i ->
+   Value a ->
+   Value a -> Value a ->
+   CodeGenFunction r (Value i, (Value a, Value a))
+flattenShapePhase = Value.unlift4 $ \periodInt period shape phase ->
+   let qLeap = Value.lift1 A.fraction $ shape/period - phase
+       (n,qStep) =
+          unzip $ Value.lift1 splitFraction $
+          {-
+          If 'shape' is correctly limited,
+          the value is always non-negative algebraically,
+          but maybe not numerically.
+          -}
+          Value.max zero $
+          shape - qLeap * Value.lift1 LLVM.inttofp periodInt
+   in  (n,(qLeap,qStep))
+
+{- |
+You must make sure, that the argument is non-negative.
+-}
+splitFraction ::
+   (IsFloating a, LLVM.IsInteger i,
+    LLVM.NumberOfElements a ~ LLVM.NumberOfElements i) =>
+   Value a -> CodeGenFunction r (Value i, Value a)
+splitFraction x = do
+   n <- LLVM.fptoint x
+   frac <- A.sub x =<< LLVM.inttofp n
+   return (n, frac)
+
+
+limitShape ::
+   (Memory.FirstClass t, Memory.Stored t ~ tm, IsSized tm,
+    IsFloating t, SoV.Real t,
+    LLVM.NumberOfElements t ~ LLVM.NumberOfElements i,
+    MakeValueTuple i, ValueTuple i ~ Value i,
+    Ring.C i, LLVM.IsInteger i, SoV.IntegerConstant i,
+    Storable i, Memory.FirstClass i, Memory.Stored i ~ im, IsSized im,
+    Ip.C nodesStep, Ip.C nodesLeap) =>
+   Param.T p (Ip.Margin (nodesLeap (nodesStep value))) ->
+   Param.T p i ->
+   Param.T p i ->
+   CausalP.T p (Value t) (Value t)
+limitShape margin periodInt len =
+   CausalPV.zipWithSimple (Value.limit . unzip)
+   $<
+   limitShapeSignal margin periodInt len
+
+limitShapePacked ::
+   (Memory.FirstClass t, Memory.Stored t ~ tm,
+    IsSized tm, LLVM.IsPrimitive tm,
+    LLVM.SizeOf tm ~ tmsize,
+    IsFloating t, LLVM.IsPrimitive t, Vector.Real t,
+    TypeNum.PositiveT n,
+    Ip.C nodesStep, Ip.C nodesLeap) =>
+   Param.T p (Ip.Margin (nodesLeap (nodesStep value))) ->
+   Param.T p Word32 ->
+   Param.T p Word32 ->
+   CausalP.T p (Serial.Value n t) (Serial.Value n t)
+limitShapePacked margin periodInt len =
+   CausalPV.zipWithSimple
+      (\minmax shape ->
+         let (minShape,maxShape) = unzip minmax
+         in  Value.limit
+                (Value.lift1 Serial.upsample minShape,
+                 Value.lift1 Serial.upsample maxShape)
+                shape)
+   $<
+   limitShapeSignal margin periodInt len
+
+limitShapeSignal ::
+   (Memory.FirstClass t, Memory.Stored t ~ tm, IsSized tm,
+    IsFloating t,
+    LLVM.NumberOfElements t ~ LLVM.NumberOfElements i,
+    MakeValueTuple i, ValueTuple i ~ Value i,
+    Ring.C i, LLVM.IsInteger i, SoV.IntegerConstant i,
+    Storable i, Memory.FirstClass i, Memory.Stored i ~ im, IsSized im,
+    Ip.C nodesStep, Ip.C nodesLeap) =>
+   Param.T p (Ip.Margin (nodesLeap (nodesStep value))) ->
+   Param.T p i ->
+   Param.T p i ->
+   SigP.T p (Value t, Value t)
+limitShapeSignal margin periodInt len =
+   SigP.Cons
+      (\minMax () -> return (minMax, ()))
+      (\(minShapeInt, maxShapeInt) -> do
+         minShape <- LLVM.inttofp minShapeInt
+         maxShape <- LLVM.inttofp maxShapeInt
+         return ((minShape, maxShape), ()))
+      (const $ const $ return ())
+      (\p -> return ((),
+         shapeLimits
+            (Param.get margin p)
+            (Param.get periodInt p)
+            (Param.get len p)))
+      (const $ return ())
+
+
+_limitShape ::
+   (Ring.C th, Storable th, MakeValueTuple th, ValueTuple th ~ t,
+    Memory.C t, A.Real t,
+    Ip.C nodesStep, Ip.C nodesLeap) =>
+   Ip.Margin (nodesLeap (nodesStep value)) ->
+   Param.T p th ->
+   Param.T p th ->
+   CausalP.T p t t
+_limitShape margin periodInt len =
+   CausalP.Cons
+      (\(minShape,maxShape) shape () -> MaybeCont.lift $ do
+         limited <- A.min maxShape =<< A.max minShape shape
+         return (limited, ()))
+      (\minmax -> return (minmax, ()))
+      (const $ const $ return ())
+      (\p ->
+         return
+            ((),
+             shapeLimits margin
+                (Param.get periodInt p)
+                (Param.get len p)))
+      (const $ return ())
+
+shapeLimits ::
+   (Ip.C nodesLeap, Ip.C nodesStep, Ring.C t) =>
+   Ip.Margin (nodesLeap (nodesStep value)) ->
+   t ->
+   t ->
+   (t, t)
+shapeLimits margin periodInt len =
+   case shapeMargin margin periodInt of
+      (leftMargin, rightMargin) ->
+         (leftMargin, len - rightMargin)
+
+_shapeLimits ::
+   (Ip.C nodesLeap, Ip.C nodesStep,
+    IsFloating t, LLVM.NumberOfElements t ~ D1) =>
+   Ip.Margin (nodesLeap (nodesStep value)) ->
+   Value.T (Value Word32) ->
+   Value.T (Value t) ->
+   (Value.T (Value t), Value.T (Value t))
+_shapeLimits margin periodInt len =
+   let (leftMargin, rightMargin) = shapeMargin margin periodInt
+   in  (Value.lift1 LLVM.inttofp leftMargin,
+        len - Value.lift1 LLVM.inttofp rightMargin)
+
+shapeMargin ::
+   (Ip.C nodesLeap, Ip.C nodesStep, Ring.C i) =>
+   Ip.Margin (nodesLeap (nodesStep value)) ->
+   i -> (i, i)
+shapeMargin margin periodInt =
+   let leftMargin = fromIntegral (Ip.marginOffset margin) + periodInt
+       rightMargin = fromIntegral (Ip.marginNumber margin) - leftMargin
+   in  (leftMargin, rightMargin)
+
+combineMarginParams ::
+   (Ip.C nodesStep, Ip.C nodesLeap) =>
+   (forall r. Ip.T r nodesLeap a v) ->
+   (forall r. Ip.T r nodesStep a v) ->
+   Param.T p Int ->
+   Param.T p (Ip.Margin (nodesLeap (nodesStep v)))
+combineMarginParams ipLeap ipStep periodInt =
+   fmap
+      (combineMargins (Ip.toMargin ipLeap) (Ip.toMargin ipStep))
+      periodInt
+
+combineMargins ::
+   Ip.Margin (nodesLeap value) ->
+   Ip.Margin (nodesStep value) ->
+   Int ->
+   Ip.Margin (nodesLeap (nodesStep value))
+combineMargins marginLeap marginStep periodInt =
+   Ip.Margin {
+      Ip.marginNumber =
+         Ip.marginNumber marginStep +
+         Ip.marginNumber marginLeap * periodInt,
+      Ip.marginOffset =
+         Ip.marginOffset marginStep +
+         Ip.marginOffset marginLeap * periodInt
+   }
+
+
+zigZagLong ::
+   (Storable a, MakeValueTuple a, ValueTuple a ~ Value a,
+    Memory.FirstClass a, Memory.Stored a ~ am, IsSized am,
+    SoV.Fraction a, IsFloating a, SoV.RationalConstant a, LLVM.CmpRet a,
+    Field.C a) =>
+   Param.T p a ->
+   Param.T p a ->
+   CausalP.T p (Value a) (Value a)
+zigZagLong =
+   zigZagLongGen (CausalP.fromSignal . SigP.constant) zigZag
+
+zigZagLongPacked ::
+   (Storable a, MakeValueTuple a, ValueTuple a ~ Value a,
+    SoV.Fraction a, SoV.RationalConstant a, Vector.Real a,
+    Memory.FirstClass a, Memory.Stored a ~ am, IsSized a, IsSized am,
+    LLVM.IsPrimitive am,
+    Field.C a,
+    (n TypeNum.:*: LLVM.SizeOf am) ~ amsize,
+    TypeNum.PositiveT amsize,
+    TypeNum.PositiveT n) =>
+   Param.T p a ->
+   Param.T p a ->
+   CausalP.T p (Serial.Value n a) (Serial.Value n a)
+zigZagLongPacked =
+   zigZagLongGen (CausalP.fromSignal . SigPS.constant) zigZagPacked
+
+zigZagLongGen ::
+   (A.RationalConstant al, A.Field al, Field.C a) =>
+   (Param.T p a -> CausalP.T p al al) ->
+   (Param.T p a -> CausalP.T p al al) ->
+   Param.T p a ->
+   Param.T p a ->
+   CausalP.T p al al
+zigZagLongGen constant zz prefix loop =
+   zz (negate $ prefix/loop) * constant loop + constant prefix
+   <<<
+   id / constant loop
+
+zigZag ::
+   (Storable a, MakeValueTuple a, ValueTuple a ~ Value a,
+    Memory.FirstClass a, Memory.Stored a ~ am, IsSized am,
+    SoV.Fraction a, IsFloating a, SoV.RationalConstant a,
+    LLVM.CmpRet a) =>
+   Param.T p a ->
+   CausalP.T p (Value a) (Value a)
+zigZag start =
+   CausalPV.mapSimple (\x -> 1-abs (1-x))
+   <<<
+   CausalPV.mapAccum
+      (\_ d t0 ->
+         let t1 = t0+d
+         in  (t0, wrap (curry . (??)) t1))
+      id (return ()) start
+
+zigZagPacked ::
+   (Storable a, MakeValueTuple a, ValueTuple a ~ Value a,
+    Memory.FirstClass a, Memory.Stored a ~ am, IsSized am,
+    SoV.Fraction a, Vector.Real a, IsFloating a, SoV.RationalConstant a,
+    LLVM.CmpRet a,
+    TypeNum.PositiveT n) =>
+   Param.T p a ->
+   CausalP.T p (Serial.Value n a) (Serial.Value n a)
+zigZagPacked start =
+   Serial.Cons
+   ^<<
+   CausalPV.mapSimple (\x -> 1 - abs (1-x))
+   <<<
+   CausalPV.mapAccum
+      (\_ d t0 ->
+         let (t1, cum) = unzip $ Value.lift2 Vector.cumulate t0 d
+         {-
+         Vector.select can be replaced by (??)
+         once vector select is implemented by LLVM.
+         -}
+         in  (wrap (Value.lift3 Vector.select) cum, t1))
+      id (return ()) start
+   <<^
+   (\(Serial.Cons v) -> v)
+
+wrap ::
+   (SoV.RationalConstant a, IsFloating a, SoV.Fraction a, LLVM.CmpRet a) =>
+   (Value.T (Value (LLVM.CmpResult a)) ->
+    Value.T (Value a) ->
+    Value.T (Value a) ->
+    Value.T (Value a)) ->
+   Value.T (Value a) -> Value.T (Value a)
+wrap select a = select (a%>0) (2 * Value.fraction (a/2)) a
diff --git a/src/Synthesizer/LLVM/CausalParameterized/Process.hs b/src/Synthesizer/LLVM/CausalParameterized/Process.hs
--- a/src/Synthesizer/LLVM/CausalParameterized/Process.hs
+++ b/src/Synthesizer/LLVM/CausalParameterized/Process.hs
@@ -1,44 +1,108 @@
 {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE ExistentialQuantification #-}
 {-# LANGUAGE Rank2Types #-}
 {-# LANGUAGE ForeignFunctionInterface #-}
 module Synthesizer.LLVM.CausalParameterized.Process (
    T(Cons), simple,
    fromSignal, toSignal,
-   mapAccum, map, mapSimple, zipWithSimple,
+   mapAccum, map, mapSimple, zipWith, zipWithSimple,
    apply, compose, first,
    feedFst, feedSnd,
-   loop, take, takeWhile, integrate,
-   module Synthesizer.LLVM.CausalParameterized.Process
+   loop, loopZero, take, takeWhile, integrate,
+
+   ($<), ($>), ($*), ($<#), ($>#), ($*#),
+   applyFst, applySnd,
+
+   mapAccumSimple,
+
+   replicateControlled,
+   replicateParallel,
+   replicateControlledParam,
+   feedbackControlled,
+   Causal.feedbackControlledZero,
+   Causal.fromModifier,
+   stereoFromMono,
+   stereoFromMonoControlled,
+   stereoFromMonoParameterized,
+   Causal.stereoFromVector,
+   Causal.vectorize,
+   Causal.replaceChannel,
+   Causal.arrayElement,
+   Causal.element,
+   mix,
+   raise,
+   envelope,
+   envelopeStereo,
+   amplify,
+   amplifyStereo,
+   mapLinear,
+   mapExponential,
+   quantizeLift,
+   osciSimple,
+   osciCore,
+   osciCoreSync,
+   shapeModOsci,
+   delay,
+   delayZero,
+   delay1,
+   delay1Zero,
+   delayControlled,
+   delayControlledInterpolated,
+   differentiate,
+   comb,
+   combStereo,
+   reverb,
+   reverbEfficient,
+   pipeline,
+   skip,
+   frequencyModulation,
+   frequencyModulationLinear,
+   adjacentNodes02,
+   adjacentNodes13,
+   trigger,
+
+   runStorable,
+   applyStorable,
+   runStorableChunky,
+   runStorableChunkyCont,
+   applyStorableChunky,
+
+   processIO,
+   processIOCore,
    ) where
 
 import Synthesizer.LLVM.CausalParameterized.ProcessPrivate
+import Synthesizer.LLVM.Causal.ProcessPrivate (feedbackControlledAux, )
+import Synthesizer.LLVM.Causal.Process (loopZero, )
+import qualified Synthesizer.LLVM.Causal.Process as Causal
 import qualified Synthesizer.LLVM.Plug.Input as PIn
 import qualified Synthesizer.LLVM.Plug.Output as POut
 import qualified Synthesizer.LLVM.Parameter as Param
 import qualified Synthesizer.CausalIO.Process as PIO
 
-import Synthesizer.LLVM.Parameterized.Signal (($#), )
+import Synthesizer.LLVM.Parameterized.SignalPrivate
+          (withStart, quantizeCreate, quantizeDelete,
+           quantizeNext, quantizeStart, quantizeStop, )
+import Synthesizer.LLVM.Parameter (($#), )
 import qualified Synthesizer.LLVM.RingBuffer as RingBuffer
 import qualified Synthesizer.LLVM.Parameterized.Signal as Sig
+import qualified Synthesizer.LLVM.Interpolation as Interpolation
 import qualified Synthesizer.LLVM.Frame.Stereo as Stereo
 import qualified Synthesizer.LLVM.Frame as Frame
 import qualified Synthesizer.LLVM.Execution as Exec
-import qualified Synthesizer.LLVM.Simple.Value as Value
 
 import qualified Data.StorableVector.Lazy as SVL
 import qualified Data.StorableVector as SV
 import qualified Data.StorableVector.Base as SVB
 
 import qualified Synthesizer.Generic.Cut as Cut
-import qualified Synthesizer.Plain.Modifier as Modifier
+import qualified Synthesizer.Causal.Class as CausalClass
 
 import qualified LLVM.Extra.ScalarOrVector as SoV
 import qualified LLVM.Extra.Vector as Vector
-import qualified LLVM.Extra.MaybeContinuation as Maybe
+import qualified LLVM.Extra.MaybeContinuation as MaybeCont
+import qualified LLVM.Extra.Maybe as Maybe
 import qualified LLVM.Extra.ForeignPtr as ForeignPtr
 import qualified LLVM.Extra.Memory as Memory
 import qualified LLVM.Extra.Control as C
@@ -46,59 +110,63 @@
 import qualified LLVM.Extra.Arithmetic as A
 import LLVM.Extra.Class (MakeValueTuple, ValueTuple, Undefined, undefTuple, )
 
+import qualified LLVM.Core as LLVM
 import LLVM.Util.Loop (Phi, )
-import LLVM.Core as LLVM
-import Types.Data.Num (D2, )
-import Types.Data.Ord ((:<:), )
+import LLVM.Core
+          (CodeGenFunction, ret, Value, valueOf,
+           IsSized, IsConst, IsArithmetic, IsFloating,
+           Linkage(ExternalLinkage), createNamedFunction, )
+
 import qualified Types.Data.Num as TypeNum
-import qualified Types.Data.Bool as TypeBool
+import Types.Data.Num (D1, )
 
 import qualified Control.Monad.HT as M
 import qualified Control.Arrow    as Arr
 import qualified Control.Category as Cat
-import Control.Monad.Trans.State (runState, state, evalState, )
-import Control.Arrow (arr, (<<<), (>>>), (&&&), )
-import Control.Monad (liftM2, liftM3, when, )
-import Control.Applicative (liftA2, )
+import qualified Control.Monad.Trans.State as MS
+import Control.Monad.Trans.State (evalState, )
+import Control.Arrow (arr, second, (<<<), (<<^), (>>>), (&&&), )
+import Control.Monad (liftM, liftM2, liftM3, when, )
+import Control.Applicative (liftA2, liftA3, pure, (<*>), )
+import Control.Functor.HT (void, unzip, )
 
+import qualified Data.List as List
+import Data.Traversable (traverse, )
+import Data.Foldable (sequence_, )
+import Data.Tuple.HT (swap, mapSnd, uncurry3, snd3, )
+import Data.Word (Word32, )
+import Data.Int (Int8, )
+
 import System.Random (Random, RandomGen, randomR, )
 
 import qualified Algebra.Transcendental as Trans
-import qualified Algebra.Field    as Field
-import qualified Algebra.Ring     as Ring
-import qualified Algebra.Additive as Additive
 
-import Data.Function.HT (nest, )
-import Data.Tuple.HT (swap, )
-import Data.Word (Word32, )
-import Foreign.Storable.Tuple ()
-import Foreign.Storable (Storable, poke, )
 import qualified Synthesizer.LLVM.Alloc as Alloc
+import qualified System.Unsafe as Unsafe
 import qualified Foreign.Marshal.Utils as AllocUtil
-import Foreign.ForeignPtr (withForeignPtr, )
-import Foreign.Ptr (FunPtr, )
+import qualified Foreign.Concurrent as FC
+import Foreign.Storable.Tuple ()
+import Foreign.Storable (Storable, )
+import Foreign.ForeignPtr (touchForeignPtr, withForeignPtr, )
+import Foreign.Ptr (FunPtr, Ptr, )
 import Control.Exception (bracket, )
-import qualified System.Unsafe as Unsafe
 
-import qualified Data.List as List
-
 import qualified Synthesizer.LLVM.Debug.Storable as DebugSt
 import qualified Synthesizer.LLVM.Debug.Counter as DebugCnt
 
 import NumericPrelude.Numeric
-import NumericPrelude.Base hiding (and, iterate, map, zip, zipWith, take, takeWhile, )
+import NumericPrelude.Base hiding
+          (and, iterate, map, unzip, zip, zipWith, take, takeWhile, sequence_, )
 
 
 infixl 0 $<, $>, $*, $<#, $>#, $*#
 -- infixr 0 $:*   -- can be used together with $
 
 applyFst, ($<) :: T p (a,b) c -> Sig.T p a -> T p b c
-applyFst proc sig =
-   proc <<< feedFst sig
+applyFst = CausalClass.applyFst
 
 applySnd, ($>) :: T p (a,b) c -> Sig.T p b -> T p a c
-applySnd proc sig =
-   proc <<< feedSnd sig
+applySnd = CausalClass.applySnd
 
 {-
 These infix operators may become methods of a type class
@@ -140,135 +208,154 @@
    mapAccum (\() -> f) (\() -> s) (return ()) (return ())
 
 
--- cf. synthesizer-core:Causal.Process, can be defined for any arrow
-{-# INLINE replicateControlled #-}
-replicateControlled :: Int -> T p (c,x) x -> T p (c,x) x
-replicateControlled n p =
-   nest n
-      (Arr.arr fst &&& p  >>> )
-      (Arr.arr snd)
+replicateParallel ::
+   (Undefined b, Phi b) =>
+   Param.T p Int -> Sig.T p b -> T p (b,b) b -> T p a b -> T p a b
+replicateParallel n z cum p =
+   replicateControlled n (first p >>> cum) $> z
 
+{-
+There are several problems:
+
+ * We have to call f on every parameter in the list,
+   but we have to assume that the generated code is always the same.
+
+ * createIOContext may return different types for every element in the list.
+   If types are different, the LLVM code cannot be the same, though.
+-}
+replicateControlledParam ::
+   (Undefined x, Phi x) =>
+   (forall q. Param.T q p -> Param.T q a -> T q (c,x) x) ->
+   Param.T p [a] -> T p (c,x) x
+replicateControlledParam f ps =
+   case f (arr fst) (arr snd) of
+      Cons next start stop createIOContext deleteIOContext -> Cons
+         (replicateControlledNext next stop)
+--         (_replicateControlledNext next)
+         (replicateControlledStart start)
+         (replicateControlledStop stop)
+         (\p ->
+            replicateControlledCreate $
+               mapM
+                  (\a -> createIOContext (p,a))
+                  (Param.get ps p))
+         (replicateControlledDelete deleteIOContext)
+
+
 -- cf. synthesizer-core:Causal.Process
-{-# INLINE feedbackControlled #-}
 feedbackControlled ::
-   (Storable ch,
-    MakeValueTuple ch, ValueTuple ch ~ c,
-    Memory.C c) =>
+   (Storable ch, MakeValueTuple ch, ValueTuple ch ~ c, Memory.C c) =>
    Param.T p ch ->
    T p ((ctrl,a),c) b -> T p (ctrl,b) c -> T p (ctrl,a) b
 feedbackControlled initial forth back =
-   loop initial
-      (Arr.arr (fst.fst) &&& forth  >>>  Arr.arr snd &&& back)
-
-
-fromModifier ::
-   (Value.Flatten ah, Value.Registers ah ~ al,
-    Value.Flatten bh, Value.Registers bh ~ bl,
-    Value.Flatten ch, Value.Registers ch ~ cl,
-    Value.Flatten sh, Value.Registers sh ~ sl,
-    Memory.C sl) =>
-   Modifier.Simple sh ch ah bh -> T p (cl,al) bl
-fromModifier (Modifier.Simple initial step) =
-   mapAccumSimple
-      (\(c,a) s ->
-         Value.flatten $
-         runState
-            (step (Value.unfold c) (Value.unfold a))
-            (Value.unfold s))
-      (Value.flatten initial)
+   loop initial (feedbackControlledAux forth back)
 
 
 {- |
 Run a causal process independently on each stereo channel.
 -}
 stereoFromMono ::
+   (Phi a, Phi b, Undefined b) =>
    T p a b -> T p (Stereo.T a) (Stereo.T b)
-stereoFromMono =
-   Stereo.arrowFromMono
+stereoFromMono (Cons next start stop createIOContext deleteIOContext) = Cons
+   (stereoNext stop next)
+   (stereoStart start)
+   (stereoStop stop)
+   (stereoCreate createIOContext createIOContext)
+   (composeDelete deleteIOContext deleteIOContext)
 
 stereoFromMonoControlled ::
+   (Phi a, Phi b, Phi c, Undefined b) =>
    T p (c,a) b -> T p (c, Stereo.T a) (Stereo.T b)
-stereoFromMonoControlled =
-   Stereo.arrowFromMonoControlled
+stereoFromMonoControlled proc =
+   stereoFromMono proc <<^ (\(c,sa) -> fmap ((,) c) sa)
 
-stereoFromChannels ::
-   T p a b -> T p a b -> T p (Stereo.T a) (Stereo.T b)
-stereoFromChannels =
-   Stereo.arrowFromChannels
+stereoFromMonoParameterized ::
+   (Phi a, Phi b, Undefined b) =>
+   (forall q. Param.T q p -> Param.T q x -> T q a b) ->
+   Param.T p (Stereo.T x) -> T p (Stereo.T a) (Stereo.T b)
+stereoFromMonoParameterized f ps =
+   case f (arr fst) (arr snd) of
+      Cons next start stop createIOContext deleteIOContext -> Cons
+         (stereoNext stop next)
+         (stereoStart start)
+         (stereoStop stop)
+         (stereoCreate
+            (\p -> createIOContext (p, Stereo.left  $ Param.get ps p))
+            (\p -> createIOContext (p, Stereo.right $ Param.get ps p)))
+         (composeDelete deleteIOContext deleteIOContext)
 
-{-
-In order to let this work we have to give the disable-mmx option somewhere,
-but where?
--}
-stereoFromVector ::
-   (IsPrimitive a, IsPrimitive b) =>
-   T p (Value (Vector D2 a)) (Value (Vector D2 b)) ->
-   T p (Stereo.T (Value a)) (Stereo.T (Value b))
-stereoFromVector proc =
-   mapSimple Frame.stereoFromVector <<<
-   proc <<<
-   mapSimple Frame.vectorFromStereo
+stereoCreate ::
+   Monad m =>
+   (p -> m (ioContextA, context)) ->
+   (p -> m (ioContextB, context)) ->
+   p -> m ((ioContextA, ioContextB), Stereo.T context)
+stereoCreate l r =
+   liftM (mapSnd $ uncurry Stereo.cons) . composeCreate l r
 
 
-vectorize ::
-   (Vector.C va, n ~ Vector.Size va, a ~ Vector.Element va,
-    Vector.C vb, n ~ Vector.Size vb, b ~ Vector.Element vb) =>
-   T p a b -> T p va vb
-vectorize = vectorizeSize undefined
+stereoNext ::
+   (Phi a, Phi b, Phi c, Phi s, Phi context,
+    Undefined b, Undefined s) =>
+   (context -> s -> CodeGenFunction r ()) ->
+   (forall z. (Phi z) => context -> a -> s -> MaybeCont.T r z (b, s)) ->
+   Stereo.T context ->
+   Stereo.T a ->
+   Stereo.T s ->
+   MaybeCont.T r c (Stereo.T b, Stereo.T s)
+stereoNext stop next context a s0 = MaybeCont.fromMaybe $ do
+   mbs1 <-
+      twiceStereo
+         (MaybeCont.toMaybe . uncurry3 next)
+         (liftA3 (,,) context a s0)
 
-{-
-insert and extract instructions will be in opposite order,
-no matter whether we use foldr or foldl
-and independent from the order of proc and channel in replaceChannel.
-However, LLVM neglects the order anyway.
--}
-vectorizeSize ::
-   (Vector.C va, n ~ Vector.Size va, a ~ Vector.Element va,
-    Vector.C vb, n ~ Vector.Size vb, b ~ Vector.Element vb) =>
-   n -> T p a b -> T p va vb
-vectorizeSize n proc =
-   foldl
-      (\acc i -> replaceChannel i proc acc)
-      (Arr.arr (const $ undefTuple)) $
-   List.take (TypeNum.fromIntegerT n) [0 ..]
+   mbs2 <-
+      if True
+        then Maybe.lift2 Stereo.cons (Stereo.left mbs1) (Stereo.right mbs1)
+        else MaybeCont.toMaybe $ traverse (MaybeCont.fromMaybe . return) mbs1
 
-{- |
-Given a vector process, replace the i-th output by output
-that is generated by a scalar process from the i-th input.
--}
-replaceChannel ::
-   (Vector.C va, n ~ Vector.Size va, a ~ Vector.Element va,
-    Vector.C vb, n ~ Vector.Size vb, b ~ Vector.Element vb) =>
-   Int -> T p a b -> T p va vb -> T p va vb
-replaceChannel i channel proc =
-   let li = valueOf $ fromIntegral i
-   in  zipWithSimple (Vector.insert li) <<<
-          (channel <<< mapSimple (Vector.extract li)) &&&
-          proc
+   end <- Maybe.getIsNothing mbs2
+   C.ifThen end () $
+      sequence_ $
+      liftA2
+         (\mbsi c -> Maybe.for mbsi (stop c . snd))
+         mbs1 context
 
-{- |
-Read the i-th element from each array.
--}
-arrayElement ::
-   (IsFirstClass a, LLVM.GetValue (LLVM.Array dim a) index,
-    LLVM.ValueType (LLVM.Array dim a) index ~ a,
-    TypeNum.NaturalT index, TypeNum.NaturalT dim,
-    (index :<: dim) ~ TypeBool.True) =>
-   index -> T p (Value (LLVM.Array dim a)) (Value a)
-arrayElement i =
-   mapSimple (\array -> LLVM.extractvalue array i)
+   return $ fmap unzip mbs2
 
-{- |
-Read the i-th element from an aggregate type.
--}
-element ::
-   (IsFirstClass a, LLVM.GetValue agg index,
-    LLVM.ValueType agg index ~ a) =>
-   index -> T p (Value agg) (Value a)
-element i =
-   mapSimple (\array -> LLVM.extractvalue array i)
+stereoStart ::
+   (Phi a, Phi b, Phi c, Undefined b, Undefined c) =>
+   (a -> CodeGenFunction r (c, b)) ->
+   Stereo.T a -> CodeGenFunction r (Stereo.T c, Stereo.T b)
+stereoStart code a =
+   fmap unzip $ twiceStereo code a
 
+stereoStop ::
+   (Phi context, Phi state) =>
+   (context -> state -> CodeGenFunction r ()) ->
+   Stereo.T context -> Stereo.T state -> CodeGenFunction r ()
+stereoStop code c s = void $ twiceStereo (uncurry code) (liftA2 (,) c s)
 
+twiceStereo ::
+   (Phi a, Phi b, Undefined b) =>
+   (a -> CodeGenFunction r b) ->
+   Stereo.T a -> CodeGenFunction r (Stereo.T b)
+twiceStereo code a =
+   fmap (uncurry Stereo.cons) $
+   twice code (Stereo.left a, Stereo.right a)
+
+twice ::
+   (Phi a, Phi b, Undefined b) =>
+   (a -> CodeGenFunction r b) ->
+   (a,a) -> CodeGenFunction r (b,b)
+twice code a =
+   fmap snd $
+   C.fixedLengthLoop (valueOf (2::Int8)) (a, undefTuple) $
+      \((a0,a1), (_,b1)) -> do
+         b0 <- code a0
+         return ((a1,a0), (b1,b0))
+
+
 {- |
 You may also use '(+)'.
 -}
@@ -358,35 +445,21 @@
 -}
 quantizeLift ::
    (Memory.C b,
-    Ring.C c,
-    IsFloating c, CmpRet c, CmpResult c ~ Bool,
-    Storable c, MakeValueTuple c, ValueTuple c ~ (Value c),
-    Memory.FirstClass c, Memory.Stored c ~ cm, IsSized c, IsSized cm,
-    IsConst c) =>
+    Storable c, MakeValueTuple c, ValueTuple c ~ Value cl,
+    SoV.IntegerConstant cl, IsFloating cl,
+    LLVM.CmpRet cl, LLVM.CmpResult cl ~ Bool,
+    Memory.FirstClass cl, Memory.Stored cl ~ cm, IsSized cm) =>
    Param.T p c ->
    T p a b ->
    T p a b
 quantizeLift k
-      (Cons next start createIOContext deleteIOContext) = Cons
-   (\(kl,parameter) a0 bState0 -> do
-      ((b1,state1), ss1) <-
-         Maybe.fromBool $
-         C.whileLoop
-            (valueOf True, bState0)
-            (\(cont1, (_, ss0)) ->
-               and cont1 =<< A.fcmp FPOLE ss0 (value LLVM.zero))
-            (\(_,((_,state01), ss0)) ->
-               Maybe.toBool $ liftM2 (,)
-                  (next parameter a0 state01)
-                  (Maybe.lift $ A.add ss0 (Param.value k kl)))
-
-      ss2 <- Maybe.lift $ A.sub ss1 (valueOf Ring.one)
-      return (b1, ((b1,state1),ss2)))
-   (fmap (\sa -> ((undefTuple, sa), value LLVM.zero)) . start)
-   (\p -> do
-      (ioContext, (nextParam, startParam)) <- createIOContext p
-      return (ioContext, ((Param.get k p, nextParam), startParam)))
-   deleteIOContext
+      (Cons next start stop createIOContext deleteIOContext) =
+   Param.with k $ \getK valueK -> Cons
+   (\context a0 -> quantizeNext (flip next a0) valueK context)
+   (quantizeStart start)
+   (quantizeStop stop)
+   (quantizeCreate createIOContext getK)
+   (quantizeDelete deleteIOContext)
 
 
 {- |
@@ -396,25 +469,35 @@
 For FM synthesis we need also negative phase distortions,
 thus we use 'SoV.addToPhase' which supports that.
 -}
-osciCore ::
-   (Memory.FirstClass t, Memory.Stored t ~ tm, IsSized t, IsSized tm,
-    IsConst t, SoV.Fraction t, Additive.C t) =>
+osciCore, _osciCore, osciCoreSync ::
+   (Memory.FirstClass t, Memory.Stored t ~ tm, IsSized tm,
+    SoV.Fraction t) =>
    T p (Value t, Value t) (Value t)
-osciCore =
+_osciCore =
    zipWithSimple SoV.addToPhase <<<
    Arr.second
       (mapAccumSimple
          (\a s -> do
             b <- SoV.incPhase a s
             return (s,b))
-         (return (valueOf Additive.zero)))
--- this is in principle equivalent to mapAccumSimple,
--- but needs more type constraints
---      (loop Additive.zero (arr snd &&& zipWithSimple SoV.incPhase))
+         (return A.zero))
 
+osciCoreSync =
+   zipWithSimple SoV.addToPhase <<<
+   Arr.second
+      (mapAccumSimple
+         (\a s -> do
+            b <- SoV.incPhase a s
+            return (b,b))
+         (return A.zero))
+
+osciCore =
+   zipWithSimple SoV.addToPhase <<<
+   Arr.second (loopZero (arr snd &&& zipWithSimple SoV.incPhase))
+
 osciSimple ::
    (Memory.FirstClass t, Memory.Stored t ~ tm, IsSized t, IsSized tm,
-    IsConst t, SoV.Fraction t, Additive.C t) =>
+    SoV.Fraction t) =>
    (forall r. Value t -> CodeGenFunction r y) ->
    T p (Value t, Value t) y
 osciSimple wave =
@@ -422,7 +505,7 @@
 
 shapeModOsci ::
    (Memory.FirstClass t, Memory.Stored t ~ tm, IsSized t, IsSized tm,
-    IsConst t, SoV.Fraction t, Additive.C t) =>
+    SoV.Fraction t) =>
    (forall r. c -> Value t -> CodeGenFunction r y) ->
    T p (c, (Value t, Value t)) y
 shapeModOsci wave =
@@ -436,16 +519,22 @@
 The initial value is needed in order to determine the ring buffer element type.
 -}
 delay ::
-   (Storable a,
-    MakeValueTuple a, ValueTuple a ~ al,
-    Memory.C al) =>
+   (Storable a, MakeValueTuple a, ValueTuple a ~ al, Memory.C al) =>
    Param.T p a -> Param.T p Int -> T p al al
 delay initial time =
    mapSimple RingBuffer.oldest
    <<<
    RingBuffer.track initial time
 
+delayZero ::
+   (Memory.C a, A.Additive a) =>
+   Param.T p Int -> T p a a
+delayZero time =
+   mapSimple RingBuffer.oldest
+   <<<
+   RingBuffer.trackConst A.zero time
 
+
 {- |
 Delay by one sample.
 For very small delay times (say up to 8)
@@ -460,19 +549,58 @@
 what you want.
 -}
 delay1 ::
-   (Storable a,
-    MakeValueTuple a, ValueTuple a ~ al,
-    Memory.C al) =>
+   (Storable a, MakeValueTuple a, ValueTuple a ~ al, Memory.C al) =>
    Param.T p a -> T p al al
-delay1 initial =
-   loop initial (arr swap)
+delay1 initial = loop initial (arr swap)
 
+delay1Zero :: (Memory.C a, A.Additive a) => T p a a
+delay1Zero = loopZero (arr swap)
 
+
+{- |
+Delay by a variable amount of samples.
+The momentum delay must be between @0@ and @maxTime@, inclusively.
+-}
+delayControlled ::
+   (Storable a, MakeValueTuple a, ValueTuple a ~ al, Memory.C al) =>
+   Param.T p a -> Param.T p Int -> T p (Value Word32, al) al
+delayControlled initial maxTime =
+   zipWithSimple RingBuffer.index
+   <<<
+   second (RingBuffer.track initial maxTime)
+
+{- |
+Delay by a variable fractional amount of samples.
+Non-integer delays are achieved by linear interpolation.
+The momentum delay must be between @0@ and @maxTime@, inclusively.
+-}
+delayControlledInterpolated ::
+   (Interpolation.C nodes,
+    Storable vh, MakeValueTuple vh, ValueTuple vh ~ v, Memory.C v,
+    IsFloating a, LLVM.NumberOfElements a ~ TypeNum.D1) =>
+   (forall r. Interpolation.T r nodes (Value a) v) ->
+   Param.T p vh -> Param.T p Int -> T p (Value a, v) v
+delayControlledInterpolated ip initial maxTime =
+   let margin = Interpolation.toMargin ip
+   in  zipWithSimple
+          (\del buf -> do
+             let offset =
+                    A.fromInteger' $ fromIntegral $
+                    Interpolation.marginOffset margin
+             n <- A.max offset =<< LLVM.fptoint del
+             k <- A.sub del =<< LLVM.inttofp n
+             m <- A.sub n offset
+             ip k =<<
+                Interpolation.indexNodes (flip RingBuffer.index buf) A.one m)
+       <<<
+       second
+          (RingBuffer.track initial
+              (fmap (Interpolation.marginNumber margin +) maxTime))
+
+
 differentiate ::
    (A.Additive al,
-    Storable a,
-    MakeValueTuple a, ValueTuple a ~ al,
-    Memory.C al) =>
+    Storable a, MakeValueTuple a, ValueTuple a ~ al, Memory.C al) =>
    Param.T p a -> T p al al
 differentiate initial =
    Cat.id - delay1 initial
@@ -481,26 +609,22 @@
 Delay time must be greater than zero!
 -}
 comb ::
-   (Ring.C a, Storable a,
-    IsArithmetic a, MakeValueTuple a, ValueTuple a ~ (Value a),
-    Memory.FirstClass a, Memory.Stored a ~ am, IsSized a, IsSized am) =>
+   (A.PseudoRing al,
+    Storable a, MakeValueTuple a, ValueTuple a ~ al, Memory.C al) =>
    Param.T p a -> Param.T p Int ->
-   T p (Value a) (Value a)
+   T p al al
 comb gain time =
-   let z = Additive.zero `asTypeOf` gain
-   in  loop z (mix >>> (Cat.id &&&
-          (delay z (subtract 1 time) >>> amplify gain)))
+   loopZero (mix >>> (Cat.id &&&
+      (delayZero (subtract 1 time) >>> amplify gain)))
 
 combStereo ::
-   (Ring.C a, Storable a,
-    IsArithmetic a, MakeValueTuple a, ValueTuple a ~ (Value a),
-    Memory.FirstClass a, Memory.Stored a ~ am, IsSized a, IsSized am) =>
+   (A.PseudoRing al,
+    Storable a, MakeValueTuple a, ValueTuple a ~ al, Memory.C al) =>
    Param.T p a -> Param.T p Int ->
-   T p (Stereo.T (Value a)) (Stereo.T (Value a))
+   T p (Stereo.T al) (Stereo.T al)
 combStereo gain time =
-   let z = Additive.zero `asTypeOf` (liftA2 Stereo.cons gain gain)
-   in  loop z (mix >>> (Cat.id &&&
-          (delay z (subtract 1 time) >>> amplifyStereo gain)))
+   loopZero (mix >>> (Cat.id &&&
+      (delayZero (subtract 1 time) >>> amplifyStereo gain)))
 
 {- |
 Example: apply a stereo reverb to a mono sound.
@@ -510,24 +634,51 @@
 >    (Stereo.cons 42 23)
 -}
 reverb ::
-   (Field.C a, Random a, Storable a,
-    IsArithmetic a, MakeValueTuple a, ValueTuple a ~ (Value a),
-    Memory.FirstClass a, Memory.Stored a ~ am, IsSized a, IsSized am,
+   (Random a,
+    IsArithmetic a, SoV.RationalConstant a,
+    MakeValueTuple a, ValueTuple a ~ (Value a),
+    Storable a, Memory.FirstClass a, Memory.Stored a ~ am, IsSized am,
     RandomGen g) =>
    g -> Int -> (a,a) -> (Int,Int) ->
    T p (Value a) (Value a)
 reverb rnd num gainRange timeRange =
-   amplify (return (recip (fromIntegral num) `asTypeOf` fst gainRange)) <<<
+   mapSimple (A.mul (A.fromRational' $ recip $ fromIntegral num)) <<<
    (foldl (+) Cat.id $
-    List.take num $
     List.map (\(g,t) -> comb $# g $# t) $
-    flip evalState rnd $
-    M.repeat $
-    liftM2 (,)
-       (state (randomR gainRange))
-       (state (randomR timeRange)))
+    reverbParams rnd num gainRange timeRange)
 
+reverbEfficient ::
+   (Random a,
+    SoV.PseudoModule a, SoV.Scalar a ~ s,
+    IsFloating s, SoV.IntegerConstant s, LLVM.NumberOfElements s ~ D1,
+    MakeValueTuple a, ValueTuple a ~ Value a,
+    Storable a, Memory.FirstClass a, Memory.Stored a ~ am, IsSized am,
+    RandomGen g) =>
+   Param.T p g -> Param.T p Int -> Param.T p (a,a) -> Param.T p (Int,Int) ->
+   T p (Value a) (Value a)
+reverbEfficient rnd num gainRange timeRange =
+   map
+      (\n x -> flip A.scale x =<< A.fdiv A.one =<< LLVM.inttofp n)
+      (fmap (fromIntegral :: Int -> Word32) num)
+   <<<
+   replicateControlledParam
+      (\_p p -> first (comb (fmap fst p) (fmap snd p)) >>> mix)
+      (pure reverbParams <*> rnd <*> num <*> gainRange <*> timeRange)
+   <<^
+   (\a -> (a,a))
 
+reverbParams ::
+   (RandomGen g, Random a) =>
+   g -> Int -> (a, a) -> (Int, Int) -> [(a, Int)]
+reverbParams rnd num gainRange timeRange =
+   List.take num $
+   flip evalState rnd $
+   M.repeat $
+   liftM2 (,)
+      (MS.state (randomR gainRange))
+      (MS.state (randomR timeRange))
+
+
 {- |
 This allows to compute a chain of equal processes efficiently,
 if all of these processes can be bundled in one vectorial process.
@@ -557,28 +708,63 @@
    (Vector.C v, a ~ Vector.Element v,
     Class.Zero v, Memory.C v) =>
    T p v v -> T p a a
-pipeline (Cons next start createIOContext deleteIOContext) = Cons
-   (\param a0 (v0,s0) -> do
-      (a1,v1) <- Maybe.lift $ Vector.shiftUp a0 v0
-      (v2,s2) <- next param v1 s0
-      return (a1, (v2,s2)))
-   (\p -> do
-      s <- start p
-      return (Class.zeroTuple, s))
-   createIOContext
-   deleteIOContext
+pipeline = Causal.pipeline
 
 
-linearInterpolation ::
-   (Ring.C a, IsArithmetic a, IsConst a) =>
-   Value a -> (Value a, Value a) -> CodeGenFunction r (Value a)
-linearInterpolation r (a,b) = do
-   ra <- A.mul a =<< A.sub (valueOf one) r
-   rb <- A.mul b r
-   A.add ra rb
+{- |
+Feeds a signal into a causal process while holding or skipping signal elements
+according to the process input.
+The skip happens after a value is passed from the fed signal.
 
+@skip x $* 0@ repeats the first signal value in the output.
+@skip x $* 1@ feeds the signal to the output as is.
+@skip x $* 2@ feeds the signal to the output with double speed.
+-}
+skip ::
+   (Undefined v, Phi v, Memory.C v) =>
+   Sig.T p v -> T p (Value Word32) v
+skip (Sig.Cons next start stop createIOContext deleteIOContext) =
+   Cons
+      (\context n1 (yState0,n0) -> do
+         (y,state1) <-
+            MaybeCont.fromMaybe $ fmap snd $
+            MaybeCont.fixedLengthLoop n0 yState0 $
+            next context . snd
+         return (y, ((y,state1),n1)))
+      (withStart start $ \s -> return ((undefTuple, s), A.one))
+      (\context ((_y,state),_k) -> stop context state)
+      createIOContext
+      deleteIOContext
 
 {- |
+Like 'skip' but does not require @Memory@ constraint on the result type.
+This way it can be used on a stream of ring buffer states.
+The downside is that the result is recomputed (from the previous state)
+at every step.
+
+Warning:
+This process is actually unsafe.
+It fails on signal generators that use mutable variables,
+like Signal.storableVectorLazy.
+-}
+_skipVolatile ::
+   Sig.T p v -> T p (Value Word32) v
+_skipVolatile (Sig.Cons next start stop createIOContext deleteIOContext) =
+   Cons
+      (\context n state0 -> do
+         y <- fmap fst $ next context state0
+         state1 <-
+            MaybeCont.fromMaybe $ fmap snd $
+            MaybeCont.fixedLengthLoop n state0 $
+            fmap snd . next context
+         return (y, state1))
+      (withStart start return)
+      stop
+      createIOContext
+      deleteIOContext
+
+
+{- |
 > frequencyModulationLinear signal
 
 is a causal process mapping from a shrinking factor
@@ -589,40 +775,69 @@
 The shrinking factor must be non-negative.
 -}
 frequencyModulationLinear ::
-   (-- Memory.C a,
-    Ring.C a,
-    IsFloating a, CmpRet a, CmpResult a ~ Bool,
-    Storable a, MakeValueTuple a, ValueTuple a ~ (Value a),
-    Memory.FirstClass a, Memory.Stored a ~ am, IsSized a, IsSized am,
-    IsConst a) =>
+   (SoV.IntegerConstant a, IsFloating a, LLVM.CmpRet a, LLVM.CmpResult a ~ Bool,
+    Memory.FirstClass a, Memory.Stored a ~ am, IsSized am) =>
    Sig.T p (Value a) -> T p (Value a) (Value a)
-frequencyModulationLinear
-      (Sig.Cons next start createIOContext deleteIOContext) =
+frequencyModulationLinear xs =
+   frequencyModulation Interpolation.linear (adjacentNodes02 xs)
+
+frequencyModulation ::
+   (SoV.IntegerConstant a, IsFloating a, LLVM.CmpRet a, LLVM.CmpResult a ~ Bool,
+    Memory.FirstClass a, Memory.Stored a ~ am, IsSized am,
+    Undefined nodes, Phi nodes, Memory.C nodes) =>
+   (forall r. Value a -> nodes -> CodeGenFunction r v) ->
+   Sig.T p nodes -> T p (Value a) v
+frequencyModulation ip
+      (Sig.Cons next start stop createIOContext deleteIOContext) =
    Cons
-      (\parameter k yState0 -> do
-         (((y02,y12),state2), ss2) <-
-            Maybe.fromBool $
+      (\context k yState0 -> do
+         ((nodes2,state2), ss2) <-
+            MaybeCont.fromBool $
             C.whileLoop
                (valueOf True, yState0)
                (\(cont0, (_, ss0)) ->
-                  and cont0 =<< A.fcmp FPOGE ss0 (valueOf Ring.one))
-               (\(_,(((_,y01),state0), ss0)) ->
-                  Maybe.toBool $ liftM2 (,)
-                     (do (y11,state1) <- next parameter state0
-                         return ((y01,y11),state1))
-                     (Maybe.lift $ A.sub ss0 (valueOf Ring.one)))
+                  LLVM.and cont0 =<< A.fcmp LLVM.FPOGE ss0 A.one)
+               (\(_,((_,state0), ss0)) ->
+                  MaybeCont.toBool $ liftM2 (,)
+                     (next context state0)
+                     (MaybeCont.lift $ A.sub ss0 A.one))
 
-         Maybe.lift $ do
-            y <- linearInterpolation ss2 (y02,y12)
+         MaybeCont.lift $ do
+            y <- ip ss2 nodes2
             ss3 <- A.add ss2 k
-            return (y, (((y02,y12),state2),ss3)))
-      (\p -> do
-         sa <- start p
-         return (((value undef, value undef), sa), valueOf 2))
+            return (y, ((nodes2, state2), ss3)))
+      (withStart start $ \sa ->
+         return ((undefTuple, sa), A.fromInteger' 1))
+      (\context ((_y01,state),_ss) -> stop context state)
       createIOContext
       deleteIOContext
 
+adjacentNodes02 ::
+   (Memory.C a, Undefined a) =>
+   Sig.T p a -> Sig.T p (Interpolation.Nodes02 a)
+adjacentNodes02 xs =
+   Sig.tail
+      (mapAccumSimple
+          (\new old -> return (Interpolation.Nodes02 old new, new))
+          (return undefTuple)
+       $*
+       xs)
 
+adjacentNodes13 ::
+   (MakeValueTuple ah, Storable ah, ValueTuple ah ~ a,
+    Memory.C a, Undefined a) =>
+   Param.T p ah -> Sig.T p a -> Sig.T p (Interpolation.Nodes13 a)
+adjacentNodes13 yp0 xs =
+   Sig.tail $ Sig.tail
+      (mapAccum
+          (\() new (x0, x1, x2) ->
+             return (Interpolation.Nodes13 x0 x1 x2 new, (x1, x2, new)))
+          (\y0 -> return (undefTuple, undefTuple, Param.value yp0 y0))
+          (pure ()) yp0
+       $*
+       xs)
+
+
 {- |
 @trigger fill signal@ send @signal@ to the output
 and restart it whenever the Boolean process input is 'True'.
@@ -641,19 +856,24 @@
    Param.T p a ->
    Sig.T p al ->
    T p (Value Bool) al
-trigger fill (Sig.Cons next start createIOContext deleteIOContext) = Cons
-   (\(nextParam, startParam, f) b0 (active0, s0) -> Maybe.lift $ do
-      (active1,s1) <-
-         C.ifThen b0 (active0,s0)
-            (fmap ((,) (valueOf False)) $ start startParam)
-      (active2,(a2,s2)) <-
-         Maybe.toBool $ Maybe.guard active1 >> next nextParam s1
-      a3 <- C.select active2 a2 (Param.value fill f)
-      return (a3,(active2,s2)))
-   (\() -> return (valueOf False, undefTuple))
+trigger fill (Sig.Cons next start stop createIOContext deleteIOContext) =
+   Param.with fill $ \getFill valueFill -> Cons
+   (\(param, f) b0 mcs0 -> MaybeCont.lift $ do
+      mcs1 <-
+         C.ifThen b0 mcs0 $
+            Maybe.for mcs0 (uncurry stop)
+            >>
+            fmap Maybe.just (start param)
+      mcas2 <-
+         Maybe.run mcs1 (return Maybe.nothing) $ \(c1,s1) ->
+            MaybeCont.toMaybe $ fmap ((,) c1) $ next c1 s1
+      a3 <- Maybe.select (fmap (fst.snd) mcas2) (valueFill f)
+      return (a3, fmap (mapSnd snd) mcas2))
+   (\pf -> return (pf, Maybe.nothing))
+   (\ _pf -> flip Maybe.for $ uncurry stop)
    (\p -> do
-      (context, (nextParam, startParam)) <- createIOContext p
-      return (context, ((nextParam, startParam, Param.get fill p), ())))
+      (context, param) <- createIOContext p
+      return (context, (param, getFill p)))
    deleteIOContext
 
 
@@ -679,20 +899,21 @@
     Storable b, MakeValueTuple b, ValueTuple b ~ valueB, Memory.C valueB) =>
    T p valueA valueB ->
    IO (p -> SV.Vector a -> SV.Vector b)
-runStorable (Cons next start createIOContext deleteIOContext) = do
+runStorable (Cons next start stop createIOContext deleteIOContext) = do
    fill <-
       fmap derefFillPtr $
       Exec.compileModule $
       createNamedFunction ExternalLinkage "fillprocessblock" $
       \paramPtr size alPtr blPtr -> do
-         (nextParam,startParam) <- Memory.load paramPtr
-         s <- start startParam
-         (pos,_) <- Maybe.arrayLoop2 size alPtr blPtr s $
+         param <- Memory.load paramPtr
+         (c,s) <- start param
+         (pos,msExit) <- MaybeCont.arrayLoop2 size alPtr blPtr s $
                \ aPtri bPtri s0 -> do
-            a <- Maybe.lift $ Memory.load aPtri
-            (b,s1) <- next nextParam a s0
-            Maybe.lift $ Memory.store b bPtri
+            a <- MaybeCont.lift $ Memory.load aPtri
+            (b,s1) <- next c a s0
+            MaybeCont.lift $ Memory.store b bPtri
             return s1
+         Maybe.for msExit $ stop c
          ret (pos :: Value Word32)
 
    return $ \p as ->
@@ -718,61 +939,71 @@
 
 
 foreign import ccall safe "dynamic" derefChunkPtr ::
-   Exec.Importer (Ptr nextParamStruct -> Ptr stateStruct -> Word32 ->
+   Exec.Importer (Ptr contextStateStruct -> Word32 ->
              Ptr structA -> Ptr structB -> IO Word32)
 
 
 compileChunky ::
    (Memory.C valueA, Memory.Struct valueA ~ structA,
     Memory.C valueB, Memory.Struct valueB ~ structB,
-    Memory.C state, Memory.Struct state ~ stateStruct,
-    Memory.C startParamValue, Memory.Struct startParamValue ~ startParamStruct,
-    Memory.C nextParamValue,  Memory.Struct nextParamValue ~ nextParamStruct) =>
-   (forall r.
-    nextParamValue ->
+    Memory.C parameters, Memory.Struct parameters ~ paramStruct,
+    Memory.C context, Memory.C state,
+    Memory.Struct (context, Maybe.T state) ~ contextStateStruct) =>
+   (forall r z.
+    (Phi z) =>
+    context ->
     valueA -> state ->
-    Maybe.T r (Value Bool, (Value (Ptr structB), state)) (valueB, state)) ->
+    MaybeCont.T r z (valueB, state)) ->
    (forall r.
-    startParamValue ->
-    CodeGenFunction r state) ->
-   IO (FunPtr (Ptr startParamStruct -> IO (Ptr stateStruct)),
-       FunPtr (Ptr stateStruct -> IO ()),
-       FunPtr (Ptr nextParamStruct -> Ptr stateStruct -> Word32 ->
+    parameters ->
+    CodeGenFunction r (context, state)) ->
+   (forall r.
+    context -> state ->
+    CodeGenFunction r ()) ->
+   IO (FunPtr (Ptr paramStruct -> IO (Ptr contextStateStruct)),
+       FunPtr (Ptr contextStateStruct -> IO ()),
+       FunPtr (Ptr contextStateStruct -> Word32 ->
                Ptr structA -> Ptr structB -> IO Word32))
-compileChunky next start =
+compileChunky next start stop =
    Exec.compileModule $
       liftM3 (,,)
          (createNamedFunction ExternalLinkage "startprocess" $
           \paramPtr -> do
              pptr <- LLVM.malloc
-             flip Memory.store pptr =<< start =<< Memory.load paramPtr
+             flip Memory.store pptr . mapSnd Maybe.just =<< start =<< Memory.load paramPtr
              ret pptr)
          (createNamedFunction ExternalLinkage "stopprocess" $
-          \ pptr -> LLVM.free pptr >> ret ())
+          \ contextStatePtr -> do
+             (c,ms) <- Memory.load contextStatePtr
+             Maybe.for ms $ stop c
+             LLVM.free contextStatePtr
+             ret ())
          (createNamedFunction ExternalLinkage "fillprocess" $
-          \ paramPtr sptr loopLen aPtr bPtr -> do
-             param <- Memory.load paramPtr
-             sInit <- Memory.load sptr
-             (pos,sExit) <- Maybe.arrayLoop2 loopLen aPtr bPtr sInit $
-                   \ aPtri bPtri s0 -> do
-                a <- Maybe.lift $ Memory.load aPtri
+          \ contextStatePtr loopLen aPtr bPtr -> do
+             (param, msInit) <- Memory.load contextStatePtr
+             (pos,msExit) <-
+                Maybe.run msInit (return (A.zero, Maybe.nothing)) $ \sInit ->
+                   MaybeCont.arrayLoop2 loopLen aPtr bPtr sInit $
+                      \ aPtri bPtri s0 -> do
+                a <- MaybeCont.lift $ Memory.load aPtri
                 (b,s1) <- next param a s0
-                Maybe.lift $ Memory.store b bPtri
+                MaybeCont.lift $ Memory.store b bPtri
                 return s1
-             Memory.store sExit sptr
+             sptr <- LLVM.getElementPtr0 contextStatePtr (TypeNum.d1, ())
+             Memory.store msExit sptr
              ret (pos :: Value Word32))
 
 
 foreign import ccall safe "dynamic" derefStartParamPtr ::
-   Exec.Importer (Ptr startParamStruct -> IO (Ptr stateStruct))
+   Exec.Importer (Ptr paramStruct -> IO (Ptr contextStateStruct))
 
 foreign import ccall safe "dynamic" derefStopPtr ::
-   Exec.Importer (Ptr stateStruct -> IO ())
+   Exec.Importer (Ptr contextStateStruct -> IO ())
 
 compilePlugged ::
-   (Memory.C state, Memory.Struct state ~ stateStruct,
-    Memory.C startParamValue, Memory.Struct startParamValue ~ startParamStruct,
-    Memory.C nextParamValue,  Memory.Struct nextParamValue  ~ nextParamStruct,
+   (Memory.C parameters, Memory.Struct parameters ~ paramStruct,
+    Memory.C context, Memory.C state,
+    Memory.Struct (context, Maybe.T state) ~ contextStateStruct,
     Undefined stateIn,  Phi stateIn,
     Undefined stateOut, Phi stateOut,
     Memory.C paramValueIn,  Memory.Struct paramValueIn  ~ paramStructIn,
@@ -783,51 +1014,58 @@
    (forall r.
     paramValueIn ->
     LLVM.CodeGenFunction r stateIn) ->
-   (forall r.
-    nextParamValue ->
+   (forall r z.
+    (Phi z) =>
+    context ->
     valueA -> state ->
-    Maybe.T r
-       (Value Bool, (Value Word32, (stateIn, state, stateOut)))
-       (valueB, state)) ->
+    MaybeCont.T r z (valueB, state)) ->
    (forall r.
-    startParamValue ->
-    CodeGenFunction r state) ->
+    parameters ->
+    CodeGenFunction r (context, state)) ->
    (forall r.
+    context -> state ->
+    CodeGenFunction r ()) ->
+   (forall r.
     paramValueOut ->
     valueB -> stateOut -> LLVM.CodeGenFunction r stateOut) ->
    (forall r.
     paramValueOut ->
     LLVM.CodeGenFunction r stateOut) ->
-   IO (FunPtr (Ptr startParamStruct -> IO (Ptr stateStruct)),
-       FunPtr (Ptr stateStruct -> IO ()),
-       FunPtr (Ptr nextParamStruct -> Ptr stateStruct -> Word32 ->
+   IO (FunPtr (Ptr paramStruct -> IO (Ptr contextStateStruct)),
+       FunPtr (Ptr contextStateStruct -> IO ()),
+       FunPtr (Ptr contextStateStruct -> Word32 ->
                Ptr paramStructIn -> Ptr paramStructOut -> IO Word32))
-compilePlugged nextIn startIn next start nextOut startOut =
+compilePlugged nextIn startIn next start stop nextOut startOut =
    Exec.compileModule $
       liftM3 (,,)
          (createNamedFunction ExternalLinkage "startprocess" $
           \paramPtr -> do
              pptr <- LLVM.malloc
-             flip Memory.store pptr =<< start =<< Memory.load paramPtr
+             flip Memory.store pptr . mapSnd Maybe.just =<< start =<< Memory.load paramPtr
              ret pptr)
          (createNamedFunction ExternalLinkage "stopprocess" $
-          \ pptr -> LLVM.free pptr >> ret ())
+          \ contextStatePtr -> do
+             (c,ms) <- Memory.load contextStatePtr
+             Maybe.for ms $ stop c
+             LLVM.free contextStatePtr
+             ret ())
          (createNamedFunction ExternalLinkage "fillprocess" $
-          \ paramPtr sptr loopLen inPtr outPtr -> do
-             param <- Memory.load paramPtr
-             sInit <- Memory.load sptr
+          \ contextStatePtr loopLen inPtr outPtr -> do
+             (param, msInit) <- Memory.load contextStatePtr
              inParam  <- Memory.load inPtr
              outParam <- Memory.load outPtr
              inInit  <- startIn  inParam
              outInit <- startOut outParam
-             (pos,(_,sExit,_)) <-
-                Maybe.fixedLengthLoop loopLen (inInit, sInit, outInit) $
-                   \ (in0,s0,out0) -> do
-                (a,in1) <- Maybe.lift $ nextIn inParam in0
+             (pos,msExit) <-
+                Maybe.run msInit (return (A.zero, Maybe.nothing)) $ \sInit ->
+                   MaybeCont.fixedLengthLoop loopLen (inInit, sInit, outInit) $
+                      \ (in0,s0,out0) -> do
+                (a,in1) <- MaybeCont.lift $ nextIn inParam in0
                 (b,s1) <- next param a s0
-                out1 <- Maybe.lift $ nextOut outParam b out0
+                out1 <- MaybeCont.lift $ nextOut outParam b out0
                 return (in1, s1, out1)
-             Memory.store sExit sptr
+             sptr <- LLVM.getElementPtr0 contextStatePtr (TypeNum.d1, ())
+             Memory.store (fmap snd3 msExit) sptr
              ret (pos :: Value Word32))
 
 
@@ -852,20 +1090,20 @@
    IO ((SVL.Vector a -> SVL.Vector b) ->
        p ->
        SVL.Vector a -> SVL.Vector b)
-runStorableChunkyCont (Cons next start createIOContext deleteIOContext) = do
-   (startFunc, stopFunc, fill) <- compileChunky next start
+runStorableChunkyCont (Cons next start stop createIOContext deleteIOContext) = do
+   (startFunc, stopFunc, fill) <- compileChunky next start stop
    return $
       \ procRest p sig ->
       SVL.fromChunks $ Unsafe.performIO $ do
-         (ioContext, (nextParam, startParam)) <- createIOContext p
+         (ioContext, param) <- createIOContext p
 
          when False $ DebugCnt.with DebugSt.dumpCounter $ do
-            DebugSt.dump "next-param" nextParam
-            DebugSt.dump "start-param" startParam
+            DebugSt.dump "param" param
 
-         statePtr <- ForeignPtr.newParam stopFunc startFunc startParam
-         nextParamPtr <-
-            ForeignPtr.new (deleteIOContext ioContext) nextParam
+         statePtr <- ForeignPtr.newParam stopFunc startFunc param
+         concStatePtr <-
+            withForeignPtr statePtr $
+            flip FC.newForeignPtr (deleteIOContext ioContext)
 
          let go xt =
                Unsafe.interleaveIO $
@@ -873,14 +1111,14 @@
                   [] -> return []
                   x:xs -> SVB.withStartPtr x $ \aPtr size -> do
                      v <-
-                        ForeignPtr.with nextParamPtr $ \nptr ->
                         withForeignPtr statePtr $ \sptr ->
                         SVB.createAndTrim size $
                         fmap fromIntegral .
-                        derefChunkPtr fill nptr sptr
+                        derefChunkPtr fill sptr
                            (fromIntegral size)
                            (Memory.castStorablePtr aPtr) .
                         Memory.castStorablePtr
+                     touchForeignPtr concStatePtr
                      (if SV.length v > 0
                         then fmap (v:)
                         else id) $
@@ -933,21 +1171,19 @@
    IO (p -> PIO.T a d)
 processIOCore
       (PIn.Cons nextIn startIn createIn deleteIn)
-      (Cons next start createIOContext deleteIOContext)
+      (Cons next start stop createIOContext deleteIOContext)
       (POut.Cons nextOut startOut createOut deleteOut) = do
    (startFunc, stopFunc, fill) <-
-      compilePlugged nextIn startIn next start nextOut startOut
+      compilePlugged nextIn startIn next start stop nextOut startOut
    return $ \p -> PIO.Cons
-      (\a s@(_, (nextParamPtr,statePtr)) -> do
+      (\a s@(_, paramPtr) -> do
          let maximumSize = Cut.length a
-             nptr = Memory.castStorablePtr nextParamPtr
-             sptr = statePtr
          (contextIn, paramIn)  <- createIn a
          (contextOut,paramOut) <- createOut maximumSize
          actualSize <-
             AllocUtil.with paramIn $ \inptr ->
             AllocUtil.with paramOut $ \outptr ->
-            derefChunkPtr fill nptr sptr
+            derefChunkPtr fill paramPtr
                (fromIntegral maximumSize)
                (Memory.castStorablePtr inptr)
                (Memory.castStorablePtr outptr)
@@ -955,22 +1191,18 @@
          b <- deleteOut (fromIntegral actualSize) contextOut
          return (b, s))
       (do
-         (ioContext, (nextParam, startParam)) <- createIOContext p
+         (ioContext, param) <- createIOContext p
 
          when False $ DebugCnt.with DebugSt.dumpCounter $ do
-            DebugSt.dump "next-param" nextParam
-            DebugSt.dump "start-param" startParam
+            DebugSt.dump "param" param
 
-         nextParamPtr <- Alloc.malloc
-         poke nextParamPtr nextParam
-         statePtr <-
-            AllocUtil.with startParam
+         contextStatePtr <-
+            AllocUtil.with param
                (derefStartParamPtr startFunc . Memory.castStorablePtr)
 
-         return (ioContext, (nextParamPtr, statePtr)))
-      (\(ioContext, (nextParamPtr,statePtr)) -> do
-         derefStopPtr stopFunc statePtr
-         Alloc.free nextParamPtr
+         return (ioContext, contextStatePtr))
+      (\(ioContext, contextStatePtr) -> do
+         derefStopPtr stopFunc contextStatePtr
          deleteIOContext ioContext)
 
 processIO ::
diff --git a/src/Synthesizer/LLVM/CausalParameterized/ProcessPacked.hs b/src/Synthesizer/LLVM/CausalParameterized/ProcessPacked.hs
--- a/src/Synthesizer/LLVM/CausalParameterized/ProcessPacked.hs
+++ b/src/Synthesizer/LLVM/CausalParameterized/ProcessPacked.hs
@@ -8,7 +8,8 @@
 module Synthesizer.LLVM.CausalParameterized.ProcessPacked where
 
 import Synthesizer.LLVM.CausalParameterized.Process (T(Cons), )
-import qualified Synthesizer.LLVM.CausalParameterized.Process as Causal
+import Synthesizer.LLVM.Parameterized.SignalPrivate (withStart, )
+import qualified Synthesizer.LLVM.CausalParameterized.Process as CausalP
 import qualified Synthesizer.LLVM.Parameter as Param
 import qualified Synthesizer.LLVM.Frame as Frame
 import qualified Synthesizer.LLVM.Frame.SerialVector as Serial
@@ -21,22 +22,23 @@
 import qualified LLVM.Extra.Class as Class
 import qualified LLVM.Extra.Arithmetic as A
 import qualified LLVM.Extra.Control as C
-import LLVM.Extra.Class (MakeValueTuple, ValueTuple, Undefined, undefTuple, )
+import LLVM.Extra.Class (MakeValueTuple, ValueTuple, undefTuple, )
 
-import LLVM.Core as LLVM
+import qualified LLVM.Core as LLVM
+import LLVM.Core
+          (CodeGenFunction, Value, valueOf,
+           IsSized, IsArithmetic,
+           IsPrimitive, IsFirstClass, )
 
 import qualified Types.Data.Bool as TypeBool
 import qualified Types.Data.Num as TypeNum
-import Types.Data.Num.Ops ((:*:), )
 import Types.Data.Ord ((:<:), )
 
 import qualified Control.Monad.Trans.Class as MT
 import qualified Control.Monad.Trans.State as MS
 import qualified Control.Category as Cat
 import qualified Control.Arrow    as Arr
-import Control.Arrow ((^<<), (<<<), )
-
-import qualified Algebra.Additive as Additive
+import Control.Arrow ((<<<), )
 
 import Data.Tuple.HT (swap, )
 
@@ -57,7 +59,7 @@
    (Serial.Read va, n ~ Serial.Size va, a ~ Serial.Element va,
     Serial.C    vb, n ~ Serial.Size vb, b ~ Serial.Element vb) =>
    T p a b -> T p va vb
-pack (Cons next start createIOContext deleteIOContext) = Cons
+pack (Cons next start stop createIOContext deleteIOContext) = Cons
    (\param a s -> do
       r <- Maybe.lift $ Serial.readStart a
       ((_,w2),(_,s2)) <-
@@ -65,10 +67,11 @@
          C.whileLoop
             (valueOf True,
              let w = undefTuple
-             in  ((r,w), (valueOf $ (fromIntegral $ Serial.sizeOfIterator w :: Word32), s)))
+             in  ((r,w),
+                  (valueOf (fromIntegral $ Serial.sizeOfIterator w :: Word32), s)))
             (\(cont,(_rw0,(i0,_s0))) ->
                A.and cont =<<
-                  A.cmp CmpGT i0 (value LLVM.zero))
+                  A.cmp LLVM.CmpGT i0 A.zero)
             (\(_,((r0,w0),(i0,s0))) -> Maybe.toBool $ do
                (ai,r1) <- Maybe.lift $ Serial.readNext r0
                (bi,s1) <- next param ai s0
@@ -79,6 +82,7 @@
       b <- Maybe.lift $ Serial.writeStop w2
       return (b, s2))
    start
+   stop
    createIOContext
    deleteIOContext
 
@@ -92,7 +96,7 @@
    (Serial.Read va, n ~ Serial.Size va, a ~ Serial.Element va,
     Serial.C    vb, n ~ Serial.Size vb, b ~ Serial.Element vb) =>
    T p a b -> T p va vb
-packSmall (Cons next start createIOContext deleteIOContext) = Cons
+packSmall (Cons next start stop createIOContext deleteIOContext) = Cons
    (\param a ->
       MS.runStateT $
          (MT.lift . Maybe.lift . Serial.assemble)
@@ -101,6 +105,7 @@
          =<<
          (MT.lift $ Maybe.lift $ Serial.extractAll a))
    start
+   stop
    createIOContext
    deleteIOContext
 
@@ -118,9 +123,9 @@
     Memory.C va,
     Memory.C vb) =>
    T p va vb -> T p a b
-unpack (Cons next start createIOContext deleteIOContext) = Cons
+unpack (Cons next start stop createIOContext deleteIOContext) = Cons
    (\param ai ((w0,r0),(i0,s0)) -> do
-      endOfVector <- Maybe.lift $ A.cmp CmpEQ i0 (valueOf 0)
+      endOfVector <- Maybe.lift $ A.cmp LLVM.CmpEQ i0 A.zero
       ((w2,r2),(i2,s2)) <-
          Maybe.fromBool $
          C.ifThen endOfVector (valueOf True, ((w0,r0),(i0,s0))) $ do
@@ -136,96 +141,83 @@
          (bi,r3) <- Serial.readNext r2
          i3 <- A.dec i2
          return (bi, ((w3,r3),(i3,s2))))
-   (\p -> do
-      s <- start p
+   (withStart start $ \s -> do
       w <- Serial.writeZero
       return ((w, Class.undefTuple), (valueOf (0::Word32), s)))
+   (\context (_wr,(_i,state)) -> stop context state)
    createIOContext
    deleteIOContext
 
 
 raise ::
-   (Storable a, IsArithmetic a, IsConst a,
+   (Storable a, IsArithmetic a,
     MakeValueTuple a, ValueTuple a ~ (Value a),
-    Memory.FirstClass a, Memory.Stored a ~ am,
-    IsPrimitive a,  IsSized a, SizeOf a ~ as,
-    IsPrimitive am, IsSized am, SizeOf am ~ amsize,
-    TypeNum.PositiveT (n :*: as),
-    TypeNum.PositiveT (n :*: amsize),
+    IsPrimitive a, Memory.FirstClass a,
+    Memory.Stored a ~ am, IsSized am,
     TypeNum.PositiveT n) =>
    Param.T p a ->
    T p (Serial.Value n a) (Serial.Value n a)
-raise x =
-   Causal.map Frame.mix (Serial.replicate ^<< x)
-
+raise =
+   CausalP.map
+      (\x y -> Serial.upsample x >>= flip Frame.mix y)
 
 amplify ::
-   (Storable a, IsArithmetic a, IsConst a,
+   (Storable a, IsArithmetic a,
     MakeValueTuple a, ValueTuple a ~ (Value a),
-    Memory.FirstClass a, Memory.Stored a ~ am,
-    IsPrimitive a,  IsSized a, SizeOf a ~ as,
-    IsPrimitive am, IsSized am, SizeOf am ~ amsize,
-    TypeNum.PositiveT (n :*: as),
-    TypeNum.PositiveT (n :*: amsize),
+    IsPrimitive a, Memory.FirstClass a,
+    Memory.Stored a ~ am, IsSized am,
     TypeNum.PositiveT n) =>
    Param.T p a ->
    T p (Serial.Value n a) (Serial.Value n a)
-amplify p =
-   Causal.map Frame.amplifyMono (Serial.replicate ^<< p)
+amplify =
+   CausalP.map
+      (\x y -> Serial.upsample x >>= flip Frame.amplifyMono y)
 
 amplifyStereo ::
-   (Storable a, IsArithmetic a, IsConst a,
+   (Storable a, IsArithmetic a,
     MakeValueTuple a, ValueTuple a ~ (Value a),
-    Memory.FirstClass a, Memory.Stored a ~ am,
-    IsPrimitive a,  IsSized a, SizeOf a ~ as,
-    IsPrimitive am, IsSized am, SizeOf am ~ amsize,
-    TypeNum.PositiveT (n :*: as),
-    TypeNum.PositiveT (n :*: amsize),
+    IsPrimitive a, Memory.FirstClass a,
+    Memory.Stored a ~ am, IsSized am,
     TypeNum.PositiveT n) =>
    Param.T p a ->
    T p (Stereo.T (Serial.Value n a)) (Stereo.T (Serial.Value n a))
-amplifyStereo p =
-   Causal.map Frame.amplifyStereo (Serial.replicate ^<< p)
+amplifyStereo =
+   CausalP.map
+      (\x y -> Serial.upsample x >>= flip Frame.amplifyStereo y)
 
 
 osciCore ::
    (Memory.FirstClass t, Memory.Stored t ~ tm, IsSized t, IsSized tm,
-    SoV.Fraction t, IsConst t,
-    Vector.Real t, IsPrimitive t,
-    TypeNum.PositiveT n,
-    Additive.C t) =>
+    Vector.Real t, SoV.Fraction t, LLVM.IsFloating t,
+    TypeNum.PositiveT n) =>
    T p (Serial.Value n t, Serial.Value n t) (Serial.Value n t)
 osciCore =
-   Causal.zipWithSimple A.addToPhase <<<
+   CausalP.zipWithSimple A.addToPhase <<<
    Arr.second
-      (Causal.mapAccumSimple
+      (CausalP.mapAccumSimple
          (\a phase0 -> do
             (phase1,b1) <- Serial.cumulate phase0 a
             phase2 <- A.signedFraction phase1
             return (b1,phase2))
-         (return (valueOf Additive.zero)))
+         (return A.zero))
 
 osciSimple ::
    (Memory.FirstClass t, Memory.Stored t ~ tm, IsSized t, IsSized tm,
-    SoV.Fraction t, IsConst t,
-    Vector.Real t, IsPrimitive t,
-    TypeNum.PositiveT n,
-    Additive.C t) =>
+    Vector.Real t, SoV.Fraction t, LLVM.IsFloating t,
+    TypeNum.PositiveT n) =>
    (forall r. Serial.Value n t -> CodeGenFunction r y) ->
    T p (Serial.Value n t, Serial.Value n t) y
 osciSimple wave =
-   Causal.mapSimple wave <<< osciCore
+   CausalP.mapSimple wave <<< osciCore
 
 shapeModOsci ::
    (Memory.FirstClass t, Memory.Stored t ~ tm, IsSized t, IsSized tm,
-    SoV.Fraction t, IsConst t,
-    Vector.Real t, IsPrimitive t,
-    TypeNum.PositiveT n,
-    Additive.C t) =>
+    Vector.Real t, SoV.Fraction t, LLVM.IsFloating t,
+    TypeNum.PositiveT n) =>
    (forall r. c -> Serial.Value n t -> CodeGenFunction r y) ->
    T p (c, (Serial.Value n t, Serial.Value n t)) y
 shapeModOsci wave =
-   Causal.zipWithSimple wave <<< Arr.second osciCore
+   CausalP.zipWithSimple wave <<< Arr.second osciCore
 
 
 delay1 ::
@@ -235,8 +227,8 @@
     Memory.C al) =>
    Param.T p a -> T p va va
 delay1 initial =
-   Causal.loop initial $
-   Causal.mapSimple (fmap swap . uncurry Serial.shiftUp . swap)
+   CausalP.loop initial $
+   CausalP.mapSimple (fmap swap . uncurry Serial.shiftUp . swap)
 
 differentiate ::
    (Serial.C va, n ~ Serial.Size va, al ~ Serial.Element va,
@@ -248,7 +240,21 @@
 differentiate initial =
    Cat.id - delay1 initial
 
+integrate ::
+   (Storable a, MakeValueTuple a, ValueTuple a ~ Value a, Vector.Arithmetic a,
+    Memory.FirstClass a, Memory.Stored a ~ am, IsSized am,
+    TypeNum.PositiveT n) =>
+   Param.T p a ->
+   T p (Serial.Value n a) (Serial.Value n a)
+integrate =
+   CausalP.mapAccum
+      (\() a acc0 -> do
+         (acc1,b) <- Serial.cumulate acc0 a
+         return (b,acc1))
+      return
+      (return ())
 
+
 arrayElement ::
    (IsFirstClass a, LLVM.Value a ~ Serial.Element v, Serial.C v,
     LLVM.GetValue (LLVM.Array dim a) index,
@@ -257,4 +263,4 @@
     (index :<: dim) ~ TypeBool.True) =>
    index -> T p (Value (LLVM.Array dim a)) v
 arrayElement i =
-   Causal.mapSimple Serial.upsample <<< Causal.arrayElement i
+   CausalP.mapSimple Serial.upsample <<< CausalP.arrayElement i
diff --git a/src/Synthesizer/LLVM/CausalParameterized/ProcessPrivate.hs b/src/Synthesizer/LLVM/CausalParameterized/ProcessPrivate.hs
--- a/src/Synthesizer/LLVM/CausalParameterized/ProcessPrivate.hs
+++ b/src/Synthesizer/LLVM/CausalParameterized/ProcessPrivate.hs
@@ -7,25 +7,38 @@
 
 import qualified Synthesizer.LLVM.Parameterized.SignalPrivate as Sig
 import qualified Synthesizer.LLVM.Parameter as Param
+import qualified Synthesizer.LLVM.Causal.Process as Causal
+import Synthesizer.LLVM.Causal.ProcessPrivate (loopNext, )
 
+import qualified Synthesizer.Causal.Class as CausalClass
+
+import qualified LLVM.Extra.Control as C
 import qualified LLVM.Extra.Arithmetic as A
-import qualified LLVM.Extra.MaybeContinuation as Maybe
+import qualified LLVM.Extra.MaybeContinuation as MaybeCont
 import qualified LLVM.Extra.Memory as Memory
+import LLVM.Extra.Class (MakeValueTuple, ValueTuple, Undefined, )
 
 import qualified LLVM.Core as LLVM
-import LLVM.Extra.Class (MakeValueTuple, ValueTuple, )
 import LLVM.Util.Loop (Phi, )
-import LLVM.Core (Value, valueOf, CodeGenFunction, )
+import LLVM.Core (CodeGenFunction, Value, valueOf, )
 
+import Types.Data.Num (d1, )
+
+import qualified Control.Monad.HT as M
 import qualified Control.Arrow    as Arr
 import qualified Control.Category as Cat
 import Control.Arrow (arr, (^<<), (<<<), (&&&), )
-import Control.Monad (liftM2, )
 import Control.Applicative (Applicative, pure, (<*>), )
+import Data.Tuple.HT (mapSnd, )
 
+import qualified Synthesizer.LLVM.Storable.Vector as SVU
+import qualified Data.StorableVector as SV
+
 import Data.Word (Word32, )
 import Foreign.Storable.Tuple ()
 import Foreign.Storable (Storable, )
+import Foreign.ForeignPtr (ForeignPtr, touchForeignPtr, )
+import Foreign.Ptr (Ptr, )
 
 import qualified Number.Ratio as Ratio
 import qualified Algebra.Field as Field
@@ -33,31 +46,33 @@
 import qualified Algebra.Additive as Additive
 
 import NumericPrelude.Numeric
-import NumericPrelude.Base hiding (and, iterate, map, zip, zipWith, take, takeWhile, )
+import NumericPrelude.Base hiding (and, iterate, map, zip, zipWith, take, takeWhile, init, )
 
 import qualified Prelude as P
 
 
 data T p a b =
-   forall state ioContext startParamTuple nextParamTuple.
-      (Storable startParamTuple,
-       Storable nextParamTuple,
-       MakeValueTuple startParamTuple,
-       MakeValueTuple nextParamTuple,
-       Memory.C (ValueTuple startParamTuple),
-       Memory.C (ValueTuple nextParamTuple),
+   forall context state ioContext parameters.
+      (Storable parameters,
+       MakeValueTuple parameters,
+       Memory.C (ValueTuple parameters),
+       Memory.C context,
        Memory.C state) =>
    Cons
       (forall r c.
        (Phi c) =>
-       ValueTuple nextParamTuple ->
-       a -> state -> Maybe.T r c (b, state))
+       context ->
+       a -> state -> MaybeCont.T r c (b, state))
           -- compute next value
       (forall r.
-       ValueTuple startParamTuple ->
-       CodeGenFunction r state)
+       ValueTuple parameters ->
+       CodeGenFunction r (context, state))
           -- initial state
-      (p -> IO (ioContext, (nextParamTuple, startParamTuple)))
+      (forall r.
+       context -> state ->
+       CodeGenFunction r ())
+          -- cleanup
+      (p -> IO (ioContext, parameters))
           {- initialization from IO monad
           This will be run within Unsafe.performIO,
           so no observable In/Out actions please!
@@ -65,41 +80,58 @@
       (ioContext -> IO ())
           -- finalization from IO monad, also run within Unsafe.performIO
 
+instance CausalClass.C (T p) where
+   type SignalOf (T p) = Sig.T p
+   type ProcessOf (Sig.T p) = T p
+   toSignal = toSignal
+   fromSignal = fromSignal
 
+instance Causal.C (T p) where
+   simple next start =
+      simple (\() -> next) (\() -> fmap ((,) ()) start) (pure ())
+
+   loopConst init (Cons next start stop createIOContext deleteIOContext) =
+      Cons
+         (loopNext next)
+         (fmap (mapSnd ((,) init)) . start)
+         (loopStop stop)
+         createIOContext
+         deleteIOContext
+
+   replicateControlled n = replicateControlled $ pure n
+
+
 simple ::
-   (Storable startParamTuple,
-    Storable nextParamTuple,
-    MakeValueTuple startParamTuple, ValueTuple startParamTuple ~ startParamValue,
-    MakeValueTuple nextParamTuple, ValueTuple nextParamTuple ~ nextParamValue,
-    Memory.C startParamValue,
-    Memory.C nextParamValue,
+   (Storable parameters,
+    MakeValueTuple parameters, ValueTuple parameters ~ paramValue,
+    Memory.C paramValue,
+    Memory.C context,
     Memory.C state) =>
    (forall r c.
     (Phi c) =>
-    nextParamValue ->
-    a -> state -> Maybe.T r c (b, state)) ->
+    context -> a -> state -> MaybeCont.T r c (b, state)) ->
    (forall r.
-    startParamValue ->
-    CodeGenFunction r state) ->
-   Param.T p nextParamTuple ->
-   Param.T p startParamTuple -> T p a b
-simple f start selectParam initial = Cons
-   (f . Param.value selectParam)
-   (start . Param.value initial)
-   (return . (,) () . Param.get (selectParam &&& initial))
-   (const $ return ())
+    paramValue ->
+    CodeGenFunction r (context, state)) ->
+   Param.T p parameters -> T p a b
+simple f start param =
+   Param.with param $ \get value -> Cons f
+      (start . value)
+      (const $ const $ return ())
+      (return . (,) () . get)
+      (const $ return ())
 
 
 toSignal :: T p () a -> Sig.T p a
-toSignal (Cons next start createIOContext deleteIOContext) = Sig.Cons
-   (\ioContext -> next ioContext ())
-   start
+toSignal (Cons next start stop createIOContext deleteIOContext) = Sig.Cons
+   (\p -> next p ())
+   start stop
    createIOContext deleteIOContext
 
 fromSignal :: Sig.T p b -> T p a b
-fromSignal (Sig.Cons next start createIOContext deleteIOContext) = Cons
-   (\ioContext _ -> next ioContext)
-   start
+fromSignal (Sig.Cons next start stop createIOContext deleteIOContext) = Cons
+   (\p _ -> next p)
+   start stop
    createIOContext deleteIOContext
 
 
@@ -114,9 +146,9 @@
    T p a b
 mapAccum next start selectParamN selectParamS =
    simple
-      (\p a s -> Maybe.lift $ next p a s)
-      start
-      selectParamN selectParamS
+      (\p a s -> MaybeCont.lift $ next p a s)
+      (\(n,s) -> fmap ((,) n) $ start s)
+      (selectParamN &&& selectParamS)
 
 
 map ::
@@ -137,6 +169,14 @@
 mapSimple f =
    map (const f) (return ())
 
+zipWith ::
+   (Storable ph, MakeValueTuple ph, ValueTuple ph ~ pl, Memory.C pl) =>
+   (forall r. pl -> a -> b -> CodeGenFunction r c) ->
+   Param.T p ph ->
+   T p (a,b) c
+zipWith f =
+   map (uncurry . f)
+
 zipWithSimple ::
    (forall r. a -> b -> CodeGenFunction r c) ->
    T p (a,b) c
@@ -145,16 +185,13 @@
 
 
 apply :: T p a b -> Sig.T p a -> Sig.T p b
-apply proc sig =
-   toSignal (proc <<< fromSignal sig)
+apply = CausalClass.apply
 
 feedFst :: Sig.T p a -> T p b (a,b)
-feedFst sig =
-   fromSignal sig &&& Cat.id
+feedFst = CausalClass.feedFst
 
 feedSnd :: Sig.T p a -> T p b (b,a)
-feedSnd sig =
-   Cat.id &&& fromSignal sig
+feedSnd = CausalClass.feedSnd
 
 
 {-
@@ -164,37 +201,203 @@
 -}
 compose :: T p a b -> T p b c -> T p a c
 compose
-      (Cons nextA startA createIOContextA deleteIOContextA)
-      (Cons nextB startB createIOContextB deleteIOContextB) =
+      (Cons nextA startA stopA createIOContextA deleteIOContextA)
+      (Cons nextB startB stopB createIOContextB deleteIOContextB) =
    Cons
-      (\(paramA, paramB) a (sa0,sb0) ->
-         do (b,sa1) <- nextA paramA a sa0
-            (c,sb1) <- nextB paramB b sb0
-            return (c, (sa1,sb1)))
-      (\(paramA, paramB) ->
-         liftM2 (,)
-            (startA paramA)
-            (startB paramB))
-      (\p -> do
-         (ca,(nextParamA,startParamA)) <- createIOContextA p
-         (cb,(nextParamB,startParamB)) <- createIOContextB p
-         return ((ca,cb),
-            ((nextParamA,  nextParamB),
-             (startParamA, startParamB))))
-      (\(ca,cb) ->
-         deleteIOContextA ca >>
-         deleteIOContextB cb)
+      (composeNext MaybeCont.onFail stopA stopB nextA nextB)
+      (composeStart startA startB)
+      (composeStop stopA stopB)
+      (composeCreate createIOContextA createIOContextB)
+      (composeDelete deleteIOContextA deleteIOContextB)
 
+composeNext ::
+   (Monad maybe) =>
+   (forall x. code () -> maybe x -> maybe x) ->
+   (contextA -> stateA -> code ()) ->
+   (contextB -> stateB -> code ()) ->
+   (contextA -> a -> stateA -> maybe (b, stateA)) ->
+   (contextB -> b -> stateB -> maybe (c, stateB)) ->
+   (contextA, contextB) ->
+   a ->
+   (stateA, stateB) ->
+   maybe (c, (stateA, stateB))
+composeNext onFail stopA stopB nextA nextB (paramA, paramB) a (sa0,sb0) = do
+   (b,sa1) <-
+      onFail (stopB paramB sb0) $
+      nextA paramA a sa0
+   (c,sb1) <-
+      onFail (stopA paramA sa1) $
+      nextB paramB b sb0
+   return (c, (sa1,sb1))
 
+composeStart ::
+   Monad m =>
+   (paramA -> m (contextA, stateA)) ->
+   (paramB -> m (contextB, stateB)) ->
+   (paramA, paramB) -> m ((contextA, contextB), (stateA, stateB))
+composeStart = Sig.combineStart
+
+composeStop ::
+   Monad m =>
+   (contextA -> stateA -> m ()) ->
+   (contextB -> stateB -> m ()) ->
+   (contextA, contextB) -> (stateA, stateB) -> m ()
+composeStop = Sig.combineStop
+
+composeCreate ::
+   Monad m =>
+   (p -> m (ioContextA, contextA)) ->
+   (p -> m (ioContextB, contextB)) ->
+   p -> m ((ioContextA, ioContextB), (contextA, contextB))
+composeCreate = Sig.combineCreate
+
+composeDelete ::
+   (Monad m) =>
+   (ca -> m ()) -> (cb -> m ()) -> (ca, cb) -> m ()
+composeDelete = Sig.combineDelete
+
+
 first :: T p b c -> T p (b, d) (c, d)
-first (Cons next start createIOContext deleteIOContext) = Cons
-   (\ioContext (b,d) sa0 ->
-      do (c,sa1) <- next ioContext b sa0
-         return ((c,d), sa1))
-   start
+first (Cons next start stop createIOContext deleteIOContext) = Cons
+   (firstNext next) start stop
    createIOContext deleteIOContext
 
+firstNext ::
+   Monad m =>
+   (context -> a -> s -> m (b, s)) ->
+   context -> (a, c) -> s -> m ((b, c), s)
+firstNext next context (b,d) sa0 = do
+   (c,sa1) <- next context b sa0
+   return ((c,d), sa1)
 
+
+{- |
+serial replication
+
+But you may also use it for a parallel replication, see 'replicateParallel'.
+-}
+replicateControlled ::
+   (Undefined x, Phi x) =>
+   Param.T p Int -> T p (c,x) x -> T p (c,x) x
+replicateControlled n (Cons next start stop createIOContext deleteIOContext) =
+   case Param.word32 n of
+      n32 -> Cons
+         (\(len, cs) ->
+            replicateControlledNext next stop (Param.value n32 len, cs))
+         (\(len, param) ->
+            replicateControlledStart start (Param.value n32 len, param))
+         (\(len, cs) ->
+            replicateControlledStop stop (Param.value n32 len, cs))
+         (\p ->
+            replicateControlledCreate $
+               M.replicate (Param.get n p) (createIOContext p))
+         (replicateControlledDelete deleteIOContext)
+
+replicateControlledNext ::
+   (Memory.C context, Memory.C state,
+    contextState ~
+       LLVM.Struct (Memory.Struct context, (Memory.Struct state, ())),
+    Phi z, Phi a, Undefined a) =>
+   (forall z0. (Phi z0) =>
+    context -> (ctrl, a) -> state ->
+    MaybeCont.T r z0 (a, state)) ->
+   (context -> state -> CodeGenFunction r ()) ->
+   (Value Word32, Value (Ptr contextState)) ->
+   (ctrl, a) ->
+   () ->
+   MaybeCont.T r z (a, ())
+replicateControlledNext next stop (len, contextStates) (c,a) () =
+   MaybeCont.fromMaybe $ fmap (\(_,ms) -> fmap (flip (,) ()) ms) $
+      MaybeCont.arrayLoop len contextStates a $
+            \contextStatePtr a0 -> do
+         (context, s0) <- MaybeCont.lift $ Memory.load contextStatePtr
+         (a1,s1) <-
+            MaybeCont.onFail
+               (replicateControlledStopExcept
+                  stop len contextStates contextStatePtr) $
+            next context (c,a0) s0
+         MaybeCont.lift $
+            Memory.store s1 =<< LLVM.getElementPtr0 contextStatePtr (d1, ())
+         return a1
+
+replicateControlledStopExcept ::
+   (Memory.C a, Memory.C b,
+    ab ~ LLVM.Struct (Memory.Struct a, (Memory.Struct b, ()))) =>
+   (a -> b -> CodeGenFunction r ()) ->
+   Value Word32 ->
+   Value (Ptr ab) ->
+   Value (Ptr ab) ->
+   CodeGenFunction r ()
+replicateControlledStopExcept stop len contextStates contextStatePtr =
+   C.arrayLoop len contextStates () $ \ptr () -> do
+      b <- A.cmp LLVM.CmpNE ptr contextStatePtr
+      C.ifThen b () $ uncurry stop =<< Memory.load ptr
+
+_replicateControlledNext ::
+   (Memory.C context, Memory.C state,
+    contextState ~
+       LLVM.Struct (Memory.Struct context, (Memory.Struct state, ())),
+    Phi z, Phi a, Undefined a) =>
+   (forall z0. (Phi z0) =>
+    context -> (ctrl, a) -> state ->
+    MaybeCont.T r z0 (a, state)) ->
+   (Value Word32, Value (Ptr contextState)) ->
+   (ctrl, a) ->
+   () ->
+   MaybeCont.T r z (a, ())
+_replicateControlledNext next (len, contextStates) (c,a) () =
+   fmap (flip (,) ()) $ MaybeCont.fromBool $ fmap snd $
+   C.arrayLoopWithExit len contextStates (valueOf True, a) $
+         \contextStatePtr (_,a0) -> do
+      (context, s0) <- Memory.load contextStatePtr
+      (cont, (a1,s1)) <- MaybeCont.toBool $ next context (c,a0) s0
+      Memory.store s1 =<< LLVM.getElementPtr0 contextStatePtr (d1, ())
+      return (cont, (cont,a1))
+
+replicateControlledStart ::
+   (Memory.C a, Memory.C b) =>
+   (a -> CodeGenFunction r b) ->
+   (Value Word32, Value (Ptr (Memory.Struct a))) ->
+   CodeGenFunction r ((Value Word32, Value (Ptr (Memory.Struct b))), ())
+replicateControlledStart start (len, params) = do
+   contextStates <- LLVM.arrayMalloc len
+   C.arrayLoop2 len params contextStates () $ \paramPtr statePtr () ->
+      flip Memory.store statePtr =<< start =<< Memory.load paramPtr
+   return ((len, contextStates), ())
+
+replicateControlledStop ::
+   (Memory.C a, Memory.C b,
+    ab ~ LLVM.Struct (Memory.Struct a, (Memory.Struct b, ()))) =>
+   (a -> b -> CodeGenFunction r ()) ->
+   (Value Word32, Value (Ptr ab)) ->
+   () ->
+   CodeGenFunction r ()
+replicateControlledStop stop (len, contextStates) () = do
+   C.arrayLoop len contextStates () $ \contextStatePtr () ->
+      uncurry stop =<< Memory.load contextStatePtr
+   LLVM.free contextStates
+
+
+replicateControlledCreate ::
+   (Monad m, MakeValueTuple b, Storable b, ValueTuple b ~ bl, Memory.C bl) =>
+   m [(a, b)] ->
+   m (([a], ForeignPtr b),
+      (Word32, Ptr (Memory.Struct bl)))
+replicateControlledCreate createIOContexts = do
+   (ioContexts, params) <- M.lift unzip createIOContexts
+   let (fptr, ptr, len) = SVU.unsafeToPointers $ SV.pack params
+   return
+      ((ioContexts, fptr),
+       (fromIntegral len, ptr))
+
+replicateControlledDelete ::
+   (a -> IO ()) ->
+   ([a], ForeignPtr b) -> IO ()
+replicateControlledDelete deleteIOContext (ioContexts, fptr) = do
+   mapM_ deleteIOContext ioContexts
+   touchForeignPtr fptr
+
+
 instance Cat.Category (T p) where
    id = mapSimple return
    (.) = flip compose
@@ -253,23 +456,22 @@
 in a way that allows to access a result before creating the input.
 -}
 loop ::
-   (Storable ch,
-    MakeValueTuple ch, ValueTuple ch ~ c,
-    Memory.C c) =>
-   Param.T p ch -> T p (a,c) (b,c) -> T p a b
-loop initial (Cons next start createIOContext deleteIOContext) =
-   Cons
-      (\p a0 (c0,s0) -> do
-         ((b1,c1), s1) <- next p (a0,c0) s0
-         return (b1,(c1,s1)))
-      (\(i,p) -> fmap ((,) (Param.value initial i)) $ start p)
+   (Storable c, MakeValueTuple c, ValueTuple c ~ cl, Memory.C cl) =>
+   Param.T p c -> T p (a,cl) (b,cl) -> T p a b
+loop initial (Cons next start stop createIOContext deleteIOContext) =
+   Param.with initial $ \getInitial valueInitial -> Cons
+      (loopNext next)
+      (\(i,p) -> fmap (mapSnd ((,) (valueInitial i))) $ start p)
+      (loopStop stop)
       (\p -> do
-         (ctx,(nextParam,startParam)) <- createIOContext p
-         return (ctx,
-            (nextParam, (Param.get initial p, startParam))))
+         (ctx, param) <- createIOContext p
+         return (ctx, (getInitial p, param)))
       deleteIOContext
 
+loopStop :: (context -> state -> m) -> context -> (c, state) -> m
+loopStop stop ctx (_c,s) = stop ctx s
 
+
 takeWhile ::
    (Storable ph, MakeValueTuple ph, ValueTuple ph ~ pl, Memory.C pl) =>
    (forall r. pl -> a -> CodeGenFunction r (Value Bool)) ->
@@ -277,11 +479,10 @@
    T p a a
 takeWhile check selectParam = simple
    (\p a () -> do
-      Maybe.guard =<< Maybe.lift (check p a)
+      MaybeCont.guard =<< MaybeCont.lift (check p a)
       return (a, ()))
-   return
+   (\p -> return (p, ()))
    selectParam
-   (return ())
 
 
 take ::
@@ -289,7 +490,7 @@
    T p a a
 take len =
    snd ^<<
-   takeWhile (const $ A.cmp LLVM.CmpLT (valueOf 0) . fst) (return ()) <<<
+   takeWhile (const $ A.cmp LLVM.CmpLT A.zero . fst) (return ()) <<<
    feedFst
       (Sig.iterate (const A.dec) (return ())
          ((fromIntegral :: Int -> Word32) . max 0 ^<< len))
@@ -297,7 +498,7 @@
 
 {- |
 The first output value is the initial value.
-Thus 'integrate' delays by one sample compared with 'integrate0'.
+Thus 'integrate' delays by one sample compared with 'integrateSync'.
 -}
 integrate ::
    (Storable a, A.Additive al,
@@ -307,10 +508,10 @@
 integrate =
    flip loop (arr snd &&& zipWithSimple A.add)
 
-integrate0 ::
+integrateSync ::
    (Storable a, A.Additive al,
     MakeValueTuple a, ValueTuple a ~ al, Memory.C al) =>
    Param.T p a ->
    T p al al
-integrate0 =
+integrateSync =
    flip loop ((\a -> (a,a)) ^<< zipWithSimple A.add)
diff --git a/src/Synthesizer/LLVM/CausalParameterized/ProcessValue.hs b/src/Synthesizer/LLVM/CausalParameterized/ProcessValue.hs
--- a/src/Synthesizer/LLVM/CausalParameterized/ProcessValue.hs
+++ b/src/Synthesizer/LLVM/CausalParameterized/ProcessValue.hs
@@ -8,22 +8,25 @@
 -}
 module Synthesizer.LLVM.CausalParameterized.ProcessValue (
 --   simple,
-   mapAccum, map, mapSimple,
+   mapAccum, map, mapSimple, zipWith, zipWithSimple,
+   takeWhile,
    ) where
 
 import Synthesizer.LLVM.CausalParameterized.ProcessPrivate (T, )
-import qualified Synthesizer.LLVM.CausalParameterized.ProcessPrivate as Causal
-import qualified Synthesizer.LLVM.Parameter as Param
-
+import qualified Synthesizer.LLVM.CausalParameterized.ProcessPrivate as CausalP
+import qualified Synthesizer.LLVM.Causal.ProcessValue as CausalV
 import qualified Synthesizer.LLVM.Simple.Value as Value
+import qualified Synthesizer.LLVM.Parameter as Param
 
 import qualified LLVM.Extra.Memory as Memory
 import LLVM.Extra.Class (MakeValueTuple, ValueTuple, )
 
+import qualified LLVM.Core as LLVM
+
 import Foreign.Storable.Tuple ()
 import Foreign.Storable (Storable, )
 
-import Prelude hiding (map, )
+import Prelude hiding (map, zipWith, takeWhile, )
 
 
 {-
@@ -41,7 +44,7 @@
    Param.T p nextParamTuple ->
    Param.T p startParamTuple -> T p a b
 simple f start =
-   Causal.simple
+   CausalP.simple
       (\p a s ->
          Value.flattenMaybe $
          next
@@ -56,14 +59,25 @@
    (Value.T pl -> Value.T a -> Value.T b) ->
    Param.T p ph ->
    T p a b
-map f = Causal.map (Value.unlift2 f)
+map f = CausalP.map (Value.unlift2 f)
 
 mapSimple ::
    (Value.T a -> Value.T b) ->
    T p a b
-mapSimple f =
-   Causal.mapSimple (Value.unlift1 f)
+mapSimple = CausalV.map
 
+zipWith ::
+   (Storable ph, MakeValueTuple ph, ValueTuple ph ~ pl, Memory.C pl) =>
+   (Value.T pl -> Value.T a -> Value.T b -> Value.T c) ->
+   Param.T p ph -> T p (a,b) c
+zipWith f =
+   CausalP.zipWith (Value.unlift3 f)
+
+zipWithSimple ::
+   (Value.T a -> Value.T b -> Value.T c) ->
+   T p (a,b) c
+zipWithSimple = CausalV.zipWith
+
 mapAccum ::
    (Storable pnh, MakeValueTuple pnh, ValueTuple pnh ~ pnl, Memory.C pnl,
     Storable psh, MakeValueTuple psh, ValueTuple psh ~ psl, Memory.C psl,
@@ -74,11 +88,14 @@
    Param.T p psh ->
    T p a b
 mapAccum next start =
-   Causal.mapAccum
-      (\p a s ->
-         Value.flatten $
-         next
-            (Value.constantValue p)
-            (Value.constantValue a)
-            (Value.constantValue s))
+   CausalP.mapAccum
+      (Value.unlift3 next)
       (Value.unlift1 start)
+
+takeWhile ::
+   (Storable ph, MakeValueTuple ph, ValueTuple ph ~ pl, Memory.C pl) =>
+   (Value.T pl -> Value.T a -> Value.T (LLVM.Value Bool)) ->
+   Param.T p ph ->
+   T p a a
+takeWhile check =
+   CausalP.takeWhile (Value.unlift2 check)
diff --git a/src/Synthesizer/LLVM/ConstantPiece.hs b/src/Synthesizer/LLVM/ConstantPiece.hs
--- a/src/Synthesizer/LLVM/ConstantPiece.hs
+++ b/src/Synthesizer/LLVM/ConstantPiece.hs
@@ -33,12 +33,10 @@
 import Data.Word (Word32, )
 import Foreign.Storable.Tuple ()
 import Foreign.Storable (Storable, )
-import Foreign.Ptr (Ptr, )
-import qualified Synthesizer.LLVM.Alloc as Alloc
 
 import Control.Applicative (liftA2, )
 
-import NumericPrelude.Numeric
+import NumericPrelude.Numeric ()
 import NumericPrelude.Base
 
 
@@ -82,21 +80,20 @@
    (Memory.C value) =>
    SigP.T p (T value) ->
    SigP.T p value
-flatten (SigP.Cons next start createIOContext deleteIOContext) =
+flatten (SigP.Cons next start stop createIOContext deleteIOContext) =
    SigP.Cons
-      (\nextParam state0 -> do
+      (\context state0 -> do
          (Cons length1 y1, s1) <-
             Maybe.fromBool $
             whileLoop (valueOf True, state0)
                (\(cont, (Cons len _y, _s)) ->
-                  LLVM.and cont =<< A.cmp LLVM.CmpEQ len (valueOf 0))
+                  LLVM.and cont =<< A.cmp LLVM.CmpEQ len A.zero)
                (\(_cont, (Cons _len _y, s)) ->
-                  Maybe.toBool $ next nextParam s)
+                  Maybe.toBool $ next context s)
          length2 <- Maybe.lift (A.dec length1)
          return (y1, (Cons length2 y1, s1)))
-      (\startParam ->
-         fmap ((,) (Cons (valueOf 0) undefTuple)) $
-         start startParam)
+      (SigP.withStart start (return . ((,) (Cons A.zero undefTuple))))
+      (\context (_, state) -> stop context state)
       createIOContext deleteIOContext
 
 
@@ -105,29 +102,21 @@
    Param.T p (EventList.T NonNeg.Int a) ->
    SigP.T p (T value)
 piecewiseConstant evs = SigP.Cons
-   (\(stable, yPtr) () -> do
+   (\stable () -> do
+      yPtr <- Maybe.lift $ LLVM.alloca
       len <- Maybe.lift $ do
          nextFn <- LLVM.staticFunction EventIt.nextCallBack
          LLVM.call nextFn stable yPtr
       Maybe.guard =<<
-         Maybe.lift (A.cmp LLVM.CmpNE len (valueOf 0))
+         Maybe.lift (A.cmp LLVM.CmpNE len A.zero)
       y <- Maybe.lift $ Memory.load yPtr
       return (Cons len y, ()))
    return
+   (const $ const $ return ())
    (\p -> do
       stable <- EventIt.new (Param.get evs p)
-      yPtr <- Alloc.malloc
-      return ((stable, asTypeOfEventListElement yPtr evs),
-              ((stable, Memory.castStorablePtr yPtr), ())))
-   (\(stable,yPtr) -> do
-      EventIt.dispose stable
-      Alloc.free yPtr)
-
-asTypeOfEventListElement ::
-   Ptr a ->
-   Param.T p (EventList.T NonNeg.Int a) ->
-   Ptr a
-asTypeOfEventListElement ptr _ = ptr
+      return (stable, (stable, ())))
+   EventIt.dispose
 
 
 lazySize ::
@@ -139,9 +128,10 @@
          nextFn <- LLVM.staticFunction SizeIt.nextCallBack
          LLVM.call nextFn stable
       Maybe.guard =<<
-         Maybe.lift (A.cmp LLVM.CmpNE len (valueOf 0))
+         Maybe.lift (A.cmp LLVM.CmpNE len A.zero)
       return (Cons len (), ()))
    return
+   (const $ const $ return ())
    (\p -> do
       stable <- SizeIt.new (Param.get size p)
       return (stable, (stable, ())))
diff --git a/src/Synthesizer/LLVM/EventIterator.hs b/src/Synthesizer/LLVM/EventIterator.hs
--- a/src/Synthesizer/LLVM/EventIterator.hs
+++ b/src/Synthesizer/LLVM/EventIterator.hs
@@ -1,10 +1,14 @@
 {-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE ForeignFunctionInterface #-}
 module Synthesizer.LLVM.EventIterator where
 
 import qualified Data.EventList.Relative.BodyTime as EventList
 import qualified Numeric.NonNegative.Wrapper as NonNeg
 
+import qualified LLVM.Extra.Memory as Memory
+import qualified LLVM.Extra.Class as Class
+
 import Data.Word (Word32, )
 import Foreign.Storable (Storable, poke, )
 import Foreign.Ptr (Ptr, castPtr, )
@@ -18,24 +22,27 @@
 import qualified Synthesizer.LLVM.Debug.StablePtr as DebugStable
 
 
-data T =
-   forall a. Storable a =>
-   Cons (IORef (EventList.T NonNeg.Int a))
-
 {-
-For problems about Storable constraint, see ChunkIterator.
+For problems on constraints, see ChunkIterator.
 -}
+data T a =
+   (Storable a, Class.MakeValueTuple a, Memory.C (Class.ValueTuple a)) =>
+   Cons (IORef (EventList.T NonNeg.Int a))
+
+type MemoryPtr a = Ptr (Memory.Struct (Class.ValueTuple a))
+
+
 foreign import ccall "&nextConstant"
    nextCallBack ::
       FunPtr (
-         StablePtr T ->
-         Ptr a -> IO Word32
+         StablePtr (T a) ->
+         MemoryPtr a -> IO Word32
       )
 
 foreign export ccall "nextConstant"
    next ::
-      StablePtr T ->
-      Ptr a -> IO Word32
+      StablePtr (T a) ->
+      MemoryPtr a -> IO Word32
 
 
 {- |
@@ -44,8 +51,8 @@
 say below 100).
 -}
 new ::
-   Storable a =>
-   EventList.T NonNeg.Int a -> IO (StablePtr T)
+   (Storable a, Class.MakeValueTuple a, Memory.C (Class.ValueTuple a)) =>
+   EventList.T NonNeg.Int a -> IO (StablePtr (T a))
 new evs =
    DebugStable.trace "new" =<<
    newStablePtr . Cons
@@ -55,12 +62,12 @@
        EventList.toPairList evs)
 
 dispose ::
-   StablePtr T -> IO ()
+   StablePtr (T a) -> IO ()
 dispose = freeStablePtr <=< DebugStable.trace "dispose"
 
 next ::
-   StablePtr T ->
-   Ptr a -> IO Word32
+   StablePtr (T a) ->
+   MemoryPtr a -> IO Word32
 next stable eventPtr =
    DebugStable.trace "next" stable >>=
    deRefStablePtr >>= \state ->
diff --git a/src/Synthesizer/LLVM/Filter/Allpass.hs b/src/Synthesizer/LLVM/Filter/Allpass.hs
--- a/src/Synthesizer/LLVM/Filter/Allpass.hs
+++ b/src/Synthesizer/LLVM/Filter/Allpass.hs
@@ -3,10 +3,16 @@
 {-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE DeriveTraversable #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 module Synthesizer.LLVM.Filter.Allpass (
    Parameter, parameter,
    CascadeParameter, flangerParameter, flangerParameterPlain,
+   causal, cascade, phaser,
+   cascadePipeline, phaserPipeline,
+   causalPacked, cascadePacked, phaserPacked,
+
    causalP, cascadeP, phaserP,
    cascadePipelineP, phaserPipelineP,
    causalPackedP, cascadePackedP, phaserPackedP,
@@ -21,6 +27,8 @@
 
 import qualified Synthesizer.LLVM.CausalParameterized.Process as CausalP
 import qualified Synthesizer.LLVM.CausalParameterized.Functional as F
+import qualified Synthesizer.LLVM.Causal.ProcessValue as CausalV
+import qualified Synthesizer.LLVM.Causal.Process as Causal
 import qualified Synthesizer.LLVM.Frame.SerialVector as Serial
 import qualified Synthesizer.LLVM.Simple.Value as Value
 
@@ -28,6 +36,7 @@
 import qualified LLVM.Extra.Memory as Memory
 import qualified LLVM.Extra.Class as Class
 import qualified LLVM.Extra.Arithmetic as A
+import qualified LLVM.Util.Loop as Loop
 import qualified LLVM.Core as LLVM
 import LLVM.Extra.Class (Undefined, undefTuple, )
 import LLVM.Core (CodeGenFunction, )
@@ -85,8 +94,8 @@
 
 instance (Value.Flatten a) => Value.Flatten (Parameter a) where
    type Registers (Parameter a) = Parameter (Value.Registers a)
-   flatten = Value.flattenTraversable
-   unfold =  Value.unfoldFunctor
+   flattenCode = Value.flattenCodeTraversable
+   unfoldCode = Value.unfoldCodeTraversable
 
 
 instance (Vector.Simple v) => Vector.Simple (Parameter v) where
@@ -102,18 +111,20 @@
 parameter ::
    (A.Transcendental a, A.RationalConstant a) =>
    a -> a -> CodeGenFunction r (Parameter a)
-parameter phase freq =
-   Value.flatten $
-   Allpass.parameter
-      (Value.constantValue phase) (Value.constantValue freq)
+parameter = Value.unlift2 Allpass.parameter
 
 
 newtype CascadeParameter n a =
    CascadeParameter (Allpass.Parameter a)
       deriving
-         (Phi, Undefined, Class.Zero, Storable,
+         (Undefined, Class.Zero, Storable,
           Functor, App.Applicative, Fold.Foldable, Trav.Traversable)
 
+instance (Phi a) => Phi (CascadeParameter n a) where
+   phis bb (CascadeParameter v) = fmap CascadeParameter $ Loop.phis bb v
+   addPhis bb (CascadeParameter x) (CascadeParameter y) = Loop.addPhis bb x y
+
+
 instance (Memory.C a) => Memory.C (CascadeParameter n a) where
    type Struct (CascadeParameter n a) = Memory.Struct a
    load = Memory.loadNewtype CascadeParameter
@@ -137,8 +148,8 @@
 
 instance (Value.Flatten a) => Value.Flatten (CascadeParameter n a) where
    type Registers (CascadeParameter n a) = CascadeParameter n (Value.Registers a)
-   flatten = Value.flattenTraversable
-   unfold =  Value.unfoldFunctor
+   flattenCode = Value.flattenCodeTraversable
+   unfoldCode = Value.unfoldCodeTraversable
 
 
 instance (Vector.Simple v) => Vector.Simple (CascadeParameter n v) where
@@ -159,11 +170,8 @@
    (A.Transcendental a, A.RationalConstant a, TypeNum.NaturalT n) =>
    n -> a ->
    CodeGenFunction r (CascadeParameter n a)
-flangerParameter order freq =
-   Value.flatten $
-   CascadeParameter $
-   Allpass.flangerParameter (TypeNum.fromIntegerT order) $
-   Value.constantValue freq
+flangerParameter order =
+   Value.unlift1 (flangerParameterPlain order)
 
 flangerParameterPlain ::
    (Trans.C a, TypeNum.NaturalT n) =>
@@ -174,7 +182,7 @@
 
 
 modifier ::
-   (A.PseudoModule a v, A.IntegerConstant a) =>
+   (a ~ A.Scalar v, A.PseudoModule v, A.IntegerConstant a) =>
    Modifier.Simple
       -- (Allpass.State (Value.T v))
       (Value.T v, Value.T v)
@@ -184,50 +192,50 @@
    Allpass.firstOrderModifier
 
 {-
-For Allpass cascade you may use the 'CausalP.pipeline' function.
+For Allpass cascade you may use the 'Causal.pipeline' function.
 -}
-causalP ::
-   (A.RationalConstant a, A.PseudoModule a v, Memory.C v) =>
-   CausalP.T p (Parameter a, v) v
-causalP =
-   CausalP.fromModifier modifier
+causal ::
+   (Causal.C process,
+    A.RationalConstant a, a ~ A.Scalar v, A.PseudoModule v, Memory.C v) =>
+   process (Parameter a, v) v
+causal =
+   Causal.fromModifier modifier
 
 
 replicateStage ::
-   (TypeNum.NaturalT n) =>
+   (Causal.C process,
+    TypeNum.NaturalT n, Phi b, Undefined b) =>
    n ->
-   CausalP.T p (Parameter a, b) b ->
-   CausalP.T p (CascadeParameter n a, b) b
+   process (Parameter a, b) b ->
+   process (CascadeParameter n a, b) b
 replicateStage order stg =
-   CausalP.replicateControlled
+   Causal.replicateControlled
       (TypeNum.fromIntegerT order)
       (stg <<< first (arr (\(CascadeParameter p) -> p)))
 
-cascadeP ::
-   (A.RationalConstant a, A.PseudoModule a v, Memory.C v,
+cascade ::
+   (Causal.C process,
+    A.RationalConstant a, a ~ A.Scalar v, A.PseudoModule v, Memory.C v,
     TypeNum.NaturalT n) =>
-   CausalP.T p (CascadeParameter n a, v) v
-cascadeP =
-   replicateStage undefined causalP
+   process (CascadeParameter n a, v) v
+cascade =
+   replicateStage undefined causal
 
 half ::
-   (A.RationalConstant a, A.PseudoModule a v) =>
-   CausalP.T p (param a, v) v
-half =
-   let scale :: A.PseudoModule a v => param a -> a -> v -> CodeGenFunction r v
-       scale _ = A.scale
-   in  CausalP.mapSimple
-          (\(p,x) -> scale p (A.fromRational' 0.5) x)
+   (Causal.C process, A.RationalConstant a, a ~ A.Scalar v, A.PseudoModule v) =>
+   process v v
+half = CausalV.map (Value.fromRational' 0.5 *>)
 
-phaserP ::
-   (A.RationalConstant a, A.RationalConstant v,
-    A.PseudoModule a v, Memory.C v,
+phaser ::
+   (Causal.C process,
+    A.RationalConstant a, A.RationalConstant v,
+    a ~ A.Scalar v, A.PseudoModule v, Memory.C v,
     TypeNum.NaturalT n) =>
-   CausalP.T p (CascadeParameter n a, v) v
-phaserP =
-   CausalP.mix <<<
-   cascadeP &&& arr snd <<<
-   (arr fst &&& half)
+   process (CascadeParameter n a, v) v
+phaser =
+   Causal.mix <<<
+   cascade &&& arr snd <<<
+   second half
 
 
 {-
@@ -235,21 +243,22 @@
 but LLVM-2.6 does not yet do it.
 -}
 stage ::
-   (Vector.Canonical n a, Vector.Construct n a ~ v,
-    A.PseudoModule a a, A.IntegerConstant a, Memory.C a) =>
+   (Causal.C process,
+    Vector.Canonical n a, Vector.Construct n a ~ v,
+    a ~ A.Scalar a, A.PseudoModule a, A.IntegerConstant a, Memory.C a) =>
    n ->
-   CausalP.T p
+   process
       (CascadeParameter n v, v)
       (CascadeParameter n v, v)
 stage _ =
-   CausalP.vectorize
+   Causal.vectorize
       (arr fst &&&
-       (CausalP.fromModifier modifier <<<
+       (Causal.fromModifier modifier <<<
         first (arr (\(CascadeParameter p) -> p))))
 
 withSize ::
-   (n -> CausalP.T p (CascadeParameter n a, b) c) ->
-   CausalP.T p (CascadeParameter n a, b) c
+   (n -> process (CascadeParameter n a, b) c) ->
+   process (CascadeParameter n a, b) c
 withSize f = f undefined
 
 {- |
@@ -258,47 +267,51 @@
 primitive element types
 and we get a delay by the number of pipeline stages.
 -}
-cascadePipelineP ::
-   (Vector.Canonical n a, Vector.Construct n a ~ v,
-    A.PseudoModule a a, A.IntegerConstant a, Memory.C a,
-    Class.Zero v, Memory.C v) =>
-   CausalP.T p (CascadeParameter n a, a) a
-cascadePipelineP = withSize $ \order ->
-   snd ^<< CausalP.pipeline (stage order)
+cascadePipeline ::
+   (Causal.C process,
+    Vector.Canonical n a, Vector.Construct n a ~ v,
+    a ~ A.Scalar a, A.PseudoModule a, A.IntegerConstant a, Memory.C a,
+    A.Additive v, Memory.C v) =>
+   process (CascadeParameter n a, a) a
+cascadePipeline = withSize $ \order ->
+   snd ^<< Causal.pipeline (stage order)
 
 vectorId ::
-   (Vector.Canonical n a) =>
-   n -> CausalP.T p (Vector.Construct n a) (Vector.Construct n a)
+   (Causal.C process, Vector.Canonical n a) =>
+   n -> process (Vector.Construct n a) (Vector.Construct n a)
 vectorId _ = Cat.id
 
-phaserPipelineP ::
-   (Vector.Canonical n a, Vector.Construct n a ~ v,
-    A.PseudoModule a a, A.RationalConstant a, Memory.C a,
-    Class.Zero v, Memory.C v) =>
-   CausalP.T p (CascadeParameter n a, a) a
-phaserPipelineP = withSize $ \order ->
-   CausalP.mix <<<
-   cascadePipelineP &&&
-   (CausalP.pipeline (vectorId order) <<^ snd) <<<
---   (CausalP.delay (const zero) (const $ TypeNum.fromIntegerT order) <<^ snd) <<<
-   (arr fst &&& half)
+phaserPipeline ::
+   (Causal.C process,
+    Vector.Canonical n a, Vector.Construct n a ~ v,
+    a ~ A.Scalar a, A.PseudoModule a, A.RationalConstant a, Memory.C a,
+    A.Additive v, Memory.C v) =>
+   process (CascadeParameter n a, a) a
+phaserPipeline = withSize $ \order ->
+   Causal.mix <<<
+   cascadePipeline &&&
+   (Causal.pipeline (vectorId order) <<^ snd) <<<
+--   (Causal.delay (const zero) (const $ TypeNum.fromIntegerT order) <<^ snd) <<<
+   second half
 
 
-causalPackedP,
-  causalNonRecursivePackedP ::
-   (Serial.C v, Serial.Element v ~ a,
+causalPacked,
+  causalNonRecursivePacked ::
+   (Causal.C process,
+    Serial.C v, Serial.Element v ~ a,
     Memory.C a, A.IntegerConstant a,
     A.PseudoRing v, A.PseudoRing a) =>
-   CausalP.T p (Parameter a, v) v
-causalPackedP =
-   Filt1L.causalRecursivePackedP <<<
-   (CausalP.mapSimple
+   process (Parameter a, v) v
+
+causalPacked =
+   Filt1L.causalRecursivePacked <<<
+   (Causal.map
        (\(Parameter k, _) ->
            fmap Filt1.Parameter $ A.neg k) &&&
-    causalNonRecursivePackedP)
+    causalNonRecursivePacked)
 
-causalNonRecursivePackedP =
-   CausalP.mapAccumSimple
+causalNonRecursivePacked =
+   Causal.mapAccum
       (\(Parameter k, v0) x1 -> do
          (_,v1) <- Serial.shiftUp x1 v0
          y <- A.add v1 =<< A.mul v0 =<< Serial.upsample k
@@ -307,16 +320,80 @@
          return (y, u0))
       (return A.zero)
 
+cascadePacked, phaserPacked ::
+   (Causal.C process,
+    TypeNum.NaturalT n,
+    Serial.C v, Serial.Element v ~ a,
+    A.PseudoRing a, A.IntegerConstant a, Memory.C a,
+    A.PseudoRing v, A.RationalConstant v) =>
+   process (CascadeParameter n a, v) v
+cascadePacked =
+   replicateStage undefined causalPacked
+
+phaserPacked =
+   Causal.mix <<<
+   cascadePacked &&& arr snd <<<
+   second (Causal.map (A.mul (A.fromRational' 0.5)))
+
+
+
+
+
+causalP ::
+   (A.RationalConstant a, a ~ A.Scalar v, A.PseudoModule v, Memory.C v) =>
+   CausalP.T p (Parameter a, v) v
+causalP = causal
+
+cascadeP ::
+   (A.RationalConstant a, a ~ A.Scalar v, A.PseudoModule v, Memory.C v,
+    TypeNum.NaturalT n) =>
+   CausalP.T p (CascadeParameter n a, v) v
+cascadeP = cascade
+
+phaserP ::
+   (A.RationalConstant a, A.RationalConstant v,
+    a ~ A.Scalar v, A.PseudoModule v, Memory.C v,
+    TypeNum.NaturalT n) =>
+   CausalP.T p (CascadeParameter n a, v) v
+phaserP = phaser
+
+
+cascadePipelineP ::
+   (Vector.Canonical n a, Vector.Construct n a ~ v,
+    a ~ A.Scalar a, A.PseudoModule a, A.IntegerConstant a, Memory.C a,
+    A.Additive v, Memory.C v) =>
+   CausalP.T p (CascadeParameter n a, a) a
+cascadePipelineP = cascadePipeline
+
+phaserPipelineP ::
+   (Vector.Canonical n a, Vector.Construct n a ~ v,
+    a ~ A.Scalar a, A.PseudoModule a, A.RationalConstant a, Memory.C a,
+    A.Additive v, Memory.C v) =>
+   CausalP.T p (CascadeParameter n a, a) a
+phaserPipelineP = phaserPipeline
+
+
+causalPackedP ::
+   (Serial.C v, Serial.Element v ~ a,
+    Memory.C a, A.IntegerConstant a,
+    A.PseudoRing v, A.PseudoRing a) =>
+   CausalP.T p (Parameter a, v) v
+causalPackedP = causalPacked
+
 cascadePackedP, phaserPackedP ::
    (TypeNum.NaturalT n,
     Serial.C v, Serial.Element v ~ a,
     A.PseudoRing a, A.IntegerConstant a, Memory.C a,
     A.PseudoRing v, A.RationalConstant v) =>
    CausalP.T p (CascadeParameter n a, v) v
-cascadePackedP =
-   replicateStage undefined causalPackedP
+cascadePackedP = cascadePacked
+phaserPackedP = phaserPacked
 
-phaserPackedP =
-   CausalP.mix <<<
-   cascadePackedP &&& arr snd <<<
-   second (CausalP.mapSimple (A.mul (A.fromRational' 0.5)))
+{-# DEPRECATED causalP          "use 'causal' instead" #-}
+{-# DEPRECATED cascadeP         "use 'cascade' instead" #-}
+{-# DEPRECATED phaserP          "use 'phaser' instead" #-}
+{-# DEPRECATED cascadePipelineP "use 'cascadePipeline' instead" #-}
+{-# DEPRECATED phaserPipelineP  "use 'phaserPipeline' instead" #-}
+{-# DEPRECATED causalPackedP    "use 'causalPacked' instead" #-}
+{-# DEPRECATED cascadePackedP   "use 'cascadePacked' instead" #-}
+{-# DEPRECATED phaserPackedP    "use 'phaserPacked' instead" #-}
diff --git a/src/Synthesizer/LLVM/Filter/Butterworth.hs b/src/Synthesizer/LLVM/Filter/Butterworth.hs
--- a/src/Synthesizer/LLVM/Filter/Butterworth.hs
+++ b/src/Synthesizer/LLVM/Filter/Butterworth.hs
@@ -4,6 +4,7 @@
 {-# LANGUAGE FlexibleContexts #-}
 module Synthesizer.LLVM.Filter.Butterworth (
    parameter, Cascade.ParameterValue,
+   Cascade.causal,  Cascade.causalPacked,
    Cascade.causalP, Cascade.causalPackedP,
    Cascade.fixSize,
    ) where
@@ -12,7 +13,6 @@
 import qualified Synthesizer.LLVM.Filter.SecondOrder as Filt2
 
 import qualified Synthesizer.Plain.Filter.Recursive.Butterworth as Butterworth
-import qualified Synthesizer.Plain.Filter.Recursive.SecondOrder as Filt2Core
 import Synthesizer.Plain.Filter.Recursive (Passband, )
 
 import qualified Synthesizer.LLVM.Simple.Value as Value
@@ -24,7 +24,7 @@
 import qualified LLVM.Core as LLVM
 import LLVM.Core
    (Value, valueOf, constOf,
-    IsConst, IsFloating, IsSized, SizeOf,
+    IsFloating, IsSized, SizeOf,
     CodeGenFunction, )
 import Data.Word (Word32, )
 
@@ -51,8 +51,7 @@
 
 parameterMalloc n kind ratio freq = do
    let order = 2 * TypeNum.fromIntegerT n
-   partialRatio <-
-      Value.decons (Butterworth.partialRatio order (Value.constantValue ratio))
+   partialRatio <- Value.unlift1 (Butterworth.partialRatio order) ratio
    let sines =
           (flip const :: n -> LLVM.Value (LLVM.Array n a)
                            -> LLVM.Value (LLVM.Array n a)) n $
@@ -69,13 +68,7 @@
       sinw <- LLVM.load si
       flip LLVM.store ptri =<<
          Filt2.composeParameter =<<
-         Value.flatten
-            (Filt2Core.adjustPassband kind
-               (flip
-                  (Butterworth.partialParameter
-                      (Value.constantValue partialRatio))
-                  (Value.constantValue sinw))
-               (Value.constantValue freq))
+         Value.unlift3 (Butterworth.partialParameter kind) partialRatio sinw freq
       A.advanceArrayElementPtr si
    pv <- LLVM.load ps
    LLVM.free psine
@@ -84,8 +77,7 @@
 
 _parameterAlloca n kind ratio freq = do
    let order = 2 * TypeNum.fromIntegerT n
-   partialRatio <-
-      Value.decons (Butterworth.partialRatio order (Value.constantValue ratio))
+   partialRatio <- Value.unlift1 (Butterworth.partialRatio order) ratio
    let sines =
           (flip const :: n -> LLVM.Value (LLVM.Array n a)
                            -> LLVM.Value (LLVM.Array n a)) n $
@@ -102,12 +94,6 @@
       sinw <- LLVM.load si
       flip LLVM.store ptri =<<
          Filt2.composeParameter =<<
-         Value.flatten
-            (Filt2Core.adjustPassband kind
-               (flip
-                  (Butterworth.partialParameter
-                      (Value.constantValue partialRatio))
-                  (Value.constantValue sinw))
-               (Value.constantValue freq))
+         Value.unlift3 (Butterworth.partialParameter kind) partialRatio sinw freq
       A.advanceArrayElementPtr si
    fmap Cascade.ParameterValue $ LLVM.load ps
diff --git a/src/Synthesizer/LLVM/Filter/Chebyshev.hs b/src/Synthesizer/LLVM/Filter/Chebyshev.hs
--- a/src/Synthesizer/LLVM/Filter/Chebyshev.hs
+++ b/src/Synthesizer/LLVM/Filter/Chebyshev.hs
@@ -4,6 +4,7 @@
 {-# LANGUAGE FlexibleContexts #-}
 module Synthesizer.LLVM.Filter.Chebyshev (
    parameterA, parameterB, Cascade.ParameterValue,
+   Cascade.causal,  Cascade.causalPacked,
    Cascade.causalP, Cascade.causalPackedP,
    Cascade.fixSize,
    ) where
@@ -26,7 +27,6 @@
    (Value, valueOf, IsSized, SizeOf, IsFloating, CodeGenFunction, )
 import Data.Word (Word32, )
 
-import qualified Types.Data.Bool as TypeBool
 import qualified Types.Data.Num as TypeNum
 import Types.Data.Num.Ops ((:*:), )
 
@@ -35,9 +35,6 @@
 import qualified Number.Complex as Complex
 
 import qualified Algebra.Transcendental as Trans
--- import qualified Algebra.Field as Field
--- import qualified Algebra.Module as Module
--- import qualified Algebra.Ring as Ring
 
 import NumericPrelude.Numeric
 import NumericPrelude.Base
@@ -49,7 +46,7 @@
 -}
 parameterA, parameterB ::
    (Trans.C a, SoV.TranscendentalConstant a, IsFloating a, IsSized a,
-    TypeNum.PositiveT n, TypeNum.IsNatural n ~ TypeBool.True,
+    TypeNum.PositiveT n, TypeNum.NaturalT n,
     TypeNum.PositiveT (n :*: SizeOf a),
     IsSized (Cascade.ParameterStruct n a), SizeOf (Cascade.ParameterStruct n a) ~ paramSize,
     (n :*: LLVM.UnknownSize) ~ paramSize, TypeNum.PositiveT paramSize) =>
@@ -75,12 +72,12 @@
 
 parameter ::
    (Trans.C a, SoV.RationalConstant a, IsFloating a, IsSized a,
-    TypeNum.PositiveT n, TypeNum.IsNatural n ~ TypeBool.True,
+    Value.T (Value a) ~ av,
+    TypeNum.PositiveT n, TypeNum.NaturalT n,
     TypeNum.PositiveT (n :*: SizeOf a),
     IsSized (Cascade.ParameterStruct n a), SizeOf (Cascade.ParameterStruct n a) ~ paramSize,
     (n :*: LLVM.UnknownSize) ~ paramSize, TypeNum.PositiveT paramSize) =>
-   (Int -> Value.T (Value a) -> Value.T (Value a) ->
-    Complex.T (Value.T (Value a)) -> Filt2Core.Parameter (Value.T (Value a))) ->
+   (Passband -> Int -> av -> Complex.T av -> av -> Filt2Core.Parameter av) ->
    n -> Passband -> Value a -> Value a ->
    CodeGenFunction r (Value (Cascade.ParameterStruct n a))
 parameter partialParameter n kind ratio freq = do
@@ -103,11 +100,9 @@
       flip LLVM.store ptri =<<
          Filt2.composeParameter =<<
          Value.flatten
-            (Filt2Core.adjustPassband kind
-               (flip
-                  (partialParameter order
-                      (Value.constantValue ratio))
-                  (ComplexL.unfold c))
+            (partialParameter kind order
+               (Value.constantValue ratio)
+               (ComplexL.unfold c)
                (Value.constantValue freq))
       A.advanceArrayElementPtr si
 
diff --git a/src/Synthesizer/LLVM/Filter/ComplexFirstOrder.hs b/src/Synthesizer/LLVM/Filter/ComplexFirstOrder.hs
--- a/src/Synthesizer/LLVM/Filter/ComplexFirstOrder.hs
+++ b/src/Synthesizer/LLVM/Filter/ComplexFirstOrder.hs
@@ -89,8 +89,8 @@
 
 instance (Value.Flatten a) => Value.Flatten (Parameter a) where
    type Registers (Parameter a) = Parameter (Value.Registers a)
-   flatten = Value.flattenTraversable
-   unfold =  Value.unfoldFunctor
+   flattenCode = Value.flattenCodeTraversable
+   unfoldCode = Value.unfoldCodeTraversable
 
 
 parameter, _parameter ::
@@ -152,13 +152,14 @@
    return (A.zero Complex.+: A.zero)
 
 causal ::
-   (A.PseudoRing a, A.IntegerConstant a, Memory.C a) =>
-   Causal.T
+   (Causal.C process, A.PseudoRing a, A.IntegerConstant a, Memory.C a) =>
+   process
       (Parameter a, Stereo.T a)
       (Stereo.T a)
 causal =
    Causal.mapAccum next start
 
+{-# DEPRECATED causalP "use causal instead" #-}
 causalP ::
    (A.PseudoRing a, A.IntegerConstant a, Memory.C a) =>
    CausalP.T p
diff --git a/src/Synthesizer/LLVM/Filter/ComplexFirstOrderPacked.hs b/src/Synthesizer/LLVM/Filter/ComplexFirstOrderPacked.hs
--- a/src/Synthesizer/LLVM/Filter/ComplexFirstOrderPacked.hs
+++ b/src/Synthesizer/LLVM/Filter/ComplexFirstOrderPacked.hs
@@ -22,8 +22,8 @@
 
 import qualified LLVM.Core as LLVM
 import LLVM.Core
-   (Value, valueOf, value, Struct,
-    IsPrimitive, IsConst, IsFloating, IsSized,
+   (Value, valueOf, Struct,
+    IsPrimitive, IsFloating, IsSized,
     Vector, insertelement,
     CodeGenFunction, )
 import LLVM.Util.Loop (Phi, phis, addPhis, )
@@ -102,8 +102,8 @@
    ki <- A.mul k =<< A.sin w
 
    kin <- A.neg ki
-   kvr <- Vector.assemble [kr,kin,amp, value LLVM.zero]
-   kvi <- Vector.assemble [ki,kr, amp, value LLVM.zero]
+   kvr <- Vector.assemble [kr,kin,amp, A.zero]
+   kvi <- Vector.assemble [ki,kr, amp, A.zero]
    return (Parameter kvr kvi)
 
 
@@ -119,9 +119,9 @@
 This would even require a vector of size 3.
 -}
 next ::
-   (Vector.Arithmetic a, IsConst a) =>
+   (Vector.Arithmetic a) =>
    (Parameter a, Stereo.T (Value a)) ->
-   (Value (State a)) ->
+   Value (State a) ->
    CodeGenFunction r (Stereo.T (Value a), (Value (State a)))
 next (Parameter kr ki, x) s = do
    sr <- insertelement s (Stereo.left  x) (valueOf 2)
@@ -134,39 +134,21 @@
    return (Stereo.cons yr yi, sv)
 
 start ::
-   (IsPrimitive a, IsConst a) =>
+   (Vector.Arithmetic a) =>
    CodeGenFunction r (Value (State a))
-start =
-   return (value LLVM.zero)
+start = return A.zero
 
 causal ::
-   (IsConst a, Vector.Arithmetic a,
-    Memory.C (Value (State a))) =>
-{-
-   (IsConst a, Vector.Arithmetic a,
-    Memory.FirstClass a am,
-    IsPrimitive am,
-    IsSized am s, Add s s s2, Add s2 s s3, Add s3 s s4, Sets.Pos s4,
-    IsSized (State a) vasize,
-    IsSized (State am) vamsize) =>
--}
-   Causal.T
+   (Causal.C process, Vector.Arithmetic a, Memory.C (Value (State a))) =>
+   process
       (Parameter a, Stereo.T (Value a))
       (Stereo.T (Value a))
 causal =
    Causal.mapAccum next start
 
+{-# DEPRECATED causalP "use causal instead" #-}
 causalP ::
-   (IsConst a, Vector.Arithmetic a,
-    Memory.C (Value (State a))) =>
-{-
-   (IsConst a, Vector.Arithmetic a,
-    Memory.FirstClass a am,
-    IsPrimitive am,
-    IsSized am s, Add s s s2, Add s2 s s3, Add s3 s s4, Sets.Pos s4,
-    IsSized (State a) vasize,
-    IsSized (State am) vamsize) =>
--}
+   (Vector.Arithmetic a, Memory.C (Value (State a))) =>
    CausalP.T p
       (Parameter a, Stereo.T (Value a))
       (Stereo.T (Value a))
diff --git a/src/Synthesizer/LLVM/Filter/FirstOrder.hs b/src/Synthesizer/LLVM/Filter/FirstOrder.hs
--- a/src/Synthesizer/LLVM/Filter/FirstOrder.hs
+++ b/src/Synthesizer/LLVM/Filter/FirstOrder.hs
@@ -3,6 +3,10 @@
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 module Synthesizer.LLVM.Filter.FirstOrder (
    Result(Result,lowpass_,highpass_), Parameter, parameter,
+   causal, lowpassCausal, highpassCausal,
+   causalPacked, lowpassCausalPacked, highpassCausalPacked,
+   causalRecursivePacked, -- for Allpass
+
    causalP, lowpassCausalP, highpassCausalP,
    causalPackedP, lowpassCausalPackedP, highpassCausalPackedP,
    causalRecursivePackedP, -- for Allpass
@@ -15,6 +19,7 @@
 import qualified Synthesizer.Plain.Modifier as Modifier
 
 import qualified Synthesizer.LLVM.CausalParameterized.Process as CausalP
+import qualified Synthesizer.LLVM.Causal.Process as Causal
 import qualified Synthesizer.LLVM.Frame.SerialVector as Serial
 import qualified Synthesizer.LLVM.Simple.Value as Value
 
@@ -49,9 +54,14 @@
 
 instance (Value.Flatten a) => Value.Flatten (Parameter a) where
    type Registers (Parameter a) = Parameter (Value.Registers a)
-   flatten = Value.flattenTraversable
-   unfold =  Value.unfoldFunctor
+   flattenCode = Value.flattenCodeTraversable
+   unfoldCode = Value.unfoldCodeTraversable
 
+instance (Value.Flatten a) => Value.Flatten (Result a) where
+   type Registers (Result a) = Result (Value.Registers a)
+   flattenCode = Value.flattenCodeTraversable
+   unfoldCode = Value.unfoldCodeTraversable
+
 {-
 instance LLVM.ValueTuple a => LLVM.ValueTuple (Parameter a) where
    buildTuple f = Class.buildTupleTraversable (LLVM.buildTuple f)
@@ -68,14 +78,19 @@
 parameter ::
    (A.Transcendental a, A.RationalConstant a) =>
    a -> LLVM.CodeGenFunction r (Parameter a)
-parameter reson =
-   Value.flatten $
-   FirstOrder.parameter
-      (Value.constantValue reson)
+parameter = Value.unlift1 FirstOrder.parameter
 
 
+modifier ::
+   (a ~ A.Scalar v, A.PseudoModule v, A.IntegerConstant a) =>
+   Modifier.Simple
+      (Value.T v)
+      (Parameter (Value.T a))
+      (Value.T v) (Result (Value.T v))
+modifier  = FirstOrder.modifier
+
 lowpassModifier, highpassModifier ::
-   (A.PseudoModule a v, A.IntegerConstant a) =>
+   (a ~ A.Scalar v, A.PseudoModule v, A.IntegerConstant a) =>
    Modifier.Simple
 --      (FirstOrder.State (Value.T v))
       (Value.T v)
@@ -84,37 +99,31 @@
 lowpassModifier  = FirstOrder.lowpassModifier
 highpassModifier = FirstOrder.highpassModifier
 
-causalP ::
-   (A.IntegerConstant a, A.PseudoModule a v, Memory.C v) =>
-   CausalP.T p (Parameter a, v) (Result v)
-{-
-in contrast to CausalP.fromModifier this allows for sharing
-between lowpass and highpass channel
--}
-causalP =
-   CausalP.mapSimple (\(l,x) -> do
-      h <- A.sub x l
-      return (Result{FirstOrder.lowpass_ = l,
-                     FirstOrder.highpass_ = h}))
-    <<< (lowpassCausalP &&& arr snd)
+causal ::
+   (Causal.C process,
+    A.IntegerConstant a, a ~ A.Scalar v, A.PseudoModule v, Memory.C v) =>
+   process (Parameter a, v) (Result v)
+causal = Causal.fromModifier modifier
 
-lowpassCausalP, highpassCausalP ::
-   (A.IntegerConstant a, A.PseudoModule a v, Memory.C v) =>
-   CausalP.T p (Parameter a, v) v
-lowpassCausalP  = CausalP.fromModifier lowpassModifier
-highpassCausalP = CausalP.fromModifier highpassModifier
+lowpassCausal, highpassCausal ::
+   (Causal.C process,
+    A.IntegerConstant a, a ~ A.Scalar v, A.PseudoModule v, Memory.C v) =>
+   process (Parameter a, v) v
+lowpassCausal  = CausalP.fromModifier lowpassModifier
+highpassCausal = CausalP.fromModifier highpassModifier
 
-lowpassCausalPackedP, highpassCausalPackedP, causalRecursivePackedP ::
-   (Serial.C v, Serial.Element v ~ a,
+lowpassCausalPacked, highpassCausalPacked, causalRecursivePacked ::
+   (Causal.C process,
+    Serial.C v, Serial.Element v ~ a,
     Memory.C a, A.IntegerConstant a,
     A.PseudoRing v, A.PseudoRing a) =>
-   CausalP.T p (Parameter a, v) v
-highpassCausalPackedP =
-   arr snd - lowpassCausalPackedP
-lowpassCausalPackedP =
-   causalRecursivePackedP <<<
+   process (Parameter a, v) v
+highpassCausalPacked =
+   Causal.zipWith A.sub <<< arr snd &&& lowpassCausalPacked
+lowpassCausalPacked =
+   causalRecursivePacked <<<
    (arr fst &&&
-    CausalP.mapSimple
+    Causal.map
        (\(FirstOrder.Parameter k, x) ->
           A.mul x =<< Serial.upsample =<< A.sub (A.fromInteger' 1) k))
 
@@ -132,11 +141,11 @@
 f1x = f0x + k * f0x->1
 f2x = f1x + k^2 * f1x->2
 -}
-causalRecursivePackedP =
-   CausalP.mapAccumSimple
+causalRecursivePacked =
+   Causal.mapAccum
       (\(FirstOrder.Parameter k, xk0) y1 -> do
          y1k <- A.mul k y1
-         xk1 <- Serial.modify (LLVM.valueOf 0) (A.add y1k) xk0
+         xk1 <- Serial.modify A.zero (A.add y1k) xk0
          let size = Serial.size xk0
          kv <- Serial.upsample k
          xk2 <-
@@ -208,14 +217,63 @@
 
 
 
-causalPackedP ::
-   (Serial.C v, Serial.Element v ~ a,
+causalPacked ::
+   (Causal.C process,
+    Serial.C v, Serial.Element v ~ a,
     Memory.C a, A.IntegerConstant a,
     A.PseudoRing v, A.PseudoRing a) =>
+   process (Parameter a, v) (Result v)
+causalPacked =
+   Causal.map (\(l,x) -> do
+      h <- A.sub x l
+      return (Result{FirstOrder.lowpass_ = l,
+                     FirstOrder.highpass_ = h}))
+    <<< (lowpassCausalPacked &&& arr snd)
+
+
+
+causalP ::
+   (A.IntegerConstant a, a ~ A.Scalar v, A.PseudoModule v, Memory.C v) =>
    CausalP.T p (Parameter a, v) (Result v)
-causalPackedP =
-   CausalP.mapSimple (\(l,x) -> do
+{-
+Before we added sharing to Simple.Value,
+only this implementation allowed sharing
+and using CausalP.fromModifier did not.
+-}
+causalP =
+   Causal.map (\(l,x) -> do
       h <- A.sub x l
       return (Result{FirstOrder.lowpass_ = l,
                      FirstOrder.highpass_ = h}))
-    <<< (lowpassCausalPackedP &&& arr snd)
+    <<< (lowpassCausalP &&& arr snd)
+
+lowpassCausalP, highpassCausalP ::
+   (A.IntegerConstant a, a ~ A.Scalar v, A.PseudoModule v, Memory.C v) =>
+   CausalP.T p (Parameter a, v) v
+lowpassCausalP  = lowpassCausal
+highpassCausalP = highpassCausal
+
+lowpassCausalPackedP, highpassCausalPackedP, causalRecursivePackedP ::
+   (Serial.C v, Serial.Element v ~ a,
+    Memory.C a, A.IntegerConstant a,
+    A.PseudoRing v, A.PseudoRing a) =>
+   CausalP.T p (Parameter a, v) v
+highpassCausalPackedP = highpassCausalPacked
+lowpassCausalPackedP = lowpassCausalPacked
+causalRecursivePackedP = causalRecursivePacked
+
+causalPackedP ::
+   (Serial.C v, Serial.Element v ~ a,
+    Memory.C a, A.IntegerConstant a,
+    A.PseudoRing v, A.PseudoRing a) =>
+   CausalP.T p (Parameter a, v) (Result v)
+causalPackedP = causalPacked
+
+
+{-# DEPRECATED causalP                "use 'causal' instead" #-}
+{-# DEPRECATED lowpassCausalP         "use 'lowpassCausal' instead" #-}
+{-# DEPRECATED highpassCausalP        "use 'highpassCausal' instead" #-}
+{-# DEPRECATED causalPackedP          "use 'causalPacked' instead" #-}
+{-# DEPRECATED lowpassCausalPackedP   "use 'lowpassCausalPacked' instead" #-}
+{-# DEPRECATED highpassCausalPackedP  "use 'highpassCausalPacked' instead" #-}
+{-# DEPRECATED causalRecursivePackedP "use 'causalRecursivePacked' instead" #-}
diff --git a/src/Synthesizer/LLVM/Filter/Moog.hs b/src/Synthesizer/LLVM/Filter/Moog.hs
--- a/src/Synthesizer/LLVM/Filter/Moog.hs
+++ b/src/Synthesizer/LLVM/Filter/Moog.hs
@@ -1,11 +1,11 @@
 {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE DeriveTraversable #-}
 module Synthesizer.LLVM.Filter.Moog
    (Parameter, parameter,
-    causalP,
-    causalInitP,
+    causal, causalInit,
+    causalP, causalInitP,
    ) where
 
 import qualified Synthesizer.LLVM.Filter.FirstOrder as Filt1
@@ -15,20 +15,20 @@
 import Synthesizer.Plain.Filter.Recursive (Pole(..))
 
 import qualified Synthesizer.LLVM.CausalParameterized.Process as CausalP
+import qualified Synthesizer.LLVM.Causal.Process as Causal
 import qualified Synthesizer.LLVM.Simple.Value as Value
 import qualified Synthesizer.LLVM.Parameter as Param
 
 import Foreign.Storable (Storable, )
 
-import qualified LLVM.Extra.ScalarOrVector as SoV
 import qualified LLVM.Extra.Vector as Vector
 import qualified LLVM.Extra.Memory as Memory
 import qualified LLVM.Extra.Arithmetic as A
 import qualified LLVM.Extra.Class as Class
-import LLVM.Extra.Class (MakeValueTuple, ValueTuple, Undefined, undefTuple, )
+import LLVM.Extra.Class (Undefined, undefTuple, )
 
 import qualified LLVM.Core as LLVM
-import LLVM.Core (Value, IsConst, IsSized, CodeGenFunction, )
+import LLVM.Core (CodeGenFunction, )
 import LLVM.Util.Loop (Phi, phis, addPhis, )
 
 import qualified Types.Data.Num as TypeNum
@@ -38,11 +38,9 @@
 import qualified Control.Applicative as App
 import qualified Data.Foldable as Fold
 import qualified Data.Traversable as Trav
-import Control.Arrow ((>>>), (&&&), )
+import Control.Arrow (arr, (>>>), (&&&), )
 import Control.Applicative (liftA2, )
 
-import qualified Algebra.Additive as Additive
-
 import NumericPrelude.Numeric
 import NumericPrelude.Base
 
@@ -87,8 +85,8 @@
 
 instance (Value.Flatten a, TypeNum.NaturalT n) => Value.Flatten (Parameter n a) where
    type Registers (Parameter n a) = Parameter n (Value.Registers a)
-   flatten = Value.flattenTraversable
-   unfold =  Value.unfoldFunctor
+   flattenCode = Value.flattenCodeTraversable
+   unfoldCode = Value.unfoldCodeTraversable
 
 
 instance (Vector.Simple v, TypeNum.NaturalT n) => Vector.Simple (Parameter n v) where
@@ -105,29 +103,13 @@
    (A.Transcendental a, A.RationalConstant a, TypeNum.NaturalT n) =>
    n -> a -> a ->
    CodeGenFunction r (Parameter n a)
-parameter order reson freq =
-   Value.flatten $
-   Parameter $ Moog.parameter (TypeNum.fromIntegerT order)
-      (Pole (Value.constantValue reson) (Value.constantValue freq))
+parameter order =
+   Value.unlift2 $ \reson freq ->
+   Parameter $ Moog.parameter (TypeNum.fromIntegerT order) (Pole reson freq)
 
-{-
-infixr 1 ^>>, >>^
 
-(>>^) ::
-   (Value.Flatten b bl, Value.Flatten c cl) =>
-   CausalP.T p al bl -> (b -> c) -> CausalP.T p al cl
-(>>^) a f =
-   a >>> CausalP.mapSimple (Value.flatten . f . Value.unfold)
-
-(^>>) ::
-   (Value.Flatten a al, Value.Flatten b bl) =>
-   (a -> b) -> CausalP.T p bl cl -> CausalP.T p al cl
-(^>>) f b =
-   CausalP.mapSimple (Value.flatten . f . Value.unfold) >>> b
--}
-
 merge ::
-   (A.PseudoModule a v, A.IntegerConstant a) =>
+   (a ~ A.Scalar v, A.PseudoModule v, A.IntegerConstant a) =>
    (Parameter n a, v) -> v ->
    CodeGenFunction r (FirstOrder.Parameter a, v)
 merge (Parameter (Moog.Parameter f k), x) y0 =
@@ -136,57 +118,64 @@
    in  Value.flatten (fmap c k, c x - c f *> c y0)
 
 amplify ::
-   (A.PseudoModule a v, A.IntegerConstant a) =>
+   (a ~ A.Scalar v, A.PseudoModule v, A.IntegerConstant a) =>
    Parameter n a ->
    v ->
    CodeGenFunction r v
-amplify (Parameter (Moog.Parameter f _k)) y1 =
-   Value.decons $
-   (1 + Value.constantValue f) *> Value.constantValue y1
+amplify =
+   Value.unlift2 $ \p y1 ->
+      case fmap (Moog.feedback . getParam) p of
+         f -> (1 + f) *> y1
 
+causal ::
+   (Causal.C process,
+    Memory.C v, A.PseudoModule v, A.Scalar v ~ a, A.IntegerConstant a,
+    TypeNum.NaturalT n) =>
+   process (Parameter n a, v) v
+causal =
+   causalSize
+      (flip Causal.feedbackControlledZero (arr snd))
+      undefined
+
 causalP ::
-   (SoV.PseudoModule a v, SoV.IntegerConstant a,
-    IsConst v, Additive.C v,
-    Storable v,
-    MakeValueTuple v, ValueTuple v ~ (Value v),
-    MakeValueTuple a, ValueTuple a ~ (Value a),
-    Memory.FirstClass a, Memory.Stored a ~ am, IsSized a, IsSized am,
-    Memory.FirstClass v, Memory.Stored v ~ vm, IsSized v, IsSized vm,
+   (Memory.C v, A.PseudoModule v, A.Scalar v ~ a, A.IntegerConstant a,
     TypeNum.NaturalT n) =>
-   CausalP.T p (Parameter n (Value a), Value v) (Value v)
-causalP =
-   let withZero ::
-          (Additive.C v) =>
-          (Param.T p v ->
-           CausalP.T p (Parameter n (Value a), Value v) (Value v)) ->
-          CausalP.T p (Parameter n (Value a), Value v) (Value v)
-       withZero proc = proc zero
-   in  withZero causalInitP
+   CausalP.T p (Parameter n a, v) v
+causalP = causal
 
 
-causalInitP ::
-   (A.PseudoModule a v, A.IntegerConstant a,
-    Storable vh, Class.MakeValueTuple vh, v ~ Class.ValueTuple vh,
-    Memory.C v,
+causalInit, causalInitP ::
+   (Storable vh, Class.MakeValueTuple vh,
+    Class.ValueTuple vh ~ v, Memory.C v,
+    A.PseudoModule v, A.Scalar v ~ a, A.IntegerConstant a,
     TypeNum.NaturalT n) =>
    Param.T p vh -> CausalP.T p (Parameter n a, v) v
-causalInitP =
-   causalInitPSize undefined
+causalInit = causalInitP
+causalInitP initial =
+   let selectOutput :: Param.T p vh -> (b, Class.ValueTuple vh) -> Class.ValueTuple vh
+       selectOutput _ = snd
+   in  causalSize
+          (flip
+             (CausalP.feedbackControlled initial)
+             (arr $ selectOutput initial))
+          undefined
 
-causalInitPSize ::
-   (A.PseudoModule a v, A.IntegerConstant a,
-    Storable vh, Class.MakeValueTuple vh, v ~ Class.ValueTuple vh,
-    Memory.C v,
+
+causalSize ::
+   (Causal.C process,
+    Memory.C v, A.PseudoModule v, A.Scalar v ~ a, A.IntegerConstant a,
     TypeNum.NaturalT n) =>
-   n -> Param.T p vh -> CausalP.T p (Parameter n a, v) v
-causalInitPSize n initial =
+   (process ((Parameter n a, v), v) v ->
+    process (Parameter n a, v) v) ->
+   n ->
+   process (Parameter n a, v) v
+causalSize feedback n =
    let order = TypeNum.fromIntegerT n
-       selectOutput :: Param.T p vh -> (b, Class.ValueTuple vh) -> Class.ValueTuple vh
-       selectOutput _ = snd
    in  Arrow.arr fst &&&
-       CausalP.feedbackControlled
-          initial
-          (CausalP.zipWithSimple merge >>>
-           CausalP.replicateControlled order Filt1.lowpassCausalP)
-          (Arrow.arr (selectOutput initial))
-        >>> CausalP.zipWithSimple amplify
+       feedback
+          (Causal.zipWith merge >>>
+           Causal.replicateControlled order Filt1.lowpassCausal)
+        >>> Causal.zipWith amplify
+
+{-# DEPRECATED causalP     "use 'causal' instead" #-}
+{-# DEPRECATED causalInitP "use 'causalInit' instead" #-}
diff --git a/src/Synthesizer/LLVM/Filter/NonRecursive.hs b/src/Synthesizer/LLVM/Filter/NonRecursive.hs
new file mode 100644
--- /dev/null
+++ b/src/Synthesizer/LLVM/Filter/NonRecursive.hs
@@ -0,0 +1,180 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE FlexibleContexts #-}
+module Synthesizer.LLVM.Filter.NonRecursive (
+   convolve,
+   convolvePacked,
+   ) where
+
+import qualified Synthesizer.LLVM.CausalParameterized.ProcessPrivate as CausalP
+import qualified Synthesizer.LLVM.Parameter as Param
+
+import qualified Synthesizer.LLVM.RingBuffer as RingBuffer
+import qualified Synthesizer.LLVM.Frame.SerialVector as Serial
+
+import qualified Synthesizer.LLVM.Storable.Vector as SVU
+import qualified Data.StorableVector as SV
+
+import qualified LLVM.Extra.Memory as Memory
+import qualified LLVM.Extra.Control as C
+import qualified LLVM.Extra.Arithmetic as A
+import qualified LLVM.Extra.Class as Class
+import LLVM.Extra.Class (undefTuple, )
+
+import qualified LLVM.Core as LLVM
+import LLVM.Core (Value, valueOf, CodeGenFunction, IsSized, SizeOf, )
+
+import qualified Types.Data.Num as TypeNum
+import Types.Data.Num.Ops ((:*:), )
+
+import Foreign.ForeignPtr (touchForeignPtr, )
+import Foreign.Storable (Storable, )
+import Foreign.Ptr (Ptr, )
+import Data.Word (Word32, )
+
+import Control.Arrow ((<<<), (&&&), )
+import Control.Monad (liftM2, )
+
+import qualified Algebra.IntegralDomain as Integral
+
+import NumericPrelude.Numeric
+import NumericPrelude.Base
+
+
+
+{-
+This is a brute-force implementation.
+No Karatsuba, No Toom-Cook, No Fourier.
+-}
+convolve ::
+   (Storable a,
+    Class.MakeValueTuple a, Class.ValueTuple a ~ al,
+    Memory.C al, A.PseudoRing al) =>
+   Param.T p (SV.Vector a) -> CausalP.T p al al
+convolve mask =
+   let len = fmap SV.length mask
+   in  CausalP.zipWith scalarProduct (fmap (fromIntegral :: Int -> Word32) len)
+       <<<
+       RingBuffer.trackConst A.zero len &&& provideMask mask
+
+convolvePacked ::
+   (LLVM.IsPrimitive a, Memory.FirstClass a, Memory.Stored a ~ am,
+    LLVM.IsPrimitive am, IsSized am, SizeOf am ~ amsize,
+    TypeNum.PositiveT n, TypeNum.PositiveT (n :*: amsize),
+    Class.MakeValueTuple a, Class.ValueTuple a ~ al, Memory.Struct al ~ am,
+    Storable a, Memory.C al,
+    LLVM.IsArithmetic a) =>
+   Param.T p (SV.Vector a) ->
+   CausalP.T p (Serial.Value n a) (Serial.Value n a)
+convolvePacked mask =
+   Serial.withSize $ \vectorSize ->
+      let len = fmap SV.length mask
+      in  CausalP.zipWith scalarProductPacked
+             (fmap (fromIntegral :: Int -> Word32) len)
+          <<<
+          RingBuffer.trackConst A.zero
+             (fmap (flip Integral.divUp vectorSize) len)
+          &&&
+          provideMask mask
+
+provideMask ::
+   (Storable a,
+    Class.MakeValueTuple a, Class.ValueTuple a ~ al,
+    Memory.C al, Memory.Struct al ~ am) =>
+   Param.T p (SV.Vector a) -> CausalP.T p x (Value (Ptr am))
+provideMask mask =
+   CausalP.Cons
+      (\p _x () -> return (p,()))
+      return
+      (const $ const $ return ())
+      (\p ->
+         let (fp,ptr,_l) = SVU.unsafeToPointers $ Param.get mask p
+         in  return (fp, (ptr, ())))
+      -- keep the foreign ptr alive
+      touchForeignPtr
+
+
+scalarProduct ::
+   (Memory.C a, Memory.Struct a ~ am,
+    A.PseudoRing a) =>
+   Value Word32 ->
+   RingBuffer.T a -> Value (Ptr am) ->
+   CodeGenFunction r a
+scalarProduct n rb mask =
+   fmap snd $
+   C.arrayLoop n mask (A.zero, A.zero) $ \ptr (k, s) -> do
+      a <- RingBuffer.index k rb
+      b <- Memory.load ptr
+      liftM2 (,) (A.inc k) (A.add s =<< A.mul a b)
+
+_scalarProduct ::
+   (Memory.FirstClass a, Memory.Stored a ~ am, IsSized am,
+    LLVM.IsArithmetic a) =>
+   Value Word32 ->
+   RingBuffer.T (Value a) -> Value (Ptr am) ->
+   CodeGenFunction r (Value a)
+_scalarProduct = scalarProduct
+
+
+scalarProductPacked ::
+   (LLVM.IsPrimitive a, Memory.FirstClass a, Memory.Stored a ~ am,
+    LLVM.IsPrimitive am, IsSized am, SizeOf am ~ amsize,
+    TypeNum.PositiveT n, TypeNum.PositiveT (n :*: amsize),
+    LLVM.IsArithmetic a) =>
+   Value Word32 ->
+   RingBuffer.T (Serial.Value n a) -> Value (Ptr am) ->
+   CodeGenFunction r (Serial.Value n a)
+scalarProductPacked n0 rb mask0 = do
+   (ax, rx) <- readSerialStart rb
+   bx <- Memory.load mask0
+   sx <- A.scale bx ax
+   n1 <- A.dec n0
+   mask1 <- A.advanceArrayElementPtr mask0
+   fmap snd $ C.arrayLoop n1 mask1 (rx, sx) $
+         \ptr (r1, s1) -> do
+      (a,r2) <- readSerialNext rb r1
+      b <- Memory.load ptr
+      fmap ((,) r2) (A.add s1 =<< A.scale b a)
+
+
+type
+   Iterator n a =
+      ((Serial.Value n a,
+        {-
+        I would like to use Serial.Iterator,
+        but we need to read in reversed order,
+        that is, from high to low indices.
+        -}
+        Serial.Value n a,
+        Value Word32),
+       Value Word32)
+
+readSerialStart ::
+   (LLVM.IsPrimitive a, Memory.FirstClass a, Memory.Stored a ~ am,
+    LLVM.IsPrimitive am, IsSized am, SizeOf am ~ amsize,
+    TypeNum.PositiveT n, TypeNum.PositiveT (n :*: amsize)) =>
+   RingBuffer.T (Serial.Value n a) ->
+   CodeGenFunction r (Serial.Value n a, Iterator n a)
+readSerialStart rb = do
+   a <- RingBuffer.index A.zero rb
+   return (a, ((a, undefTuple, A.zero), A.zero))
+
+readSerialNext ::
+   (LLVM.IsPrimitive a, Memory.FirstClass a, Memory.Stored a ~ am,
+    LLVM.IsPrimitive am, IsSized am, SizeOf am ~ amsize,
+    TypeNum.PositiveT n, TypeNum.PositiveT (n :*: amsize)) =>
+   RingBuffer.T (Serial.Value n a) ->
+   Iterator n a ->
+   CodeGenFunction r (Serial.Value n a, Iterator n a)
+readSerialNext rb ((a0,r0,j0), k0) = do
+   vectorEnd <- A.cmp LLVM.CmpEQ j0 A.zero
+   ((r1,j1), k1) <-
+      C.ifThen vectorEnd ((r0,j0), k0) $ do
+         k <- A.inc k0
+         r <- RingBuffer.index k rb
+         return ((r, valueOf (fromIntegral $ Serial.size r :: Word32)), k)
+   j2 <- A.dec j1
+   (ai,r2) <- Serial.shiftUp undefTuple r1
+   (_, a1) <- Serial.shiftUp ai a0
+   return (a1, ((a1,r2,j2), k1))
diff --git a/src/Synthesizer/LLVM/Filter/SecondOrder.hs b/src/Synthesizer/LLVM/Filter/SecondOrder.hs
--- a/src/Synthesizer/LLVM/Filter/SecondOrder.hs
+++ b/src/Synthesizer/LLVM/Filter/SecondOrder.hs
@@ -8,6 +8,7 @@
    Filt2.c0, Filt2.c1, Filt2.c2, Filt2.d1, Filt2.d2,
    bandpassParameter,
    ParameterStruct, composeParameter, decomposeParameter, -- for cascade
+   causal, causalPacked,
    causalP, causalPackedP,
    ) where
 
@@ -17,6 +18,7 @@
 import qualified Synthesizer.Plain.Modifier as Modifier
 
 import qualified Synthesizer.LLVM.CausalParameterized.Process as CausalP
+import qualified Synthesizer.LLVM.Causal.Process as Causal
 import qualified Synthesizer.LLVM.Frame.SerialVector as Serial
 import qualified Synthesizer.LLVM.Simple.Value as Value
 
@@ -108,8 +110,8 @@
 
 instance (Value.Flatten a) => Value.Flatten (Parameter a) where
    type Registers (Parameter a) = Parameter (Value.Registers a)
-   flatten = Value.flattenTraversable
-   unfold =  Value.unfoldFunctor
+   flattenCode = Value.flattenCodeTraversable
+   unfoldCode = Value.unfoldCodeTraversable
 
 
 
@@ -143,8 +145,8 @@
 
 instance (Value.Flatten a) => Value.Flatten (Filt2.State a) where
    type Registers (Filt2.State a) = Filt2.State (Value.Registers a)
-   flatten = Value.flattenTraversable
-   unfold =  Value.unfoldFunctor
+   flattenCode = Value.flattenCodeTraversable
+   unfoldCode = Value.unfoldCodeTraversable
 
 
 {-# DEPRECATED bandpassParameter "only for testing, use Universal or Moog filter for production code" #-}
@@ -166,7 +168,7 @@
          kcos k2
 
 modifier ::
-   (A.PseudoModule a v, A.IntegerConstant a) =>
+   (a ~ A.Scalar v, A.PseudoModule v, A.IntegerConstant a) =>
    Modifier.Simple
       (Filt2.State (Value.T v))
       (Parameter (Value.T a))
@@ -174,34 +176,52 @@
 modifier =
    Filt2.modifier
 
+causal ::
+   (Causal.C process,
+    a ~ A.Scalar v, A.PseudoModule v, A.IntegerConstant a, Memory.C v) =>
+   process (Parameter a, v) v
+causal =
+   Causal.fromModifier modifier
+
+{-# DEPRECATED causalP "use causal instead" #-}
 causalP ::
-   (A.PseudoModule a v, A.IntegerConstant a, Memory.C v) =>
+   (a ~ A.Scalar v, A.PseudoModule v, A.IntegerConstant a, Memory.C v) =>
    CausalP.T p (Parameter a, v) v
 causalP =
    CausalP.fromModifier modifier
 
 
+{-# DEPRECATED causalPackedP "use causalPacked instead" #-}
+causalPackedP ::
+   (Serial.C v, Serial.Element v ~ a,
+    Memory.C v, Memory.C a, A.IntegerConstant v, A.IntegerConstant a,
+    A.PseudoRing v, A.PseudoRing a) =>
+   CausalP.T p (Parameter a, v) v
+causalPackedP = causalPacked
+
 {- |
 Vector size must be at least D2.
 -}
-causalPackedP,
-  causalRecursivePackedP ::
-   (Serial.C v, Serial.Element v ~ a,
+causalPacked,
+  causalRecursivePacked ::
+   (Causal.C process,
+    Serial.C v, Serial.Element v ~ a,
     Memory.C v, Memory.C a, A.IntegerConstant v, A.IntegerConstant a,
     A.PseudoRing v, A.PseudoRing a) =>
-   CausalP.T p (Parameter a, v) v
-causalPackedP =
-   causalRecursivePackedP <<<
-   (arr fst &&& causalNonRecursivePackedP)
+   process (Parameter a, v) v
+causalPacked =
+   causalRecursivePacked <<<
+   (arr fst &&& causalNonRecursivePacked)
 
-_causalRecursivePackedPAlt,
-  causalNonRecursivePackedP ::
-   (Serial.C v, Serial.Element v ~ a,
+_causalRecursivePackedAlt,
+  causalNonRecursivePacked ::
+   (Causal.C process,
+    Serial.C v, Serial.Element v ~ a,
     Memory.C a, A.IntegerConstant v, A.IntegerConstant a,
     A.PseudoRing v, A.PseudoRing a) =>
-   CausalP.T p (Parameter a, v) v
-causalNonRecursivePackedP =
-   CausalP.mapAccumSimple
+   process (Parameter a, v) v
+causalNonRecursivePacked =
+   Causal.mapAccum
       (\(p, v0) (x1,x2) -> do
          (u1n,v1) <- Serial.shiftUp x1 v0
          (u2n,v2) <- Serial.shiftUp x2 v1
@@ -243,8 +263,8 @@
 f1x = f0x + a * f0x->1 + b * f0x->2
 f2x = f1x + (a^2-2*b) * f1x->2 + b^2 * f1x->4
 -}
-causalRecursivePackedP =
-   CausalP.mapAccumSimple
+causalRecursivePacked =
+   Causal.mapAccum
       (\(p, x0) y1v -> do
          let size = Serial.size x0
 
@@ -287,8 +307,8 @@
          return (xk2, xk2))
       (return A.zero)
 
-_causalRecursivePackedPAlt =
-   CausalP.mapAccumSimple
+_causalRecursivePackedAlt =
+   Causal.mapAccum
       (\(p, x0) (x1,x2) -> do
          let size = Serial.size x0
          -- let xk1 = x0
diff --git a/src/Synthesizer/LLVM/Filter/SecondOrderCascade.hs b/src/Synthesizer/LLVM/Filter/SecondOrderCascade.hs
--- a/src/Synthesizer/LLVM/Filter/SecondOrderCascade.hs
+++ b/src/Synthesizer/LLVM/Filter/SecondOrderCascade.hs
@@ -3,12 +3,21 @@
 {-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE UndecidableInstances #-}
-module Synthesizer.LLVM.Filter.SecondOrderCascade where
+module Synthesizer.LLVM.Filter.SecondOrderCascade (
+   causal,  causalPacked,
+   causalP, causalPackedP,
+   ParameterValue(..),
+   ParameterStruct,
+   fixSize,
+   ) where
 
 import qualified Synthesizer.LLVM.Filter.SecondOrder as Filt2
 import qualified Synthesizer.Plain.Filter.Recursive.SecondOrder as Filt2Core
 
+import qualified Synthesizer.LLVM.CausalParameterized.Functional as Func
 import qualified Synthesizer.LLVM.CausalParameterized.Process as CausalP
+import qualified Synthesizer.LLVM.Causal.Process as Causal
+import Synthesizer.LLVM.CausalParameterized.Functional (($&), (&|&), )
 
 import qualified Synthesizer.LLVM.Frame.SerialVector as Serial
 
@@ -20,19 +29,17 @@
 
 import qualified LLVM.Core as LLVM
 import LLVM.Util.Loop (Phi, phis, addPhis, )
-import LLVM.Core
-   (Value, valueOf,
-    IsArithmetic, IsSized,
-    CodeGenFunction, )
+import LLVM.Core (Value, IsArithmetic, IsSized, CodeGenFunction, )
 
-import qualified Types.Data.Bool as TypeBool
 import qualified Types.Data.Num as TypeNum
 import Types.Data.Num.Ops ((:*:), )
 
 import Data.Word (Word32, )
+import Data.Tuple.HT (mapSnd, )
 
 import qualified Control.Arrow as Arrow
-import Control.Arrow ((>>>), (<<<), (&&&), arr, )
+import Control.Arrow ((>>>), (<<<), (^<<), (<<^), (&&&), arr, )
+import Control.Applicative (liftA2, )
 
 -- import qualified Algebra.Transcendental as Trans
 -- import qualified Algebra.Field as Field
@@ -73,7 +80,7 @@
       Class.Zero (ParameterValue n a) where
    zeroTuple = ParameterValue Class.zeroTuple
 
-instance (TypeNum.IntegerT n, TypeNum.IsNatural n ~ TypeBool.True,
+instance (TypeNum.IntegerT n, TypeNum.NaturalT n,
           Memory.FirstClass a, Memory.Stored a ~ am, IsSized a, IsSized am,
           TypeNum.PositiveT (n :*: LLVM.UnknownSize)) =>
       Memory.C (ParameterValue n a) where
@@ -83,38 +90,33 @@
    decompose = Memory.decomposeNewtype ParameterValue
    compose = Memory.composeNewtype (\(ParameterValue k) -> k)
 
+type instance Func.Arguments f (ParameterValue n a) = f (ParameterValue n a)
+instance Func.MakeArguments (ParameterValue n a) where
+   makeArgs = id
 
 
 withSize ::
-   (n -> CausalP.T p (ParameterValue n a, x) y) ->
-   CausalP.T p (ParameterValue n a, x) y
+   (n -> process (ParameterValue n a, x) y) ->
+   process (ParameterValue n a, x) y
 withSize f = f undefined
 
 fixSize ::
    n ->
-   CausalP.T p (ParameterValue n a, x) y ->
-   CausalP.T p (ParameterValue n a, x) y
+   process (ParameterValue n a, x) y ->
+   process (ParameterValue n a, x) y
 fixSize _n = id
 
 causalP ::
-   (A.PseudoModule (LLVM.Value a) v,
+   (LLVM.Value a ~ A.Scalar v, A.PseudoModule v,
     Memory.FirstClass a, Memory.Stored a ~ am, IsSized a, IsSized am,
     Memory.C v,
     IsArithmetic a, SoV.IntegerConstant a, TypeNum.NaturalT n,
     TypeNum.PositiveT (n :*: LLVM.UnknownSize)) =>
    CausalP.T p (ParameterValue n a, v) v
-causalP =
-   withSize $ \n ->
-   foldl (\x y -> (arr fst &&& x) >>> y) (arr snd) $
-   map
-      (\k ->
-         Filt2.causalP <<<
-         Arrow.first (CausalP.mapSimple
-            (\ps -> getStageParameter ps k)))
-      (take (TypeNum.fromIntegerT n) [0..])
+causalP = causal
 
 causalPackedP ::
-   (A.PseudoModule (LLVM.Value a) v,
+   (LLVM.Value a ~ A.Scalar v, A.PseudoModule v,
     Serial.C v, Serial.Element v ~ LLVM.Value a,
     SoV.IntegerConstant a,
     A.PseudoRing v, A.IntegerConstant v, Memory.C v,
@@ -124,18 +126,96 @@
     TypeNum.PositiveT (n :*: LLVM.UnknownSize),
     TypeNum.NaturalT n) =>
    CausalP.T p (ParameterValue n a, v) v
-causalPackedP =
+causalPackedP = causalPacked
+
+
+causal ::
+   (Causal.C process,
+    LLVM.Value a ~ A.Scalar v, A.PseudoModule v,
+    Memory.FirstClass a, Memory.Stored a ~ am, IsSized a, IsSized am,
+    Memory.C v,
+    IsArithmetic a, SoV.IntegerConstant a, TypeNum.NaturalT n,
+    TypeNum.PositiveT (n :*: LLVM.UnknownSize)) =>
+   process (ParameterValue n a, v) v
+causal = causalGen Filt2.causal
+
+causalPacked ::
+   (Causal.C process,
+    LLVM.Value a ~ A.Scalar v, A.PseudoModule v,
+    Serial.C v, Serial.Element v ~ LLVM.Value a,
+    SoV.IntegerConstant a,
+    A.PseudoRing v, A.IntegerConstant v, Memory.C v,
+    Memory.FirstClass a, Memory.Stored a ~ am, IsSized a, IsSized am,
+    LLVM.IsPrimitive a,
+    LLVM.IsPrimitive am,
+    TypeNum.PositiveT (n :*: LLVM.UnknownSize),
+    TypeNum.NaturalT n) =>
+   process (ParameterValue n a, v) v
+causalPacked = causalGen Filt2.causalPacked
+
+causalGen ::
+   (Causal.C process, IsSized a, Phi v, Undefined v,
+    TypeNum.NaturalT n, TypeNum.PositiveT (n :*: LLVM.UnknownSize)) =>
+   process (Filt2Core.Parameter (Value a), v) v ->
+   process (ParameterValue n a, v) v
+causalGen stage =
    withSize $ \n ->
+      snd
+      ^<<
+      Causal.replicateControlled
+         (TypeNum.fromIntegerT n)
+         (paramStage stage)
+      <<^
+      (\(p,v) -> (p, (A.zero, v)))
+
+paramStage ::
+   (Causal.C process, IsSized a,
+    TypeNum.NaturalT n, TypeNum.PositiveT (n :*: LLVM.UnknownSize)) =>
+   process (Filt2Core.Parameter (Value a), v) v ->
+   process (ParameterValue n a, (Value Word32, v)) (Value Word32, v)
+paramStage stage =
+   let p = arr fst
+       i = arr (fst.snd)
+       v = arr (snd.snd)
+   in  (Causal.map A.inc <<< i)
+       &&&
+       (stage <<<
+           (Causal.zipWith getStageParameterAlloca <<< p &&& i)
+           &&&
+           v)
+
+_paramStage ::
+   (IsSized a,
+    TypeNum.NaturalT n, TypeNum.PositiveT (n :*: LLVM.UnknownSize)) =>
+   CausalP.T p (Filt2Core.Parameter (Value a), v) v ->
+   CausalP.T p (ParameterValue n a, (Value Word32, v)) (Value Word32, v)
+_paramStage stage =
+   (Func.withArgs $ \(p,(i,v)) ->
+      liftA2 (,) (i+1)
+         (stage $&
+             (Causal.zipWith getStageParameterAlloca $& p &|& i)
+             &|&
+             v))
+   <<^
+   mapSnd (mapSnd Func.AnyArg)
+
+_causalGenP ::
+   (Causal.C process, IsSized a,
+    TypeNum.NaturalT n, TypeNum.PositiveT (n :*: LLVM.UnknownSize)) =>
+   process (Filt2Core.Parameter (Value a), v) v ->
+   process (ParameterValue n a, v) v
+_causalGenP stage =
+   withSize $ \n ->
    foldl (\x y -> (arr fst &&& x) >>> y) (arr snd) $
    map
       (\k ->
-         Filt2.causalPackedP <<<
-         Arrow.first (CausalP.mapSimple
-            (\ps -> getStageParameter ps k)))
+         stage <<<
+         Arrow.first (Causal.map (flip getStageParameter k)))
       (take (TypeNum.fromIntegerT n) [0..])
 
-getStageParameter, getStageParameterMalloc, getStageParameterAlloca ::
-   (LLVM.IsFirstClass a, IsSized a, SoV.IntegerConstant a,
+
+getStageParameter ::
+   (IsSized a,
     TypeNum.NaturalT n, TypeNum.PositiveT (n :*: LLVM.UnknownSize)) =>
    ParameterValue n a ->
    Word32 ->
@@ -148,17 +228,23 @@
    Memory.compose ps
 -}
 
+_getStageParameterMalloc, getStageParameterAlloca ::
+   (IsSized a,
+    TypeNum.NaturalT n, TypeNum.PositiveT (n :*: LLVM.UnknownSize)) =>
+   ParameterValue n a ->
+   Value Word32 ->
+   CodeGenFunction r (Filt2Core.Parameter (Value a))
 {-
 Expensive because we need a heap allocation for every sample.
 However, we could allocate the memory once in the Causal initialization routine.
 -}
-getStageParameterMalloc ps k = do
+_getStageParameterMalloc ps k = do
    ptr <- LLVM.malloc
    LLVM.store (parameterValue ps) ptr
    p <-
       Filt2.decomposeParameter
        =<< LLVM.load
-       =<< LLVM.getElementPtr0 ptr (valueOf k, ())
+       =<< LLVM.getElementPtr0 ptr (k, ())
    LLVM.free ptr
    return p
 
@@ -172,4 +258,7 @@
    LLVM.store (parameterValue ps) ptr
    Filt2.decomposeParameter
     =<< LLVM.load
-    =<< LLVM.getElementPtr0 ptr (valueOf k, ())
+    =<< LLVM.getElementPtr0 ptr (k, ())
+
+{-# DEPRECATED causalP          "use 'causal' instead" #-}
+{-# DEPRECATED causalPackedP    "use 'causalPacked' instead" #-}
diff --git a/src/Synthesizer/LLVM/Filter/SecondOrderPacked.hs b/src/Synthesizer/LLVM/Filter/SecondOrderPacked.hs
--- a/src/Synthesizer/LLVM/Filter/SecondOrderPacked.hs
+++ b/src/Synthesizer/LLVM/Filter/SecondOrderPacked.hs
@@ -4,13 +4,14 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE UndecidableInstances #-}
 module Synthesizer.LLVM.Filter.SecondOrderPacked (
-   Parameter, bandpassParameter, State, causalP,
+   Parameter, bandpassParameter, State, causal, causalP,
    ) where
 
 import qualified Synthesizer.LLVM.Filter.SecondOrder as Filt2L
 import qualified Synthesizer.Plain.Filter.Recursive.SecondOrder as Filt2
 
 import qualified Synthesizer.LLVM.CausalParameterized.Process as CausalP
+import qualified Synthesizer.LLVM.Causal.Process as Causal
 import qualified LLVM.Extra.ScalarOrVector as SoV
 import qualified LLVM.Extra.Vector as Vector
 import qualified LLVM.Extra.Memory as Memory
@@ -115,20 +116,14 @@
    yv <- Vector.assemble [x0, y0, x1new, y1new]
    return (y0, yv)
 
+causal ::
+   (Causal.C process, Vector.Arithmetic a, Memory.C (Value (State a))) =>
+   process (Parameter a, Value a) (Value a)
+causal =
+   Causal.mapAccum next (return A.zero)
+
+{-# DEPRECATED causalP "use causal instead" #-}
 causalP ::
-   (Vector.Arithmetic a,
-    Memory.C (Value (State a))) =>
-{-
-   (Vector.Arithmetic a, IsPrimitive am,
-    Memory.FirstClass a am,
-    IsSized am ams,
-    Add ams ams  ams2,
-    Add ams ams2 ams3,
-    Add ams ams3 ams4,
-    Sets.Pos ams4) =>
--}
-   CausalP.T p
-      (Parameter a, Value a) (Value a)
-causalP =
-   CausalP.mapAccumSimple next
-      (return (LLVM.value LLVM.zero))
+   (Vector.Arithmetic a, Memory.C (Value (State a))) =>
+   CausalP.T p (Parameter a, Value a) (Value a)
+causalP = causal
diff --git a/src/Synthesizer/LLVM/Filter/Universal.hs b/src/Synthesizer/LLVM/Filter/Universal.hs
--- a/src/Synthesizer/LLVM/Filter/Universal.hs
+++ b/src/Synthesizer/LLVM/Filter/Universal.hs
@@ -2,7 +2,7 @@
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 module Synthesizer.LLVM.Filter.Universal (
    Result(Result, lowpass, highpass, bandpass, bandlimit),
-   Parameter, parameter, causalP,
+   Parameter, parameter, causal, causalP,
    ) where
 
 import qualified Synthesizer.Plain.Filter.Recursive.Universal as Universal
@@ -13,6 +13,7 @@
 import qualified Synthesizer.Plain.Modifier as Modifier
 
 import qualified Synthesizer.LLVM.CausalParameterized.Process as CausalP
+import qualified Synthesizer.LLVM.Causal.Process as Causal
 import qualified Synthesizer.LLVM.Frame.SerialVector as Serial
 import qualified Synthesizer.LLVM.Simple.Value as Value
 
@@ -75,8 +76,8 @@
 
 instance (Value.Flatten a) => Value.Flatten (Result a) where
    type Registers (Result a) = Result (Value.Registers a)
-   flatten = Value.flattenTraversable
-   unfold =  Value.unfoldFunctor
+   flattenCode = Value.flattenCodeTraversable
+   unfoldCode = Value.unfoldCodeTraversable
 
 
 {-
@@ -93,8 +94,8 @@
 
 instance (Value.Flatten a) => Value.Flatten (Parameter a) where
    type Registers (Parameter a) = Parameter (Value.Registers a)
-   flatten = Value.flattenTraversable
-   unfold =  Value.unfoldFunctor
+   flattenCode = Value.flattenCodeTraversable
+   unfoldCode = Value.unfoldCodeTraversable
 
 
 instance (Vector.Simple v) => Vector.Simple (Parameter v) where
@@ -144,15 +145,13 @@
 parameter ::
    (A.Transcendental a, A.RationalConstant a) =>
    a -> a -> CodeGenFunction r (Parameter a)
-parameter reson freq =
-   Value.flatten $
-   Universal.parameter
-      (Pole (Value.constantValue reson) (Value.constantValue freq))
---      (Pole (Value.unfold reson) (Value.unfold freq))
+parameter =
+   Value.unlift2 $ \reson freq ->
+   Universal.parameter (Pole reson freq)
 
 
 modifier ::
-   (A.PseudoModule a v, A.IntegerConstant a) =>
+   (a ~ A.Scalar v, A.PseudoModule v, A.IntegerConstant a) =>
    Modifier.Simple
       (Universal.State (Value.T v))
       (Parameter (Value.T a))
@@ -160,11 +159,17 @@
 modifier =
    Universal.modifier
 
+causal ::
+   (Causal.C process,
+    a ~ A.Scalar v, A.PseudoModule v, A.IntegerConstant a, Memory.C v) =>
+   process (Parameter a, v) (Result v)
+causal = Causal.fromModifier modifier
+
+{-# DEPRECATED causalP "use causal instead" #-}
 causalP ::
-   (A.PseudoModule a v, A.IntegerConstant a, Memory.C v) =>
+   (a ~ A.Scalar v, A.PseudoModule v, A.IntegerConstant a, Memory.C v) =>
    CausalP.T p (Parameter a, v) (Result v)
-causalP =
-   CausalP.fromModifier modifier
+causalP = causal
 
 {-
 The state variable filter could be vectorised
diff --git a/src/Synthesizer/LLVM/Frame/SerialVector.hs b/src/Synthesizer/LLVM/Frame/SerialVector.hs
--- a/src/Synthesizer/LLVM/Frame/SerialVector.hs
+++ b/src/Synthesizer/LLVM/Frame/SerialVector.hs
@@ -1,9 +1,8 @@
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE EmptyDataDecls #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE StandaloneDeriving #-}
 {- |
 A special vector type that represents a time-sequence of samples.
 This way we can distinguish safely between LLVM vectors
@@ -23,11 +22,12 @@
    Zero, writeZero,
    Iterator(Iterator), ReadIterator, WriteIterator, ReadMode, WriteMode,
 
-   Sized, Size, size, sizeOfIterator,
+   Sized, Size, size, sizeOfIterator, withSize,
 
    insertTraversable, extractTraversable,
    readStartTraversable, readNextTraversable,
    writeStartTraversable, writeNextTraversable, writeStopTraversable,
+   writeZeroTraversable,
 
    extractAll, assemble, modify,
    upsample, subsample,
@@ -44,9 +44,9 @@
 import qualified LLVM.Extra.Arithmetic as A
 import qualified LLVM.Extra.Class as Class
 import qualified LLVM.Extra.Memory as Memory
+import qualified LLVM.Util.Loop as Loop
 import qualified LLVM.Core as LLVM
-import LLVM.Extra.Class
-   (MakeValueTuple, valueTupleOf, )
+import LLVM.Extra.Class (MakeValueTuple, valueTupleOf, )
 import LLVM.Util.Loop (Phi, )
 
 import qualified Types.Data.Num as TypeNum
@@ -85,15 +85,60 @@
 newtype T v = Cons v
    deriving (
       Eq, St.Storable,
-      Class.Zero, Class.Undefined, Phi,
-      A.Additive, A.PseudoRing, A.Field, A.Real, A.Fraction,
-      A.Algebraic, A.Transcendental,
+      Class.Zero, Class.Undefined,
       A.IntegerConstant, A.RationalConstant, Num)
 --      SoV.IntegerConstant, SoV.RationalConstant, SoV.TranscendentalConstant)
 
-instance (A.PseudoModule a v) => A.PseudoModule a (T v) where
+instance (Phi v) => Phi (T v) where
+   phis bb (Cons v) = fmap Cons $ Loop.phis bb v
+   addPhis bb (Cons x) (Cons y) = Loop.addPhis bb x y
+
+instance (A.Additive v) => A.Additive (T v) where
+   add = lift2 A.add
+   sub = lift2 A.sub
+   neg = lift1 A.neg
+   zero = Cons A.zero
+
+instance (A.PseudoRing v) => A.PseudoRing (T v) where
+   mul = lift2 A.mul
+
+instance (A.Real v) => A.Real (T v) where
+   min = lift2 A.min
+   max = lift2 A.max
+   abs = lift1 A.abs
+   signum = lift1 A.signum
+
+instance (A.Fraction v) => A.Fraction (T v) where
+   truncate = lift1 A.truncate
+   fraction = lift1 A.fraction
+
+instance (A.Field v) => A.Field (T v) where
+   fdiv = lift2 A.fdiv
+
+instance (A.Algebraic v) => A.Algebraic (T v) where
+   sqrt = lift1 A.sqrt
+
+instance (A.Transcendental v) => A.Transcendental (T v) where
+   pi  = fmap Cons A.pi
+   sin = lift1 A.sin
+   log = lift1 A.log
+   exp = lift1 A.exp
+   cos = lift1 A.cos
+   pow = lift2 A.pow
+
+
+lift1 :: Functor f => (a -> f b) -> T a -> f (T b)
+lift1 f (Cons x) = fmap Cons $ f x
+
+lift2 :: Functor f => (a -> b -> f c) -> T a -> T b -> f (T c)
+lift2 f (Cons x) (Cons y) = fmap Cons $ f x y
+
+
+type instance A.Scalar (T v) = A.Scalar v
+instance (A.PseudoModule v) => A.PseudoModule (T v) where
    scale a (Cons v) = fmap Cons $ A.scale a v
 
+
 type instance F.Arguments f (T v) = f (T v)
 instance F.MakeArguments (T v) where
    makeArgs = id
@@ -124,8 +169,13 @@
 
 
 newtype Iterator mode it v = Iterator {unIterator :: it}
-   deriving (Class.Undefined, Phi)
+   deriving (Class.Undefined)
 
+instance Phi it => Phi (Iterator mode it v) where
+   phis bb (Iterator x) = fmap Iterator $ Loop.phis bb x
+   addPhis bb (Iterator x) (Iterator y) = Loop.addPhis bb x y
+
+
 type ReadIterator = Iterator ReadMode
 type WriteIterator = Iterator WriteMode
 
@@ -379,8 +429,7 @@
 
 instance (Zero v) => Zero (Stereo.T v) where
 
-   writeZero =
-      fmap combineItFunctor $ Trav.sequence $ App.pure writeZero
+   writeZero = writeZeroTraversable
 
 
 modify ::
@@ -396,7 +445,7 @@
    (Read v) =>
    v -> LLVM.CodeGenFunction r (Element v)
 subsample v =
-   extract (LLVM.value LLVM.zero :: LLVM.Value Word32) v
+   extract (A.zero :: LLVM.Value Word32) v
 
 -- this will be translated to an efficient pshufd
 upsample ::
@@ -495,6 +544,9 @@
 writeStopTraversable ::
    (Trav.Traversable f, App.Applicative f, C v) =>
    WriteIterator (f (WriteIt v)) (f v) -> LLVM.CodeGenFunction r (f v)
+writeZeroTraversable ::
+   (Trav.Traversable f, App.Applicative f, Zero v) =>
+   LLVM.CodeGenFunction r (WriteIterator (f (WriteIt v)) (f v))
 
 writeStartTraversable =
    fmap combineItFunctor $ Trav.sequence $ App.pure writeStart
@@ -505,7 +557,10 @@
 
 writeStopTraversable = Trav.mapM writeStop . sequenceItFunctor
 
+writeZeroTraversable =
+   fmap combineItFunctor $ Trav.sequence $ App.pure writeZero
 
+
 instance (MakeValueTuple v) => MakeValueTuple (T v) where
    type ValueTuple (T v) = T (Class.ValueTuple v)
    valueTupleOf (Cons v) = Cons (Class.valueTupleOf v)
@@ -551,7 +606,7 @@
 sizeOfIterator :: Sized v => Iterator mode it v -> Int
 sizeOfIterator =
    let sz :: Sized v => v -> Iterator mode it v -> Int
-       sz v _ = fromIntegral $ size v
+       sz v _ = size v
    in  sz undefined
 
 
diff --git a/src/Synthesizer/LLVM/Frame/Stereo.hs b/src/Synthesizer/LLVM/Frame/Stereo.hs
--- a/src/Synthesizer/LLVM/Frame/Stereo.hs
+++ b/src/Synthesizer/LLVM/Frame/Stereo.hs
@@ -9,12 +9,13 @@
 -}
 module Synthesizer.LLVM.Frame.Stereo (
    Stereo.T, Stereo.cons, Stereo.left, Stereo.right,
+   Stereo.Channel(Left, Right), Stereo.select,
    Stereo.arrowFromMono,
    Stereo.arrowFromMonoControlled,
    Stereo.arrowFromChannels,
-   interleave,
-   sequence,
-   liftApplicative,
+   Stereo.interleave,
+   Stereo.sequence,
+   Stereo.liftApplicative,
    ) where
 
 import qualified Synthesizer.Frame.Stereo as Stereo
@@ -33,28 +34,10 @@
 import Types.Data.Num (d0, d1, )
 
 import Control.Monad (liftM2, )
-import Control.Applicative (Applicative, liftA2, )
+import Control.Applicative (liftA2, )
 import qualified Data.Traversable as Trav
 
-import Prelude hiding (sequence, )
-
-
--- if it turns out to be useful, we may move it to sample-frame package
-interleave :: (Stereo.T a, Stereo.T b) -> Stereo.T (a,b)
-interleave = uncurry (liftA2 (,))
-
--- if it turns out to be useful, we may move it to sample-frame package
-sequence :: (Functor f) => f (Stereo.T a) -> Stereo.T (f a)
-sequence x =
-   Stereo.cons
-      (fmap Stereo.left x)
-      (fmap Stereo.right x)
-
-liftApplicative ::
-   (Applicative f) =>
-   (f a -> f b) -> f (Stereo.T a) -> f (Stereo.T b)
-liftApplicative proc =
-   Trav.sequenceA . fmap proc . sequence
+import Prelude hiding (Either(Left, Right), sequence, )
 
 
 instance (Class.Zero a) => Class.Zero (Stereo.T a) where
diff --git a/src/Synthesizer/LLVM/Frame/StereoInterleaved.hs b/src/Synthesizer/LLVM/Frame/StereoInterleaved.hs
--- a/src/Synthesizer/LLVM/Frame/StereoInterleaved.hs
+++ b/src/Synthesizer/LLVM/Frame/StereoInterleaved.hs
@@ -26,12 +26,16 @@
    Value(Value),
    interleave,
    deinterleave,
+   fromMono,
    assemble, extractAll,
+   zero,
    amplify,
+   envelope,
    ) where
 
 import qualified Synthesizer.LLVM.Frame.Stereo as Stereo
 import qualified Synthesizer.LLVM.Frame.SerialVector as Serial
+import qualified Synthesizer.LLVM.CausalParameterized.Functional as F
 
 import qualified LLVM.Extra.Arithmetic as A
 import qualified LLVM.Extra.Control as C
@@ -55,16 +59,23 @@
 
 import qualified Data.Foldable as Fold
 import Control.Monad (liftM2, )
-import Control.Applicative (liftA2, )
+import Control.Applicative (liftA2, pure, )
 
 import Data.Tuple.HT (mapPair, )
 
+import qualified Algebra.Additive as Additive
 
+
 data T n a = Cons (Vector n a) (Vector n a)
 
 data Value n a = Value (LLVM.Value (Vector n a)) (LLVM.Value (Vector n a))
 
 
+type instance F.Arguments f (Value n a) = f (Value n a)
+instance F.MakeArguments (Value n a) where
+   makeArgs = id
+
+
 withSize :: (TypeNum.IntegerT n) => (Int -> m (Value n a)) -> m (Value n a)
 withSize =
    let sz :: (TypeNum.IntegerT n) => n -> (Int -> m (Value n a)) -> m (Value n a)
@@ -86,6 +97,13 @@
 deinterleave v =
    Serial.assemble =<< extractAll v
 
+fromMono ::
+   (LLVM.IsPrimitive a, TypeNum.PositiveT n) =>
+   Serial.Value n a ->
+   LLVM.CodeGenFunction r (Value n a)
+fromMono x =
+   assemble . map pure =<< Serial.extractAll x
+
 assemble ::
    (LLVM.IsPrimitive a, TypeNum.IntegerT n, TypeNum.PositiveT n) =>
    [Stereo.T (LLVM.Value a)] -> LLVM.CodeGenFunction r (Value n a)
@@ -126,7 +144,7 @@
           St.pokeElemOff p 1 v1
 
 instance (TypeNum.PositiveT n, LLVM.IsPrimitive a) => Class.Zero (Value n a) where
-   zeroTuple = Value (LLVM.value LLVM.zero) (LLVM.value LLVM.zero)
+   zeroTuple = Value Class.zeroTuple Class.zeroTuple
 
 instance (TypeNum.PositiveT n, LLVM.IsPrimitive a) => Undefined (Value n a) where
    undefTuple = Value (LLVM.value LLVM.undef) (LLVM.value LLVM.undef)
@@ -260,6 +278,10 @@
    neg = mapV A.neg
 
 
+zero :: (TypeNum.PositiveT n, Additive.C a) => (T n a)
+zero = Cons (LLVM.vector [Additive.zero]) (LLVM.vector [Additive.zero])
+
+
 scale ::
    (TypeNum.PositiveT n, LLVM.IsPrimitive a, LLVM.IsArithmetic a) =>
    LLVM.Value a -> Value n a -> LLVM.CodeGenFunction r (Value n a)
@@ -271,6 +293,12 @@
    (TypeNum.PositiveT n, LLVM.IsPrimitive a, LLVM.IsArithmetic a, LLVM.IsConst a) =>
    a -> Value n a -> LLVM.CodeGenFunction r (Value n a)
 amplify a = scale (LLVM.valueOf a)
+
+envelope ::
+   (TypeNum.PositiveT n, LLVM.IsPrimitive a, LLVM.IsArithmetic a, LLVM.IsConst a) =>
+   Serial.Value n a -> Value n a -> LLVM.CodeGenFunction r (Value n a)
+envelope e a =
+   zipV Value (flip A.mul) a =<< fromMono e
 
 
 mapV :: (Monad m) =>
diff --git a/src/Synthesizer/LLVM/Generator/Exponential2.hs b/src/Synthesizer/LLVM/Generator/Exponential2.hs
--- a/src/Synthesizer/LLVM/Generator/Exponential2.hs
+++ b/src/Synthesizer/LLVM/Generator/Exponential2.hs
@@ -118,8 +118,8 @@
 
 instance (Value.Flatten a) => Value.Flatten (Parameter a) where
    type Registers (Parameter a) = Parameter (Value.Registers a)
-   flatten = Value.flattenTraversable
-   unfold =  Value.unfoldFunctor
+   flattenCode = Value.flattenCodeTraversable
+   unfoldCode = Value.unfoldCodeTraversable
 
 
 instance (Vector.Simple v) => Vector.Simple (Parameter v) where
@@ -136,9 +136,7 @@
    (Trans.C a, SoV.TranscendentalConstant a, IsFloating a) =>
    Value a ->
    CodeGenFunction r (Parameter (Value a))
-parameter halfLife =
-   Value.flatten $ parameterPlain $
-   Value.constantValue halfLife
+parameter = Value.unlift1 parameterPlain
 
 parameterPlain ::
    (Trans.C a) =>
@@ -252,8 +250,8 @@
 
 instance (Value.Flatten a) => Value.Flatten (ParameterPacked a) where
    type Registers (ParameterPacked a) = ParameterPacked (Value.Registers a)
-   flatten = Value.flattenTraversable
-   unfold =  Value.unfoldFunctor
+   flattenCode = Value.flattenCodeTraversable
+   unfoldCode = Value.unfoldCodeTraversable
 
 type instance F.Arguments f (ParameterPacked a) = f (ParameterPacked a)
 instance F.MakeArguments (ParameterPacked a) where
@@ -284,8 +282,7 @@
       Serial.iterate (A.mul k) (A.fromInteger' 1)
    return $ ParameterPacked feedback current
 {-
-   Value.flatten $ parameterPackedPlain $
-   Value.constantValue halfLife
+   Value.unlift1 parameterPackedPlain
 -}
 
 withSizePlain ::
diff --git a/src/Synthesizer/LLVM/Interpolation.hs b/src/Synthesizer/LLVM/Interpolation.hs
new file mode 100644
--- /dev/null
+++ b/src/Synthesizer/LLVM/Interpolation.hs
@@ -0,0 +1,269 @@
+{-# LANGUAGE Rank2Types #-}
+{-# LANGUAGE TypeFamilies #-}
+module Synthesizer.LLVM.Interpolation (
+   C(margin),
+   loadNodes,
+   indexNodes,
+
+   Margin(..),
+   toMargin,
+
+   T,
+
+   Nodes02(..),
+   linear,
+   linearVector,
+
+   Nodes13(..),
+   cubic,
+   cubicVector,
+   ) where
+
+import qualified Synthesizer.LLVM.Simple.Value as Value
+
+import qualified Synthesizer.LLVM.Frame.SerialVector as Serial
+import qualified Synthesizer.Interpolation.Core as Interpolation
+
+import qualified LLVM.Extra.Scalar as Scalar
+import qualified LLVM.Extra.Arithmetic as A
+import qualified LLVM.Extra.Class as Class
+import qualified LLVM.Extra.Memory as Memory
+import qualified LLVM.Util.Loop as Loop
+import qualified LLVM.Core as LLVM
+
+import LLVM.Core (CodeGenFunction, Value, )
+
+import Foreign.Ptr (Ptr, )
+import Data.Word (Word32, )
+
+import qualified Types.Data.Num as TypeNum
+
+import qualified Control.Monad.Trans.State as MS
+import Control.Applicative (Applicative, liftA2, pure, (<*>), )
+import Data.Traversable (Traversable, traverse, sequenceA, foldMapDefault, )
+import Data.Foldable (Foldable, foldMap, )
+
+
+class (Applicative nodes, Traversable nodes) => C nodes where
+   margin :: Margin (nodes a)
+
+data Margin nodes =
+      Margin { marginNumber, marginOffset :: Int }
+   deriving (Show, Eq)
+
+
+type T r nodes a v = a -> nodes v -> CodeGenFunction r v
+
+
+toMargin ::
+   (C nodes) =>
+   (forall r. T r nodes a v) ->
+   Margin (nodes v)
+toMargin _ = margin
+
+
+{- |
+Zero nodes before index 0 and two nodes starting from index 0.
+-}
+data Nodes02 a = Nodes02 {nodes02_0, nodes02_1 :: a}
+
+instance C Nodes02 where
+   margin = Margin { marginNumber = 2, marginOffset = 0 }
+
+
+instance Functor Nodes02 where
+   fmap f (Nodes02 x0 x1) = Nodes02 (f x0) (f x1)
+
+instance Applicative Nodes02 where
+   pure x = Nodes02 x x
+   (Nodes02 f0 f1) <*> (Nodes02 x0 x1) = Nodes02 (f0 x0) (f1 x1)
+
+instance Foldable Nodes02 where
+   foldMap = foldMapDefault
+
+instance Traversable Nodes02 where
+   traverse f (Nodes02 x0 x1) = liftA2 Nodes02 (f x0) (f x1)
+
+
+instance (Serial.Sized value) => Serial.Sized (Nodes02 value) where
+   type Size (Nodes02 value) = Serial.Size value
+
+instance (Serial.Read v) => Serial.Read (Nodes02 v) where
+   type Element (Nodes02 v) = Nodes02 (Serial.Element v)
+   type ReadIt (Nodes02 v) = Nodes02 (Serial.ReadIt v)
+
+   extract = Serial.extractTraversable
+
+   readStart = Serial.readStartTraversable
+   readNext = Serial.readNextTraversable
+
+instance (Serial.C v) => Serial.C (Nodes02 v) where
+   type WriteIt (Nodes02 v) = Nodes02 (Serial.WriteIt v)
+
+   insert = Serial.insertTraversable
+
+   writeStart = Serial.writeStartTraversable
+   writeNext = Serial.writeNextTraversable
+   writeStop = Serial.writeStopTraversable
+
+
+instance (Class.Undefined a) => Class.Undefined (Nodes02 a) where
+   undefTuple = Class.undefTuplePointed
+
+instance (Loop.Phi a) => Loop.Phi (Nodes02 a) where
+   phis = Class.phisTraversable
+   addPhis = Class.addPhisFoldable
+
+
+type Struct02 a = LLVM.Struct (a, (a, ()))
+
+memory02 ::
+   (Memory.C l) =>
+   Memory.Record r (Struct02 (Memory.Struct l)) (Nodes02 l)
+memory02 =
+   liftA2 Nodes02
+      (Memory.element nodes02_0 TypeNum.d0)
+      (Memory.element nodes02_1 TypeNum.d1)
+
+instance (Memory.C l) => Memory.C (Nodes02 l) where
+   type Struct (Nodes02 l) = Struct02 (Memory.Struct l)
+   load = Memory.loadRecord memory02
+   store = Memory.storeRecord memory02
+   decompose = Memory.decomposeRecord memory02
+   compose = Memory.composeRecord memory02
+
+
+linear ::
+   (A.PseudoRing a, A.IntegerConstant a) =>
+   T r Nodes02 a a
+linear r (Nodes02 a b) =
+   Scalar.unliftM3 (Value.unlift3 Interpolation.linear) a b r
+
+linearVector ::
+   (A.PseudoModule v, A.Scalar v ~ a, A.IntegerConstant a) =>
+   T r Nodes02 a v
+linearVector r (Nodes02 a b) =
+   Value.unlift3 Interpolation.linear a b r
+
+
+
+
+{- |
+One node before index 0 and three nodes starting from index 0.
+-}
+data Nodes13 a = Nodes13 {nodes13_0, nodes13_1, nodes13_2, nodes13_3 :: a}
+
+instance C Nodes13 where
+   margin = Margin { marginNumber = 4, marginOffset = 1 }
+
+instance Functor Nodes13 where
+   fmap f (Nodes13 x0 x1 x2 x3) = Nodes13 (f x0) (f x1) (f x2) (f x3)
+
+instance Applicative Nodes13 where
+   pure x = Nodes13 x x x x
+   (Nodes13 f0 f1 f2 f3) <*> (Nodes13 x0 x1 x2 x3) =
+      Nodes13 (f0 x0) (f1 x1) (f2 x2) (f3 x3)
+
+instance Foldable Nodes13 where
+   foldMap = foldMapDefault
+
+instance Traversable Nodes13 where
+   traverse f (Nodes13 x0 x1 x2 x3) =
+      pure Nodes13 <*> f x0 <*> f x1 <*> f x2 <*> f x3
+
+
+instance (Serial.Sized value) => Serial.Sized (Nodes13 value) where
+   type Size (Nodes13 value) = Serial.Size value
+
+instance (Serial.Read v) => Serial.Read (Nodes13 v) where
+   type Element (Nodes13 v) = Nodes13 (Serial.Element v)
+   type ReadIt (Nodes13 v) = Nodes13 (Serial.ReadIt v)
+
+   extract = Serial.extractTraversable
+
+   readStart = Serial.readStartTraversable
+   readNext = Serial.readNextTraversable
+
+instance (Serial.C v) => Serial.C (Nodes13 v) where
+   type WriteIt (Nodes13 v) = Nodes13 (Serial.WriteIt v)
+
+   insert = Serial.insertTraversable
+
+   writeStart = Serial.writeStartTraversable
+   writeNext = Serial.writeNextTraversable
+   writeStop = Serial.writeStopTraversable
+
+
+instance (Class.Undefined a) => Class.Undefined (Nodes13 a) where
+   undefTuple = Class.undefTuplePointed
+
+instance (Loop.Phi a) => Loop.Phi (Nodes13 a) where
+   phis = Class.phisTraversable
+   addPhis = Class.addPhisFoldable
+
+
+type Struct13 a = LLVM.Struct (a, (a, (a, (a, ()))))
+
+memory13 ::
+   (Memory.C l) =>
+   Memory.Record r (Struct13 (Memory.Struct l)) (Nodes13 l)
+memory13 =
+   pure Nodes13
+      <*> Memory.element nodes13_0 TypeNum.d0
+      <*> Memory.element nodes13_1 TypeNum.d1
+      <*> Memory.element nodes13_2 TypeNum.d2
+      <*> Memory.element nodes13_3 TypeNum.d3
+
+instance (Memory.C l) => Memory.C (Nodes13 l) where
+   type Struct (Nodes13 l) = Struct13 (Memory.Struct l)
+   load = Memory.loadRecord memory13
+   store = Memory.storeRecord memory13
+   decompose = Memory.decomposeRecord memory13
+   compose = Memory.composeRecord memory13
+
+
+cubic ::
+   (A.Field a, A.RationalConstant a) =>
+   T r Nodes13 a a
+cubic r (Nodes13 a b c d) =
+   Scalar.unliftM5 (Value.unlift5 Interpolation.cubic) a b c d r
+
+cubicVector ::
+   (A.PseudoModule v, A.Scalar v ~ a, A.Field a, A.RationalConstant a) =>
+   T r Nodes13 a v
+cubicVector r (Nodes13 a b c d) =
+   Value.unlift5 Interpolation.cubic a b c d r
+
+
+loadNodes ::
+   (C nodes) =>
+   (Value (Ptr am) -> CodeGenFunction r a) ->
+   Value Word32 ->
+   Value (Ptr am) -> CodeGenFunction r (nodes a)
+loadNodes loadNode step =
+   MS.evalStateT $ sequenceA $ pure $ loadNext loadNode step
+
+loadNext ::
+   (Value (Ptr am) -> CodeGenFunction r a) ->
+   Value Word32 ->
+   MS.StateT (Value (Ptr am)) (CodeGenFunction r) a
+loadNext loadNode step =
+   MS.StateT $ \ptr ->
+      liftA2 (,) (loadNode ptr) (LLVM.getElementPtr ptr (step, ()))
+
+
+
+indexNodes ::
+   (C nodes) =>
+   (Value Word32 -> CodeGenFunction r v) ->
+   Value Word32 ->
+   Value Word32 -> CodeGenFunction r (nodes v)
+indexNodes indexNode step =
+   MS.evalStateT $ sequenceA $ pure $ indexNext indexNode step
+
+indexNext ::
+   (Value Word32 -> CodeGenFunction r v) ->
+   Value Word32 ->
+   MS.StateT (Value Word32) (CodeGenFunction r) v
+indexNext indexNode step =
+   MS.StateT $ \i -> liftA2 (,) (indexNode i) (A.add i step)
diff --git a/src/Synthesizer/LLVM/MIDI.hs b/src/Synthesizer/LLVM/MIDI.hs
--- a/src/Synthesizer/LLVM/MIDI.hs
+++ b/src/Synthesizer/LLVM/MIDI.hs
@@ -2,11 +2,13 @@
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE RankNTypes #-}
 {- |
 Convert MIDI events of a MIDI controller to a control signal.
 -}
 module Synthesizer.LLVM.MIDI (
-   module Synthesizer.LLVM.MIDI,
+   frequencyFromBendModulation,
+   frequencyFromBendModulationPacked,
    Gen.applyModulation,
    ) where
 
@@ -15,8 +17,9 @@
 import qualified Synthesizer.LLVM.Frame.SerialVector as Serial
 
 import Synthesizer.LLVM.CausalParameterized.Process (($>), )
-import qualified Synthesizer.LLVM.Parameterized.SignalPacked as SigPS
+import qualified Synthesizer.LLVM.CausalParameterized.Functional as Func
 import qualified Synthesizer.LLVM.CausalParameterized.Process as CausalP
+import qualified Synthesizer.LLVM.Parameterized.SignalPacked as SigPS
 import qualified Synthesizer.LLVM.Parameterized.Signal as SigP
 import qualified Synthesizer.LLVM.Parameter as Param
 import qualified Synthesizer.LLVM.Wave as Wave
@@ -29,7 +32,6 @@
 import qualified LLVM.Core as LLVM
 import LLVM.Core (IsSized, SizeOf, )
 
-import qualified Types.Data.Bool as TypeBool
 import qualified Types.Data.Num as TypeNum
 import Types.Data.Num.Ops ((:*:), )
 
@@ -40,10 +42,11 @@
 
 import Control.Arrow (second, (<<<), (<<^), )
 import Control.Monad ({- liftM, -} liftM2, )
+import Data.Tuple.HT (mapPair, )
 
 -- import NumericPrelude.Base
 import NumericPrelude.Numeric
-import Prelude ()
+import Prelude (($), )
 
 
 {-
@@ -132,7 +135,7 @@
       press <- channelPressure chan pressDepth 0
       return $
          SigP.envelope bend $
-         SigP.mapSimple (A.add (LLVM.valueOf 1)) $
+         SigP.mapSimple (A.add A.one) $
          SigP.envelope
             (SigP.mix fm press)
             (SigP.osciSimple Wave.approxSine2 zero $# speed)
@@ -145,11 +148,7 @@
    Param.T p y ->
    CausalP.T p (BM.T yl) yl
 frequencyFromBendModulation speed =
-   CausalP.envelope
-   <<<
-   second
-      (CausalP.mapSimple (A.add (A.fromInteger' 1)) <<< CausalP.envelope
-         $> SigP.osciSimple Wave.approxSine2 zero speed)
+   frequencyFromPair SigP.osciSimple speed
    <<^
    (\(BM.Cons b m) -> (b,m))
 
@@ -160,18 +159,31 @@
     LLVM.IsPrimitive am,
     Storable a, Class.MakeValueTuple a, Class.ValueTuple a ~ (LLVM.Value a),
     Vector.Real a, SoV.IntegerConstant a,
-    TypeNum.PositiveT n, TypeNum.IsPositive n ~ TypeBool.True,
+    TypeNum.PositiveT n,
     TypeNum.PositiveT (n :*: SizeOf a),
     TypeNum.PositiveT (n :*: SizeOf am)) =>
    Param.T p a ->
    CausalP.T p (BM.T (LLVM.Value a)) (Serial.Value n a)
 frequencyFromBendModulationPacked speed =
-   CausalP.envelope
-   <<<
-   second
-      (CausalP.mapSimple (A.add (A.fromInteger' 1)) <<< CausalP.envelope
-         $> SigPS.osciSimple Wave.approxSine2 zero speed)
+   frequencyFromPair SigPS.osciSimple speed
    <<<
    CausalP.mapSimple
       (\(BM.Cons b m) ->
          liftM2 (,) (Serial.upsample b) (Serial.upsample m))
+
+frequencyFromPair, _frequencyFromPair ::
+   (Additive.C y, A.PseudoRing yl, A.IntegerConstant yl, A.Fraction yl) =>
+   ((forall r. yl -> LLVM.CodeGenFunction r yl) ->
+    Param.T p y -> Param.T p y -> SigP.T p yl) ->
+   Param.T p y ->
+   CausalP.T p (yl,yl) yl
+frequencyFromPair osci speed =
+   (Func.withArgs $ \(b, m) ->
+      b * (1 + m * Func.fromSignal (osci Wave.approxSine2 zero speed)))
+   <<^
+   mapPair (Func.AnyArg, Func.AnyArg)
+
+_frequencyFromPair osci speed =
+   CausalP.envelope
+   <<<
+   second (1 + (CausalP.envelope $> osci Wave.approxSine2 zero speed))
diff --git a/src/Synthesizer/LLVM/Parameter.hs b/src/Synthesizer/LLVM/Parameter.hs
--- a/src/Synthesizer/LLVM/Parameter.hs
+++ b/src/Synthesizer/LLVM/Parameter.hs
@@ -1,8 +1,13 @@
 {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE Rank2Types #-}
+{-# LANGUAGE FlexibleContexts #-}
 module Synthesizer.LLVM.Parameter where
 
 import qualified LLVM.Extra.Class as Class
+import qualified LLVM.Extra.Memory as Memory
+import Foreign.Storable.Tuple ()
+import Foreign.Storable (Storable, )
 
 import qualified Algebra.Transcendental as Trans
 import qualified Algebra.Algebraic as Algebraic
@@ -16,9 +21,10 @@
 import Control.Applicative (pure, liftA2, )
 
 import Data.Tuple.HT (mapFst, )
+import Data.Word (Word32, )
 
 import NumericPrelude.Numeric
-import Prelude (fmap, error, (.), const, id, Functor, Monad, )
+import Prelude (Functor, Monad, fmap, error, (.), const, id, )
 import qualified Prelude as P
 
 
@@ -73,6 +79,37 @@
    T p tuple -> value -> value
 value (Constant a) _ = Class.valueTupleOf a
 value (Variable _) v = v
+
+
+{- |
+This function provides specialised variants of 'get' and 'value',
+that use the unit type for constants
+and thus save space in parameter structures.
+-}
+with ::
+   (Storable tuple, Class.MakeValueTuple tuple,
+    Class.ValueTuple tuple ~ value, Memory.C value) =>
+   T p tuple ->
+   (forall parameters.
+    (Storable parameters,
+     Class.MakeValueTuple parameters,
+     Memory.C (Class.ValueTuple parameters)) =>
+    (p -> parameters) ->
+    (Class.ValueTuple parameters -> value) ->
+    a) ->
+   a
+with (Constant a) f = f (const ()) (\() -> Class.valueTupleOf a)
+with (Variable v) f = f v id
+
+
+word32 :: T p Int -> T p Word32
+word32 = fmap fromIntegral
+
+
+infixl 0 $#
+
+($#) :: (T p a -> b) -> (a -> b)
+($#) f a = f (pure a)
 
 
 {- |
diff --git a/src/Synthesizer/LLVM/Parameterized/Signal.hs b/src/Synthesizer/LLVM/Parameterized/Signal.hs
--- a/src/Synthesizer/LLVM/Parameterized/Signal.hs
+++ b/src/Synthesizer/LLVM/Parameterized/Signal.hs
@@ -10,21 +10,19 @@
    ) where
 
 import Synthesizer.LLVM.Parameterized.SignalPrivate
-import qualified Synthesizer.LLVM.CausalParameterized.ProcessPrivate as Causal
+import qualified Synthesizer.LLVM.CausalParameterized.ProcessPrivate as CausalP
 import qualified Synthesizer.LLVM.Parameter as Param
 import qualified Synthesizer.LLVM.ConstantPiece as Const
 
+import qualified Synthesizer.LLVM.Frame.Stereo as Stereo
+import qualified Synthesizer.LLVM.Frame as Frame
 import qualified Synthesizer.LLVM.Random as Rnd
 import qualified Synthesizer.LLVM.Wave as Wave
-import qualified Synthesizer.LLVM.Frame as Frame
 import qualified Synthesizer.LLVM.Execution as Exec
-
-import qualified LLVM.Extra.MaybeContinuation as Maybe
-import qualified LLVM.Extra.ForeignPtr as ForeignPtr
-import qualified LLVM.Extra.Memory as Memory
-import LLVM.Extra.Control (whileLoop, ifThen, )
+import qualified Synthesizer.LLVM.Alloc as Alloc
 
 import qualified Synthesizer.LLVM.Storable.ChunkIterator as ChunkIt
+import qualified Synthesizer.LLVM.Storable.Vector as SVU
 import qualified Data.StorableVector.Lazy.Pattern as SVP
 import qualified Data.StorableVector.Lazy as SVL
 import qualified Data.StorableVector as SV
@@ -34,15 +32,25 @@
 import qualified Numeric.NonNegative.Chunky as Chunky
 import qualified Numeric.NonNegative.Wrapper as NonNeg
 
-import qualified Synthesizer.LLVM.Frame.Stereo as Stereo
-
 import qualified LLVM.Extra.Arithmetic as A
 import qualified LLVM.Extra.ScalarOrVector as SoV
+import qualified LLVM.Extra.MaybeContinuation as MaybeCont
+import qualified LLVM.Extra.Either as Either
+import qualified LLVM.Extra.Maybe as Maybe
+import qualified LLVM.Extra.ForeignPtr as ForeignPtr
+import qualified LLVM.Extra.Memory as Memory
+import LLVM.Extra.Class (MakeValueTuple, ValueTuple, Undefined, )
 import LLVM.Extra.Arithmetic (advanceArrayElementPtr, )
-import LLVM.Extra.Class (MakeValueTuple, ValueTuple, Undefined, undefTuple, )
+import LLVM.Extra.Control (whileLoop, ifThen, )
 
-import LLVM.Core as LLVM
 import qualified LLVM.Util.Loop as Loop
+import qualified LLVM.Core as LLVM
+import LLVM.Core
+          (CodeGenFunction, ret, Value, value, valueOf,
+           IsSized, IsConst, IsArithmetic, IsFloating,
+           CodeGenModule, Linkage(ExternalLinkage),
+           Function, createNamedFunction, )
+
 import qualified Types.Data.Num as TypeNum
 
 import Control.Monad.HT ((<=<), )
@@ -55,61 +63,29 @@
 import qualified Algebra.RealField as RealField
 import qualified Algebra.Algebraic as Algebraic
 import qualified Algebra.Field as Field
-import qualified Algebra.Ring as Ring
 import qualified Algebra.Additive as Additive
 
+import Data.Tuple.HT (mapSnd, )
 import Data.Word (Word8, Word32, )
 import Data.Int (Int32, )
 import Foreign.Storable.Tuple ()
 import Foreign.Storable (Storable, )
-import Foreign.Marshal.Array (advancePtr, )
-import qualified Synthesizer.LLVM.Alloc as Alloc
 import Foreign.ForeignPtr (touchForeignPtr, withForeignPtr, )
-import Foreign.Ptr (FunPtr, nullPtr, )
+import Foreign.Ptr (FunPtr, Ptr, nullPtr, )
 import Control.Exception (bracket, )
 import qualified System.Unsafe as Unsafe
+import qualified Foreign.Concurrent as FC
 
 import qualified Synthesizer.LLVM.Debug.Storable as DebugSt
 import qualified Synthesizer.LLVM.Debug.Counter as Counter
 
 import NumericPrelude.Numeric
-import NumericPrelude.Base hiding (and, iterate, map, zip, zipWith, )
+import NumericPrelude.Base hiding (and, iterate, map, zip, zipWith, cycle, )
 
 -- for debugMain
 import qualified Control.Monad.Trans.Reader as R
 
 
-infixl 0 $#
-
-($#) :: (Param.T p a -> b) -> (a -> b)
-($#) f a = f (return a)
-
-
-mapAccum ::
-   (Storable pnh, MakeValueTuple pnh, ValueTuple pnh ~ pnl, Memory.C pnl,
-    Storable psh, MakeValueTuple psh, ValueTuple psh ~ psl, Memory.C psl,
-    Memory.C s) =>
-   (forall r. pnl -> a -> s -> CodeGenFunction r (b,s)) ->
-   (forall r. psl -> CodeGenFunction r s) ->
-   Param.T p pnh ->
-   Param.T p psh ->
-   T p a -> T p b
-mapAccum f startS selectParamF selectParamS
-      (Cons next start createIOContext deleteIOContext) =
-   Cons
-      (\(parameterF, parameter) (sa0,ss0) -> do
-         (a,sa1) <- next parameter sa0
-         (b,ss1) <- Maybe.lift $ f (Param.value selectParamF parameterF) a ss0
-         return (b, (sa1,ss1)))
-      (\(parameterF, parameter) ->
-         liftM2 (,) (start parameter) (startS (Param.value selectParamS parameterF)))
-      (\p -> do
-         (ioContext, (nextParam, startParam)) <- createIOContext p
-         return (ioContext, ((Param.get selectParamF p, nextParam),
-                             (Param.get selectParamS p, startParam))))
-      deleteIOContext
-
-
 zip :: T p a -> T p b -> T p (a,b)
 zip = liftA2 (,)
 
@@ -121,43 +97,42 @@
 -}
 tail ::
    T p a -> T p a
-tail (Cons next start createIOContext deleteIOContext) = Cons
+tail (Cons next start stop createIOContext deleteIOContext) = Cons
    next
-   (\(nextParameter, startParameter) -> do
-      s0 <- start startParameter
-      Maybe.resolve (next nextParameter s0)
-         (return s0)
-         (\(_a,s1) -> return s1))
-   (\p -> do
-      (ioContext, (nextParam, startParam)) <- createIOContext p
-      return (ioContext, (nextParam, (nextParam, startParam))))
+   (\parameter -> do
+      (c,s0) <- start parameter
+      MaybeCont.resolve (next c s0)
+         (return (c,s0))
+         (\(_a,s1) -> return (c,s1)))
+   stop
+   createIOContext
    deleteIOContext
 
 drop ::
    Param.T p Int ->
    T p a -> T p a
-drop n (Cons next start createIOContext deleteIOContext) =
-      let n32 = fmap (fromIntegral :: Int -> Word32) n in Cons
+drop n (Cons next start stop createIOContext deleteIOContext) =
+   Param.with (Param.word32 n) $ \getN valueN -> Cons
    next
-   (\(nextParameter, i0, startParameter) -> do
-      s0 <- start startParameter
+   (\(parameter, i0) -> do
+      (c,s0) <- start parameter
       (_, _, s3) <-
-         whileLoop (valueOf True, Param.value n32 i0, s0)
+         whileLoop (valueOf True, valueN i0, s0)
             (\(cont,i1,_s1) ->
                A.and cont =<<
-                  A.cmp CmpGT i1 (value LLVM.zero))
+                  A.cmp LLVM.CmpGT i1 A.zero)
             (\(_cont,i1,s1) -> do
                (cont, s2) <-
-                  Maybe.resolve (next nextParameter s1)
+                  MaybeCont.resolve (next c s1)
                      (return (valueOf False, s1))
                      (\(_a,s) -> return (valueOf True, s))
                i2 <- A.dec i1
                return (cont, i2, s2))
-      return s3)
+      return (c, s3))
+   stop
    (\p -> do
-      (ioContext, (nextParam, startParam)) <- createIOContext p
-      return (ioContext, (nextParam,
-         (nextParam, Param.get n32 p, startParam))))
+      (ioContext, param) <- createIOContext p
+      return (ioContext, (param, getN p)))
    deleteIOContext
 
 {- |
@@ -170,40 +145,64 @@
 {-
 We might save a little space by using a union
 for the states of the first and the second signal generator.
+If the concatenated generators allocate memory,
+we could also save some memory by calling @startB@
+only after the first generator finished.
+However, for correct deallocation
+we would need to track which of the @start@ blocks
+have been executed so far.
+This in turn might be difficult in connection with the garbage collector.
 -}
 append ::
    (Loop.Phi a, Undefined a) =>
    T p a -> T p a -> T p a
 append
-      (Cons nextA startA createIOContextA deleteIOContextA)
-      (Cons nextB startB createIOContextB deleteIOContextB) =
+      (Cons nextA startA stopA createIOContextA deleteIOContextA)
+      (Cons nextB startB stopB createIOContextB deleteIOContextB) =
    Cons
-      (\(parameterA, parameterB) (firstPart,(sa0,sb0)) ->
-            Maybe.fromBool $ do
-         (contA, (a,sa1)) <-
-            ifThen firstPart (valueOf False, (undefTuple,sa0))
-               (Maybe.toBool $ nextA parameterA sa0)
-         secondPart <- inv contA
-         (contB, (b,sb1)) <-
-            ifThen secondPart (valueOf True, (a,sb0))
-               (Maybe.toBool $ nextB parameterB sb0)
-         return (contB, (b, (contA, (sa1,sb1)))))
-      (\(parameterA, parameterB) ->
-         fmap ((,) (valueOf True)) $
-         liftM2 (,)
-            (startA parameterA)
-            (startB parameterB))
-      (\p -> do
-         (ca,(nextParamA,startParamA)) <- createIOContextA p
-         (cb,(nextParamB,startParamB)) <- createIOContextB p
-         return ((ca,cb),
-            ((nextParamA, nextParamB),
-             (startParamA, startParamB))))
-      (\(ca,cb) ->
-         deleteIOContextA ca >>
-         deleteIOContextB cb)
+      (\parameterB ecs0 -> MaybeCont.fromMaybe $ do
+         ecs1 <-
+            Either.run ecs0
+               (\(ca, sa0) ->
+                  MaybeCont.resolve
+                     (nextA ca sa0)
+                     (fmap Either.right $ startB parameterB)
+                     (\(a1,sa1) -> return (Either.left (a1, (ca, sa1)))))
+               (return . Either.right)
 
+         Either.run ecs1
+            (\(a1,cs1) ->
+               return (Maybe.just (a1, Either.left cs1)))
+            (\(cb,sb0) ->
+               MaybeCont.toMaybe $
+               fmap (\(b,sb1) -> (b, Either.right (cb,sb1))) $
+               nextB cb sb0))
+      (\(parameterA, parameterB) -> do
+         cs <- startA parameterA
+         return (parameterB, Either.left cs))
+      (\ _parameterB s -> Either.run s (uncurry stopA) (uncurry stopB))
+      (combineCreate createIOContextA createIOContextB)
+      (combineDelete deleteIOContextA deleteIOContextB)
 
+cycle ::
+   (Loop.Phi a, Undefined a) =>
+   T p a -> T p a
+cycle (Cons next start stop createIOContext deleteIOContext) =
+   Cons
+      (\parameter (c0,s0) ->
+          MaybeCont.alternative
+             (fmap (mapSnd ((,) c0)) $ next c0 s0)
+             (do (c1,s1) <- MaybeCont.lift $ start parameter
+                 (b0,s2) <- next c1 s1
+                 return (b0,(c1,s2))))
+      (\parameter -> do
+         contextState <- start parameter
+         return (parameter, contextState))
+      (\_parameter contextState -> uncurry stop contextState)
+      createIOContext
+      deleteIOContext
+
+
 -- * signal modifiers
 
 {- |
@@ -217,39 +216,18 @@
 -}
 interpolateConstant ::
    (Memory.C a,
-    Ring.C b,
-    IsFloating b, CmpRet b, CmpResult b ~ Bool,
-    Storable b, MakeValueTuple b, ValueTuple b ~ (Value b), IsConst b,
+    IsFloating b, SoV.IntegerConstant b, LLVM.CmpRet b, LLVM.CmpResult b ~ Bool,
+    Storable b, MakeValueTuple b, ValueTuple b ~ (Value b),
     Memory.FirstClass b, IsSized b, IsSized (Memory.Stored b)) =>
    Param.T p b -> T p a -> T p a
 interpolateConstant k
-      (Cons next start createIOContext deleteIOContext) =
-   Cons
-      (\(kl,parameter) yState0 -> do
-         ((y1,state1), ss1) <-
-            Maybe.fromBool $
-            whileLoop
-               (valueOf True, yState0)
-               (\(cont1, (_, ss1)) ->
-                  and cont1 =<< A.fcmp FPOLE ss1 (value LLVM.zero))
-               (\(_,((_,state01), ss1)) ->
-                  Maybe.toBool $ liftM2 (,)
-                     (next parameter state01)
-                     (Maybe.lift $ A.add ss1 (Param.value k kl)))
-
-         ss2 <- Maybe.lift $ A.sub ss1 (valueOf Ring.one)
-         return (y1, ((y1,state1),ss2)))
-
-{- using this initialization code we would not need undefined values
-      (do sa <- start
-          (a,_) <- next sa
-          return (sa, a, valueOf 0))
--}
-      (fmap (\sa -> ((undefTuple, sa), value LLVM.zero)) . start)
-      (\p -> do
-         (ioContext, (nextParam, startParam)) <- createIOContext p
-         return (ioContext, ((Param.get k p, nextParam), startParam)))
-      deleteIOContext
+      (Cons next start stop createIOContext deleteIOContext) =
+   Param.with k $ \getK valueK -> Cons
+      (quantizeNext next valueK)
+      (quantizeStart start)
+      (quantizeStop stop)
+      (quantizeCreate createIOContext getK)
+      (quantizeDelete deleteIOContext)
 
 
 
@@ -296,9 +274,8 @@
 constant x =
    simple
       (\pl () -> return (pl, ()))
-      return
+      (return . flip (,) ())
       x
-      (return ())
 
 
 exponentialCore ::
@@ -390,7 +367,7 @@
     Memory.C al, A.Additive al, A.IntegerConstant al) =>
    Param.T p a -> Param.T p a -> Param.T p a -> T p al
 parabolaCore d2 d1 start =
-   Causal.apply (Causal.integrate start) $
+   CausalP.apply (CausalP.integrate start) $
    rampCore d2 d1
 
 
@@ -437,25 +414,25 @@
    Param.T p a -> T p al
 
 ramp dur =
-   Causal.apply (Causal.take (fmap round dur)) $
+   CausalP.apply (CausalP.take (fmap round dur)) $
    rampInf dur
 
 parabolaFadeIn dur =
-   Causal.apply (Causal.take (fmap round dur)) $
+   CausalP.apply (CausalP.take (fmap round dur)) $
    parabolaFadeInInf dur
 
 parabolaFadeOut dur =
-   Causal.apply (Causal.take (fmap round dur)) $
+   CausalP.apply (CausalP.take (fmap round dur)) $
    parabolaFadeOutInf dur
 
 parabolaFadeInMap dur =
    -- t*(2-t)
-   Causal.apply (Causal.mapSimple (\t -> A.mul t =<< A.sub (A.fromInteger' 2) t)) $
+   CausalP.apply (CausalP.mapSimple (\t -> A.mul t =<< A.sub (A.fromInteger' 2) t)) $
    ramp dur
 
 parabolaFadeOutMap dur =
    -- 1-t^2
-   Causal.apply (Causal.mapSimple (\t -> A.sub (A.fromInteger' 1) =<< A.mul t t)) $
+   CausalP.apply (CausalP.mapSimple (\t -> A.sub (A.fromInteger' 1) =<< A.mul t t)) $
    ramp dur
 
 
@@ -478,7 +455,7 @@
 -}
 noise ::
    (Algebraic.C a, IsFloating a, IsConst a,
-    NumberOfElements a ~ TypeNum.D1,
+    LLVM.NumberOfElements a ~ TypeNum.D1,
     Memory.C (Value a),
     IsSized a, MakeValueTuple a, ValueTuple a ~ (Value a), Storable a) =>
    Param.T p Word32 ->
@@ -526,19 +503,17 @@
 fromStorableVector selectVec =
    Cons
       (\() (p0,l0) -> do
-         cont <- Maybe.lift $ A.cmp CmpGT l0 (valueOf 0)
-         Maybe.withBool cont $ do
+         cont <- MaybeCont.lift $ A.cmp LLVM.CmpGT l0 A.zero
+         MaybeCont.withBool cont $ do
             y1 <- Memory.load p0
             p1 <- advanceArrayElementPtr p0
             l1 <- A.dec l0
             return (y1,(p1,l1)))
-      return
+      (return . (,) ())
+      (\() _ -> return ())
       (\p ->
-         let (fp,s,l) = SVB.toForeignPtr $ Param.get selectVec p
-         in  return (fp,
-                ((),
-                 (Memory.castStorablePtr $ Unsafe.foreignPtrToPtr fp `advancePtr` s,
-                  fromIntegral l :: Word32))))
+         let (fp,ptr,l) = SVU.unsafeToPointers $ Param.get selectVec p
+         in  return (fp, (ptr, fromIntegral l :: Word32)))
       -- keep the foreign ptr alive
       touchForeignPtr
 
@@ -553,27 +528,27 @@
    T p value
 fromStorableVectorLazy sig =
    Cons
-      (\(stable, lenPtr) (buffer0,length0) -> do
-         (buffer1,length1) <- Maybe.lift $ do
-            nextChunkFn <- staticFunction ChunkIt.nextCallBack
-            needNext <- A.cmp CmpEQ length0 (valueOf 0)
+      (\stable (buffer0,length0) -> do
+         (buffer1,length1) <- MaybeCont.lift $ do
+            nextChunkFn <- LLVM.staticFunction ChunkIt.nextCallBack
+            needNext <- A.cmp LLVM.CmpEQ length0 A.zero
             ifThen needNext (buffer0,length0)
-               (liftM2 (,)
-                   (call nextChunkFn stable lenPtr)
-                   (load lenPtr))
-         valid <- Maybe.lift $ A.cmp CmpNE buffer1 (valueOf nullPtr)
-         Maybe.withBool valid $ do
+               (do lenPtr <- LLVM.alloca
+                   liftM2 (,)
+                      (LLVM.call nextChunkFn stable lenPtr)
+                      (LLVM.load lenPtr))
+         valid <- MaybeCont.lift $ A.cmp LLVM.CmpNE buffer1 (valueOf nullPtr)
+         MaybeCont.withBool valid $ do
             x <- Memory.load buffer1
             buffer2 <- advanceArrayElementPtr buffer1
             length2 <- A.dec length1
             return (x, (buffer2,length2)))
-      (\() -> return (valueOf nullPtr, valueOf 0))
+      (\s -> return (s, (valueOf nullPtr, A.zero)))
+      (\ _s _ -> return ())
       (\p -> do
-          s <- liftM2 (,) (ChunkIt.new (Param.get sig p)) Alloc.malloc
-          return (s, (s,())))
-      (\(stable,lenPtr) -> do
-          ChunkIt.dispose stable
-          Alloc.free lenPtr)
+          s <- ChunkIt.new (Param.get sig p)
+          return (s, s))
+      ChunkIt.dispose
 
 
 
@@ -605,19 +580,20 @@
    (Storable a, MakeValueTuple a, ValueTuple a ~ value, Memory.C value) =>
    T p value ->
    IO (Int -> p -> SV.Vector a)
-run (Cons next start createIOContext deleteIOContext) =
+run (Cons next start stop createIOContext deleteIOContext) =
    do -- this compiles once and is much faster than simpleFunction
       fill <-
          fmap derefFillPtr .
          Exec.compileModule .
          createNamedFunction ExternalLinkage "fillsignalblock" $
          \paramPtr size bPtr -> do
-            (nextParam,startParam) <- Memory.load paramPtr
-            s <- start startParam
-            (pos,_) <- Maybe.arrayLoop size bPtr s $ \ ptri s0 -> do
-               (y,s1) <- next nextParam s0
-               Maybe.lift $ Memory.store y ptri
+            param <- Memory.load paramPtr
+            (c,s) <- start param
+            (pos,se) <- MaybeCont.arrayLoop size bPtr s $ \ ptri s0 -> do
+               (y,s1) <- next c s0
+               MaybeCont.lift $ Memory.store y ptri
                return s1
+            Maybe.for se $ stop c
             ret (pos :: Value Word32)
 
       return $ \len p ->
@@ -640,80 +616,85 @@
 
 
 foreign import ccall safe "dynamic" derefChunkPtr ::
-   Exec.Importer (Ptr nextParamStruct -> Ptr stateStruct -> Word32 -> Ptr struct -> IO Word32)
+   Exec.Importer (Ptr contextStateStruct -> Word32 -> Ptr struct -> IO Word32)
 
 
 moduleChunky ::
    (Memory.C value, Memory.Struct value ~ struct,
-    Memory.C state, Memory.Struct state ~ stateStruct,
-    Memory.C startParamValue, Memory.Struct startParamValue ~ startParamStruct,
-    Memory.C nextParamValue,  Memory.Struct nextParamValue ~ nextParamStruct) =>
+    Memory.C parameters, Memory.Struct parameters ~ paramStruct,
+    Memory.C context, Memory.C state,
+    Memory.Struct (context, Maybe.T state) ~ contextStateStruct) =>
+   (forall r z.
+    (Loop.Phi z) =>
+    context -> state -> MaybeCont.T r z (value, state)) ->
    (forall r.
-    nextParamValue ->
-    state -> Maybe.T r (Value Bool, state) (value, state)) ->
+    parameters -> CodeGenFunction r (context, state)) ->
    (forall r.
-    startParamValue ->
-    CodeGenFunction r state) ->
+    context -> state -> CodeGenFunction r ()) ->
    CodeGenModule
-      (Function (Ptr startParamStruct -> IO (Ptr stateStruct)),
-       Function (Ptr stateStruct -> IO ()),
-       Function (Ptr nextParamStruct -> Ptr stateStruct -> Word32 -> Ptr struct -> IO Word32))
-moduleChunky next start = liftM3 (,,)
+      (Function (Ptr paramStruct -> IO (Ptr contextStateStruct)),
+       Function (Ptr contextStateStruct -> IO ()),
+       Function (Ptr contextStateStruct ->
+                 Word32 -> Ptr struct -> IO Word32))
+moduleChunky next start stop = liftM3 (,,)
    (createNamedFunction ExternalLinkage "startsignal" $
     \paramPtr -> do
        pptr <- LLVM.malloc
-       flip Memory.store pptr =<< start =<< Memory.load paramPtr
+       flip Memory.store pptr . mapSnd Maybe.just =<< start =<< Memory.load paramPtr
        ret pptr)
    (createNamedFunction ExternalLinkage "stopsignal" $
-    \ pptr -> LLVM.free pptr >> ret ())
+    \ contextStatePtr -> do
+       (c,ms) <- Memory.load contextStatePtr
+       Maybe.for ms $ stop c
+       LLVM.free contextStatePtr
+       ret ())
    (createNamedFunction ExternalLinkage "fillsignal" $
-    \ paramPtr sptr loopLen ptr -> do
-       param <- Memory.load paramPtr
-       sInit <- Memory.load sptr
-       (pos,sExit) <- Maybe.arrayLoop loopLen ptr sInit $ \ ptri s0 -> do
-          (y,s1) <- next param s0
-          Maybe.lift $ Memory.store y ptri
+    \ contextStatePtr loopLen ptr -> do
+       (context, msInit) <- Memory.load contextStatePtr
+       (pos,msExit) <-
+          Maybe.run msInit (return (A.zero, Maybe.nothing)) $ \sInit ->
+             MaybeCont.arrayLoop loopLen ptr sInit $ \ ptri s0 -> do
+          (y,s1) <- next context s0
+          MaybeCont.lift $ Memory.store y ptri
           return s1
-       Memory.store sExit sptr
+       sptr <- LLVM.getElementPtr0 contextStatePtr (TypeNum.d1, ())
+       Memory.store msExit sptr
        ret (pos :: Value Word32))
 
 compileChunky ::
    (Memory.C value, Memory.Struct value ~ struct,
-    Memory.C state, Memory.Struct state ~ stateStruct,
-    Memory.C startParamValue, Memory.Struct startParamValue ~ startParamStruct,
-    Memory.C nextParamValue,  Memory.Struct nextParamValue ~ nextParamStruct) =>
+    Memory.C parameters, Memory.Struct parameters ~ paramStruct,
+    Memory.C context, Memory.C state,
+    Memory.Struct (context, Maybe.T state) ~ contextStateStruct) =>
+   (forall r z.
+    (Loop.Phi z) =>
+    context -> state -> MaybeCont.T r z (value, state)) ->
    (forall r.
-    nextParamValue ->
-    state -> Maybe.T r (Value Bool, state) (value, state)) ->
+    parameters -> CodeGenFunction r (context, state)) ->
    (forall r.
-    startParamValue ->
-    CodeGenFunction r state) ->
-   IO (FunPtr (Ptr startParamStruct -> IO (Ptr stateStruct)),
-       FunPtr (Ptr stateStruct -> IO ()),
-       FunPtr (Ptr nextParamStruct -> Ptr stateStruct -> Word32 -> Ptr struct -> IO Word32))
-compileChunky next start =
-   Exec.compileModule $ moduleChunky next start
+    context -> state -> CodeGenFunction r ()) ->
+   IO (FunPtr (Ptr paramStruct -> IO (Ptr contextStateStruct)),
+       FunPtr (Ptr contextStateStruct -> IO ()),
+       FunPtr (Ptr contextStateStruct ->
+               Word32 -> Ptr struct -> IO Word32))
+compileChunky next start stop =
+   Exec.compileModule $ moduleChunky next start stop
 
 debugMain ::
-   forall
-      struct stateStruct
-      startParamValue startParamStruct
-      nextParamValue  nextParamStruct.
-   (Storable startParamValue,
-    Storable nextParamValue,
+   forall parameters struct paramStruct contextStateStruct.
+   (Storable parameters,
     LLVM.IsType struct,
-    LLVM.IsType stateStruct,
-    LLVM.IsType startParamStruct,
-    LLVM.IsType nextParamStruct,
-    IsSized    startParamStruct,
-    IsSized    nextParamStruct) =>
+    LLVM.IsType contextStateStruct,
+    LLVM.IsType paramStruct,
+    IsSized    paramStruct) =>
    CodeGenModule
-      (Function (Ptr startParamStruct -> IO (Ptr stateStruct)),
-       Function (Ptr stateStruct -> IO ()),
-       Function (Ptr nextParamStruct -> Ptr stateStruct -> Word32 -> Ptr struct -> IO Word32)) ->
-   (nextParamValue, startParamValue) ->
+      (Function (Ptr paramStruct -> IO (Ptr contextStateStruct)),
+       Function (Ptr contextStateStruct -> IO ()),
+       Function (Ptr contextStateStruct ->
+                 Word32 -> Ptr struct -> IO Word32)) ->
+   parameters ->
    IO (Function (Word32 -> Ptr (Ptr Word8) -> IO Word32))
-debugMain sigModule (nextParam, startParam) = do
+debugMain sigModule params = do
 {-
 This does not work, since we cannot add (Mul n D32 s) constraint
 to the function argument in reifyIntegral.
@@ -723,39 +704,33 @@
          LLVM.store (value arr) ptr
          LLVM.bitcast ptr)
 -}
-   nextArray <-
-      DebugSt.withConstArray nextParam (\arr -> do
-         ptr <- LLVM.alloca
-         LLVM.store (value arr) =<< LLVM.bitcast ptr
-         return ptr)
-   startArray <-
-      DebugSt.withConstArray startParam (\arr -> do
+   paramArray <-
+      DebugSt.withConstArray params (\arr -> do
          ptr <- LLVM.alloca
          LLVM.store (value arr) =<< LLVM.bitcast ptr
          return ptr)
 
    m <- LLVM.newModule
 
-   mainFunc <- defineModule m (do
+   mainFunc <- LLVM.defineModule m (do
       mallocBytes <- LLVM.newNamedFunction ExternalLinkage "malloc" ::
          LLVM.TFunction (Ptr Word8 -> IO (Ptr struct))
       (start, stop, fill) <- sigModule
       createNamedFunction ExternalLinkage "main" $ \ _argc _argv -> do
-         state <- LLVM.call start =<< startArray
+         contextState <- LLVM.call start =<< paramArray
          let chunkSize = LLVM.valueOf 100000
              basePtr = LLVM.valueOf nullPtr
          buffer <-
             LLVM.call mallocBytes =<<
             LLVM.bitcast =<<
             LLVM.getElementPtr basePtr (chunkSize, ())
-         nextPtr <- nextArray
          _done <-
-            LLVM.call fill nextPtr state chunkSize (asTypeOf buffer basePtr)
-         _ <- LLVM.call stop state
-         ret (LLVM.value LLVM.zero :: LLVM.Value Word32))
+            LLVM.call fill contextState chunkSize (asTypeOf buffer basePtr)
+         _ <- LLVM.call stop contextState
+         ret (A.zero :: LLVM.Value Word32))
 
    Counter.with Exec.counter $ R.ReaderT $ \cnt -> do
-      writeBitcodeToFile ("main" ++ Counter.format 3 cnt ++ ".bc") m
+      LLVM.writeBitcodeToFile ("main" ++ Counter.format 3 cnt ++ ".bc") m
 
    return mainFunc
 
@@ -770,25 +745,26 @@
    (Storable a, MakeValueTuple a, ValueTuple a ~ value, Memory.C value) =>
    T p value ->
    IO (SVP.LazySize -> p -> SVL.Vector a)
-runChunkyPattern (Cons next start createIOContext deleteIOContext) = do
-   (startFunc, stopFunc, fill) <- compileChunky next start
+runChunkyPattern (Cons next start stop createIOContext deleteIOContext) = do
+   (startFunc, stopFunc, fill) <- compileChunky next start stop
    return $
       \ lazysize p -> SVL.fromChunks $ Unsafe.performIO $ do
-         (ioContext, (nextParam, startParam)) <- createIOContext p
+         (ioContext, param) <- createIOContext p
 
 {-
          putStr "nextParam: "
          DebugSt.format nextParam >>= putStrLn
 -}
          when False $ Counter.with DebugSt.dumpCounter $ do
-            DebugSt.dump "next-param" nextParam
-            DebugSt.dump "start-param" startParam
+            DebugSt.dump "param" param
 
          when False $ void $
-            debugMain (moduleChunky next start) (nextParam, startParam)
+            debugMain (moduleChunky next start stop) param
 
-         statePtr <- ForeignPtr.newParam stopFunc startFunc startParam
-         nextParamPtr <- ForeignPtr.new (deleteIOContext ioContext) nextParam
+         statePtr <- ForeignPtr.newParam stopFunc startFunc param
+         concStatePtr <-
+            withForeignPtr statePtr $
+            flip FC.newForeignPtr (deleteIOContext ioContext)
 
          let go cs =
                 Unsafe.interleaveIO $
@@ -797,11 +773,11 @@
                    SVL.ChunkSize size : rest -> do
                       v <-
                          withForeignPtr statePtr $ \sptr ->
-                         ForeignPtr.with nextParamPtr $ \nptr ->
                          SVB.createAndTrim size $
                          fmap fromIntegral .
-                         derefChunkPtr fill nptr sptr (fromIntegral size) .
+                         derefChunkPtr fill sptr (fromIntegral size) .
                          Memory.castStorablePtr
+                      touchForeignPtr concStatePtr
                       (if SV.length v > 0
                          then fmap (v:)
                          else id) $
diff --git a/src/Synthesizer/LLVM/Parameterized/SignalPacked.hs b/src/Synthesizer/LLVM/Parameterized/SignalPacked.hs
--- a/src/Synthesizer/LLVM/Parameterized/SignalPacked.hs
+++ b/src/Synthesizer/LLVM/Parameterized/SignalPacked.hs
@@ -24,6 +24,7 @@
 module Synthesizer.LLVM.Parameterized.SignalPacked where
 
 import Synthesizer.LLVM.Parameterized.Signal (T(Cons), )
+import Synthesizer.LLVM.Parameterized.SignalPrivate (withStart, )
 import qualified Synthesizer.LLVM.Parameterized.Signal as Sig
 import qualified Synthesizer.LLVM.Parameter as Param
 import qualified Synthesizer.LLVM.Frame.SerialVector as Serial
@@ -35,13 +36,16 @@
 import qualified LLVM.Extra.MaybeContinuation as Maybe
 import qualified LLVM.Extra.Control as U
 import qualified LLVM.Extra.Arithmetic as A
-import LLVM.Extra.Class (MakeValueTuple, ValueTuple, Undefined, undefTuple, )
+import LLVM.Extra.Class (MakeValueTuple, ValueTuple, undefTuple, )
 
-import qualified Types.Data.Bool as TypeBool
 import qualified Types.Data.Num as TypeNum
 import Types.Data.Num ((:*:), )
 
-import LLVM.Core as LLVM
+import qualified LLVM.Core as LLVM
+import LLVM.Core
+          (CodeGenFunction, Value, valueOf,
+           IsSized, IsConst, IsArithmetic, IsFloating,
+           IsPrimitive, Vector, SizeOf, )
 
 import qualified Control.Monad.Trans.Class as MT
 import qualified Control.Monad.Trans.State as MS
@@ -77,7 +81,7 @@
    T p a -> T p v
 pack = packRotate
 
-packRotate (Cons next start createIOContext deleteIOContext) = Cons
+packRotate (Cons next start stop createIOContext deleteIOContext) = Cons
    (\param s -> do
       wInit <- Maybe.lift $ Serial.writeStart
       (w2,_,s2) <-
@@ -89,7 +93,7 @@
               s))
             (\(cont,(_w0,i0,_s0)) ->
                A.and cont =<<
-                  A.cmp CmpGT i0 (value LLVM.zero))
+                  A.cmp LLVM.CmpGT i0 A.zero)
             (\(_,(w0,i0,s0)) -> Maybe.toBool $ do
                (a,s1) <- next param s0
                Maybe.lift $ do
@@ -99,6 +103,7 @@
       v <- Maybe.lift $ Serial.writeStop w2
       return (v, s2))
    start
+   stop
    createIOContext
    deleteIOContext
 
@@ -116,10 +121,10 @@
       (v2,_,s2) <-
          Maybe.fromBool $
          U.whileLoop
-            (valueOf True, (undefTuple, value LLVM.zero, s))
+            (valueOf True, (undefTuple, A.zero, s))
             (\(cont,(v0,i0,_s0)) ->
                A.and cont =<<
-                  A.cmp CmpLT i0
+                  A.cmp LLVM.CmpLT i0
                      (valueOf $ fromIntegral $ Serial.size v0))
             (\(_,(v0,i0,s0)) -> Maybe.toBool $ do
                (a,s1) <- next param s0
@@ -143,7 +148,7 @@
 packSmall ::
    (Serial.C v, a ~ Serial.Element v) =>
    T p a -> T p v
-packSmall (Cons next start createIOContext deleteIOContext) = Cons
+packSmall (Cons next start stop createIOContext deleteIOContext) = Cons
    (\param ->
       MS.runStateT $
       case undefined of
@@ -153,6 +158,7 @@
             =<<
             replicateM (Serial.size vundef) (MS.StateT $ next param))
    start
+   stop
    createIOContext
    deleteIOContext
 
@@ -162,23 +168,22 @@
    T p v -> T p a
 unpack = unpackRotate
 
-unpackRotate (Cons next start createIOContext deleteIOContext) = Cons
-   (\param (i0,r0,s0) -> do
+unpackRotate (Cons next start stop createIOContext deleteIOContext) = Cons
+   (\context (i0,r0,s0) -> do
       endOfVector <-
-         Maybe.lift $ A.cmp CmpEQ i0 (valueOf (0::Word32))
+         Maybe.lift $ A.cmp LLVM.CmpEQ i0 (valueOf (0::Word32))
       (i2,r2,s2) <-
          Maybe.fromBool $
          U.ifThen endOfVector (valueOf True, (i0,r0,s0)) $ do
-            (cont1, (v1,s1)) <- Maybe.toBool $ next param s0
+            (cont1, (v1,s1)) <- Maybe.toBool $ next context s0
             r1 <- Serial.readStart v1
             return (cont1, (valueOf $ fromIntegral $ Serial.size v1, r1, s1))
       Maybe.lift $ do
          (a,r3) <- Serial.readNext r2
          i3 <- A.dec i2
          return (a, (i3,r3,s2)))
-   (\p -> do
-      s <- start p
-      return (valueOf 0, undefTuple, s))
+   (withStart start $ \s -> return (A.zero, undefTuple, s))
+   (\context (_,_,state) -> stop context state)
    createIOContext
    deleteIOContext
 
@@ -195,13 +200,13 @@
 unpackIndex (Cons next start createIOContext deleteIOContext) = Cons
    (\param (i0,v0,s0) -> do
       endOfVector <-
-         Maybe.lift $ A.cmp CmpGE i0
+         Maybe.lift $ A.cmp LLVM.CmpGE i0
             (valueOf $ fromIntegral $ Serial.size v0)
       (i2,v2,s2) <-
          Maybe.fromBool $
          U.ifThen endOfVector (valueOf True, (i0,v0,s0)) $ do
             (cont1, (v1,s1)) <- Maybe.toBool $ next param s0
-            return (cont1, (value LLVM.zero, v1, s1))
+            return (cont1, (A.zero, v1, s1))
       Maybe.lift $ do
          a <- Vector.extract i2 v2
          i3 <- A.inc i2
@@ -221,7 +226,7 @@
 withSize f = f undefined
 
 withSizeRing ::
-   (Ring.C b, TypeNum.IntegerT n, TypeNum.IsPositive n ~ TypeBool.True) =>
+   (Ring.C b, TypeNum.IntegerT n, TypeNum.PositiveT n) =>
    (b -> T p (Serial.Value n a)) ->
    T p (Serial.Value n a)
 withSizeRing f =
@@ -229,14 +234,13 @@
 
 
 constant ::
-   (Storable a,  MakeValueTuple a, ValueTuple a ~ (Value a),
+   (Storable a, MakeValueTuple a, ValueTuple a ~ (Value a),
     IsConst a,
     Memory.FirstClass a, Memory.Stored a ~ am,
-    IsPrimitive a,  IsSized a, SizeOf a ~ as,
+    IsPrimitive a,
     IsPrimitive am, IsSized am, SizeOf am ~ amsize,
-    TypeNum.PositiveT (n :*: as),
     TypeNum.PositiveT (n :*: amsize),
-    TypeNum.IntegerT n, TypeNum.IsPositive n ~ TypeBool.True) =>
+    TypeNum.PositiveT n) =>
    Param.T p a -> T p (Serial.Value n a)
 constant x =
    Sig.constant (Serial.replicate ^<< x)
@@ -250,7 +254,7 @@
     IsPrimitive am, IsSized am, SizeOf am ~ amsize,
     TypeNum.PositiveT (n :*: as),
     TypeNum.PositiveT (n :*: amsize),
-    TypeNum.IntegerT n, TypeNum.IsPositive n ~ TypeBool.True) =>
+    TypeNum.IntegerT n, TypeNum.PositiveT n) =>
    Param.T p a -> Param.T p a -> T p (Serial.Value n a)
 exponential2 halfLife start = withSizeRing $ \n ->
    Sig.exponentialCore
@@ -267,7 +271,7 @@
     IsPrimitive am, IsSized am, SizeOf am ~ amsize,
     TypeNum.PositiveT (n :*: as),
     TypeNum.PositiveT (n :*: amsize),
-    TypeNum.IntegerT n, TypeNum.IsPositive n ~ TypeBool.True) =>
+    TypeNum.IntegerT n, TypeNum.PositiveT n) =>
    Param.T p a -> Param.T p a -> Param.T p a ->
    T p (Serial.Value n a)
 exponentialBounded2 bound halfLife start = withSizeRing $ \n ->
@@ -287,7 +291,7 @@
     TypeNum.PositiveT (n :*: tsize),
     TypeNum.PositiveT (n :*: tmsize),
     Vector.Real t, IsFloating t, RealField.C t, IsConst t,
-    TypeNum.IntegerT n, TypeNum.IsPositive n ~ TypeBool.True) =>
+    TypeNum.IntegerT n, TypeNum.PositiveT n) =>
    Param.T p t -> Param.T p t -> T p (Serial.Value n t)
 osciCore phase freq = withSizeRing $ \n ->
    Sig.osciCore
@@ -308,7 +312,7 @@
     TypeNum.PositiveT (n :*: tmsize),
     Memory.C cl,
     Vector.Real t, IsFloating t, RealField.C t, IsConst t,
-    TypeNum.IntegerT n, TypeNum.IsPositive n ~ TypeBool.True) =>
+    TypeNum.IntegerT n, TypeNum.PositiveT n) =>
    (forall r. cl -> Serial.Value n t -> CodeGenFunction r y) ->
    Param.T p c ->
    Param.T p t -> Param.T p t -> T p y
@@ -324,7 +328,7 @@
     TypeNum.PositiveT (n :*: tsize),
     TypeNum.PositiveT (n :*: tmsize),
     Vector.Real t, IsFloating t, RealField.C t, IsConst t,
-    TypeNum.IntegerT n, TypeNum.IsPositive n ~ TypeBool.True) =>
+    TypeNum.IntegerT n, TypeNum.PositiveT n) =>
    (forall r. Serial.Value n t -> CodeGenFunction r y) ->
    Param.T p t -> Param.T p t -> T p y
 osciSimple wave =
@@ -340,7 +344,7 @@
     TypeNum.PositiveT (n :*: as),
     TypeNum.PositiveT (n :*: amsize),
     IsArithmetic a, SoV.IntegerConstant a,
-    TypeNum.IntegerT n, TypeNum.IsPositive n ~ TypeBool.True) =>
+    TypeNum.IntegerT n, TypeNum.PositiveT n) =>
    Param.T p a -> T p (Serial.Value n a)
 rampSlope slope = withSizeRing $ \n ->
    Sig.rampCore
@@ -386,7 +390,7 @@
 -}
 noise ::
    (Algebraic.C a, IsFloating a, SoV.IntegerConstant a,
-    TypeNum.IntegerT n, TypeNum.IsPositive n ~ TypeBool.True,
+    TypeNum.IntegerT n, TypeNum.PositiveT n,
     TypeNum.PositiveT (n :*: TypeNum.D32),
     Memory.FirstClass a, Memory.Stored a ~ am,
     IsPrimitive a,  IsSized a, SizeOf a ~ as,
@@ -424,7 +428,7 @@
        CodeGenFunction r (Value (Vector n Int32)))
 
 noiseCore, noiseCoreAlt ::
-   (TypeNum.IntegerT n, TypeNum.IsPositive n ~ TypeBool.True,
+   (TypeNum.IntegerT n, TypeNum.PositiveT n,
     TypeNum.PositiveT (n :*: TypeNum.D32)) =>
    Param.T p Word32 ->
    T p (Serial.Value n Word32)
diff --git a/src/Synthesizer/LLVM/Parameterized/SignalPrivate.hs b/src/Synthesizer/LLVM/Parameterized/SignalPrivate.hs
--- a/src/Synthesizer/LLVM/Parameterized/SignalPrivate.hs
+++ b/src/Synthesizer/LLVM/Parameterized/SignalPrivate.hs
@@ -8,7 +8,11 @@
 import qualified Synthesizer.LLVM.Parameter as Param
 import qualified LLVM.Extra.MaybeContinuation as Maybe
 import qualified LLVM.Extra.Memory as Memory
+import qualified LLVM.Extra.Class as Class
+import qualified LLVM.Extra.ScalarOrVector as SoV
 import qualified LLVM.Extra.Arithmetic as A
+import qualified LLVM.Extra.Control as C
+import qualified LLVM.Core as LLVM
 
 import LLVM.Extra.Class (MakeValueTuple, ValueTuple, )
 import LLVM.Core (CodeGenFunction, )
@@ -18,6 +22,8 @@
 import Control.Monad (liftM2, )
 import Control.Applicative (Applicative, pure, (<*>), )
 
+import Data.Tuple.HT (mapFst)
+
 import Foreign.Storable.Tuple ()
 import Foreign.Storable (Storable, )
 
@@ -59,25 +65,30 @@
 Consider a signal algorithm, where the LFO frequency is a parameter.
 -}
 data T p a =
-   forall state ioContext startParamTuple nextParamTuple.
-      (Storable startParamTuple,
-       Storable nextParamTuple,
-       MakeValueTuple startParamTuple,
-       MakeValueTuple nextParamTuple,
-       Memory.C (ValueTuple startParamTuple),
-       Memory.C (ValueTuple nextParamTuple),
+   forall context state ioContext parameters.
+      (Storable parameters,
+       MakeValueTuple parameters,
+       Memory.C (ValueTuple parameters),
+       Memory.C context,
        Memory.C state) =>
    Cons
       (forall r c.
        (Phi c) =>
-       ValueTuple nextParamTuple ->
-       state -> Maybe.T r c (a, state))
+       context -> state -> Maybe.T r c (a, state))
           -- compute next value
       (forall r.
-       ValueTuple startParamTuple ->
-       CodeGenFunction r state)
-          -- initial state
-      (p -> IO (ioContext, (nextParamTuple, startParamTuple)))
+       ValueTuple parameters ->
+       CodeGenFunction r (context, state))
+          -- allocate initial state
+      (forall r.
+       context -> state ->
+       CodeGenFunction r ())
+          {- cleanup
+          You must make sure to call this
+          whenever you allocated context and state with the 'start' function.
+          You must call it with the latest state returned from the 'next' function.
+          -}
+      (p -> IO (ioContext, parameters))
           {- initialization from IO monad
           This will be run within Unsafe.performIO,
           so no observable In/Out actions please!
@@ -85,30 +96,72 @@
       (ioContext -> IO ())
           -- finalization from IO monad, also run within Unsafe.performIO
 
+
+withStart ::
+   (startParam -> CodeGenFunction r (context, state0)) ->
+   (state0 -> CodeGenFunction r state1) ->
+   startParam -> CodeGenFunction r (context, state1)
+withStart start act p = do
+   (c,s) <- start p
+   fmap ((,) c) $ act s
+
+combineStart ::
+   Monad m =>
+   (paramA -> m (contextA, stateA)) ->
+   (paramB -> m (contextB, stateB)) ->
+   (paramA, paramB) -> m ((contextA, contextB), (stateA, stateB))
+combineStart startA startB (paramA, paramB) =
+   liftM2
+      (\(ca,sa) (cb,sb) -> ((ca,cb), (sa,sb)))
+      (startA paramA)
+      (startB paramB)
+
+combineStop ::
+   Monad m =>
+   (contextA -> stateA -> m ()) ->
+   (contextB -> stateB -> m ()) ->
+   (contextA, contextB) -> (stateA, stateB) -> m ()
+combineStop stopA stopB (ca, cb) (sa, sb) =
+   stopA ca sa >> stopB cb sb
+
+combineCreate ::
+   Monad m =>
+   (p -> m (ioContextA, contextA)) ->
+   (p -> m (ioContextB, contextB)) ->
+   p -> m ((ioContextA, ioContextB), (contextA, contextB))
+combineCreate createIOContextA createIOContextB p = do
+   (ca,paramA) <- createIOContextA p
+   (cb,paramB) <- createIOContextB p
+   return ((ca,cb), (paramA,paramB))
+
+combineDelete ::
+   (Monad m) =>
+   (ca -> m ()) -> (cb -> m ()) -> (ca, cb) -> m ()
+combineDelete deleteIOContextA deleteIOContextB (ca,cb) =
+   deleteIOContextA ca >>
+   deleteIOContextB cb
+
+
+
 simple ::
-   (Storable startParamTuple,
-    Storable nextParamTuple,
-    MakeValueTuple startParamTuple,
-    MakeValueTuple nextParamTuple,
-    ValueTuple startParamTuple ~ startParamValue,
-    ValueTuple nextParamTuple ~ nextParamValue,
-    Memory.C startParamValue,
-    Memory.C nextParamValue,
+   (Storable parameters,
+    MakeValueTuple parameters,
+    Memory.C (ValueTuple parameters),
+    Memory.C context,
     Memory.C state) =>
    (forall r c.
     (Phi c) =>
-    nextParamValue ->
-    state -> Maybe.T r c (al, state)) ->
+    context -> state -> Maybe.T r c (al, state)) ->
    (forall r.
-    startParamValue ->
-    CodeGenFunction r state) ->
-   Param.T p nextParamTuple ->
-   Param.T p startParamTuple -> T p al
-simple f start selectParam initial = Cons
-   (f . Param.value selectParam)
-   (start . Param.value initial)
-   (return . (,) () . Param.get (selectParam &&& initial))
-   (const $ return ())
+    ValueTuple parameters ->
+    CodeGenFunction r (context, state)) ->
+   Param.T p parameters -> T p al
+simple f start param =
+   Param.with param $ \getParam valueParam -> Cons f
+      (start . valueParam)
+      (const $ const $ return ())
+      (return . (,) () . getParam)
+      (const $ return ())
 
 
 map ::
@@ -117,16 +170,18 @@
    Param.T p ph ->
    T p a -> T p b
 map f selectParamF
-      (Cons next start createIOContext deleteIOContext) =
-   Cons
+      (Cons next start stop createIOContext deleteIOContext) =
+   Param.with selectParamF $ \getParamF valueF -> Cons
       (\(parameterF, parameter) sa0 -> do
          (a,sa1) <- next parameter sa0
-         b <- Maybe.lift $ f (Param.value selectParamF parameterF) a
+         b <- Maybe.lift $ f (valueF parameterF) a
          return (b, sa1))
-      start
+      (\(parameterF, parameter) ->
+         fmap (mapFst ((,) parameterF)) $ start parameter)
+      (stop . snd)
       (\p -> do
-         (ioContext, (nextParam, startParam)) <- createIOContext p
-         return (ioContext, ((Param.get selectParamF p, nextParam), startParam)))
+         (ioContext, param) <- createIOContext p
+         return (ioContext, (getParamF p, param)))
       deleteIOContext
 
 mapSimple ::
@@ -141,27 +196,26 @@
    Param.T p ph ->
    T p a -> T p b -> T p c
 zipWith f selectParamF
-      (Cons nextA startA createIOContextA deleteIOContextA)
-      (Cons nextB startB createIOContextB deleteIOContextB) =
-   Cons
+      (Cons nextA startA stopA createIOContextA deleteIOContextA)
+      (Cons nextB startB stopB createIOContextB deleteIOContextB) =
+   Param.with selectParamF $ \getParamF valueParamF -> Cons
       (\(parameterF, (parameterA, parameterB)) (sa0,sb0) -> do
-         (a,sa1) <- nextA parameterA sa0
-         (b,sb1) <- nextB parameterB sb0
-         c <- Maybe.lift $ f (Param.value selectParamF parameterF) a b
+         (a,sa1) <-
+            Maybe.onFail (stopB parameterB sb0) $
+            nextA parameterA sa0
+         (b,sb1) <-
+            Maybe.onFail (stopA parameterA sa1) $
+            nextB parameterB sb0
+         c <- Maybe.lift $ f (valueParamF parameterF) a b
          return (c, (sa1,sb1)))
-      (\(parameterA, parameterB) ->
-         liftM2 (,)
-            (startA parameterA)
-            (startB parameterB))
+      (\(parameterF, parameter) ->
+         fmap (mapFst ((,) parameterF)) $
+         combineStart startA startB parameter)
+      (combineStop stopA stopB . snd)
       (\p -> do
-         (ca,(nextParamA,startParamA)) <- createIOContextA p
-         (cb,(nextParamB,startParamB)) <- createIOContextB p
-         return ((ca,cb),
-            ((Param.get selectParamF p, (nextParamA,  nextParamB)),
-             (startParamA, startParamB))))
-      (\(ca,cb) ->
-         deleteIOContextA ca >>
-         deleteIOContextB cb)
+         (c,param) <- combineCreate createIOContextA createIOContextB p
+         return (c, (getParamF p, param)))
+      (combineDelete deleteIOContextA deleteIOContextB)
 
 zipWithSimple ::
    (forall r. a -> b -> CodeGenFunction r c) ->
@@ -180,8 +234,7 @@
    pure x =
       simple
          (\() () -> return (x, ()))
-         return
-         (return ())
+         (\() -> return ((),()))
          (return ())
    (<*>) = zipWithSimple (\f a -> return (f a))
 
@@ -222,9 +275,64 @@
    (forall r. pl -> al -> CodeGenFunction r al) ->
    Param.T p ph ->
    Param.T p a -> T p al
-iterate f selectParam initial = simple
+iterate f param initial = simple
    (\pl al0 ->
       Maybe.lift $ fmap (\al1 -> (al0,al1)) (f pl al0))
    return
-   selectParam
-   initial
+   (param &&& initial)
+
+
+quantizeNext ::
+   (LLVM.IsFloating a, LLVM.CmpRet a, LLVM.CmpResult a ~ Bool,
+    SoV.IntegerConstant a, Phi z,
+    Class.Undefined y, Phi y,
+    Class.Undefined state, Phi state) =>
+   (forall zn. Phi zn => context -> state -> Maybe.T r zn (y, state)) ->
+   (valueA -> LLVM.Value a) ->
+   (valueA, context) ->
+   ((y, state), LLVM.Value a) ->
+   Maybe.T r z (y, ((y, state), LLVM.Value a))
+quantizeNext next valueK (kl,context) yState0 = do
+   ((y1,state1), frac1) <-
+      Maybe.fromBool $
+      C.whileLoop
+         (LLVM.valueOf True, yState0)
+         (\(cont1, (_, frac0)) ->
+            LLVM.and cont1 =<< A.fcmp LLVM.FPOLE frac0 A.zero)
+         (\(_,((_,state01), frac0)) ->
+            Maybe.toBool $ liftM2 (,)
+               (next context state01)
+               (Maybe.lift $ A.add frac0 (valueK kl)))
+
+   frac2 <- Maybe.lift $ A.sub frac1 A.one
+   return (y1, ((y1,state1),frac2))
+
+quantizeStart ::
+   (Monad m, Class.Undefined y, A.Additive al) =>
+   (param -> m (context, state)) ->
+   (ap, param) -> m ((ap, context), ((y, state), al))
+{- using this initialization code we would not need undefined values
+   (do sa <- start
+       (a,_) <- next sa
+       return (sa, a, A.zero))
+-}
+quantizeStart start (kl,p) = do
+   (c,s) <- start p
+   return ((kl,c), ((Class.undefTuple, s), A.zero))
+
+quantizeStop ::
+   (context -> state -> m ()) ->
+   (ap, context) -> ((y, state), al) -> m ()
+quantizeStop stop (_kl,c) ((_, s), _) = stop c s
+
+quantizeCreate ::
+   Monad m =>
+   (p -> m (ioContext, param)) ->
+   (p -> ah) -> p -> m (ioContext, (ah, param))
+quantizeCreate createIOContext getK p = do
+   (ioContext, param) <- createIOContext p
+   return (ioContext, (getK p, param))
+
+quantizeDelete :: (ioContext -> m ()) -> (ioContext -> m ())
+quantizeDelete deleteIOContext =
+   deleteIOContext
diff --git a/src/Synthesizer/LLVM/Plug/Input.hs b/src/Synthesizer/LLVM/Plug/Input.hs
--- a/src/Synthesizer/LLVM/Plug/Input.hs
+++ b/src/Synthesizer/LLVM/Plug/Input.hs
@@ -34,16 +34,14 @@
 
 import qualified Numeric.NonNegative.Wrapper as NonNegW
 
+import qualified Synthesizer.LLVM.Storable.Vector as SVU
 import qualified Data.StorableVector as SV
-import qualified Data.StorableVector.Base as SVB
 
 import qualified Foreign.Marshal.Array as Array
 import qualified Foreign.Marshal.Alloc as Alloc
 import qualified Foreign.ForeignPtr as FPtr
 import Foreign.Storable (Storable, pokeElemOff, )
 
-import qualified System.Unsafe as Unsafe
-
 import Data.Word (Word32, )
 
 
@@ -168,10 +166,8 @@
             (A.advanceArrayElementPtr p))
       return
       (\vec ->
-         let (fp,s,_l) = SVB.toForeignPtr vec
-         in  return (fp,
-                Memory.castStorablePtr $
-                Unsafe.foreignPtrToPtr fp `Array.advancePtr` s))
+         let (fp,ptr,_l) = SVU.unsafeToPointers vec
+         in  return (fp,ptr))
       -- keep the foreign ptr alive
       FPtr.touchForeignPtr
 
diff --git a/src/Synthesizer/LLVM/Plug/Output.hs b/src/Synthesizer/LLVM/Plug/Output.hs
--- a/src/Synthesizer/LLVM/Plug/Output.hs
+++ b/src/Synthesizer/LLVM/Plug/Output.hs
@@ -16,16 +16,14 @@
 
 import Control.Monad (liftM2, )
 
+import qualified Synthesizer.LLVM.Storable.Vector as SVU
 import qualified Data.StorableVector as SV
 import qualified Data.StorableVector.Base as SVB
 
-import qualified Foreign.Marshal.Array as Array
 import qualified Foreign.ForeignPtr as FPtr
 import Foreign.Storable.Tuple ()
 import Foreign.Storable (Storable, )
 
-import qualified System.Unsafe as Unsafe
-
 import NumericPrelude.Numeric
 import NumericPrelude.Base hiding (and, iterate, map, zip, zipWith, take, takeWhile, )
 
@@ -107,11 +105,9 @@
    return
    (\len -> do
       vec <- SVB.create len (const $ return ())
-      -- s should be always zero, but we must not rely on that
-      let (fp,s,_l) = SVB.toForeignPtr vec
-      return (vec,
-         Memory.castStorablePtr $
-         Unsafe.foreignPtrToPtr fp `Array.advancePtr` s))
+      -- offset should be always zero, but we must not rely on that
+      let (_fp,ptr,_l) = SVU.unsafeToPointers vec
+      return (vec, ptr))
    (\len vec -> do
       let (fp,_s,_l) = SVB.toForeignPtr vec
       -- keep the foreign ptr alive
diff --git a/src/Synthesizer/LLVM/Random.hs b/src/Synthesizer/LLVM/Random.hs
--- a/src/Synthesizer/LLVM/Random.hs
+++ b/src/Synthesizer/LLVM/Random.hs
@@ -19,7 +19,6 @@
            zext, trunc, lshr, value, valueOf, vector,
            undef, constOf, constVector, bitcast, )
 import qualified LLVM.Core as LLVM
-import qualified Types.Data.Bool as TypeBool
 import qualified Types.Data.Num as TypeNum
 
 import Data.Function.HT (nest, )
@@ -63,8 +62,8 @@
 
 nextCG32 :: Value Word32 -> CodeGenFunction r (Value Word32)
 nextCG32 s = do
-   sHigh <- A.mul (valueOf splitRem) =<< LLVM.idiv s split
-   sLow  <- A.mul (valueOf factor)   =<< LLVM.irem s split
+   sHigh <- A.mul (valueOf splitRem) =<< LLVM.idiv s (valueOf split)
+   sLow  <- A.mul (valueOf factor)   =<< LLVM.irem s (valueOf split)
    flip A.irem (valueOf modulus) =<< A.add sHigh sLow
 
 nextCG64 :: Value Word32 -> CodeGenFunction r (Value Word32)
@@ -121,7 +120,7 @@
    fromIntegral $ nest n next 1
 
 vectorSeed ::
-   (TypeNum.IntegerT n, TypeNum.IsPositive n ~ TypeBool.True) =>
+   (TypeNum.IntegerT n, TypeNum.PositiveT n) =>
    Word32 -> Vector n Word32
 vectorSeed seed =
    let n = Vector.size $ valueOf v
@@ -369,7 +368,7 @@
    Value (Vector n Int32) ->
    CodeGenFunction r (Value (Vector n Int32))
 selectNonNegativeGeneric x y = do
-   b <- A.cmp LLVM.CmpGE x (value LLVM.zero)
+   b <- A.cmp LLVM.CmpGE x A.zero
    Vector.select b x y
 
 
diff --git a/src/Synthesizer/LLVM/RingBuffer.hs b/src/Synthesizer/LLVM/RingBuffer.hs
--- a/src/Synthesizer/LLVM/RingBuffer.hs
+++ b/src/Synthesizer/LLVM/RingBuffer.hs
@@ -1,7 +1,7 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE TypeFamilies #-}
 module Synthesizer.LLVM.RingBuffer (
-   T, track,
+   T, track, trackConst,
    index, oldest,
    ) where
 
@@ -20,15 +20,22 @@
 import Data.Word (Word32, )
 import Foreign.Storable.Tuple ()
 import Foreign.Storable (Storable, )
-import qualified Synthesizer.LLVM.Alloc as Alloc
 import Foreign.Ptr (Ptr, )
 
 import Prelude hiding (length, )
 
 
-data T ap =
+{-
+I have chosen this type parameter
+in order make sure that you can only retrieve from the buffer
+what you have put into it.
+E.g. if you store a SerialVector in it,
+you can only load a SerialVector from it, but not a Vector,
+although both of them use the same type for storage.
+-}
+data T a =
    Cons {
-      buffer :: Value (Ptr ap),
+      buffer :: Value (Ptr (Memory.Struct a)),
       length :: Value Word32,
       current :: Value Word32,
       oldest_ :: Value Word32
@@ -38,10 +45,12 @@
 This function does not check for range violations.
 If the ring buffer was generated by @track initial time@,
 then the minimum index is zero and the maximum index is @time@.
+Index zero refers to the current sample
+and index @time@ refers to the oldest one.
 -}
 index ::
    (Memory.C a) =>
-   Value Word32 -> T (Memory.Struct a) -> CodeGenFunction r a
+   Value Word32 -> T a -> CodeGenFunction r a
 index i rb = do
    k <- flip A.irem (length rb) =<< A.add (current rb) i
    Memory.load =<< LLVM.getElementPtr (buffer rb) (k, ())
@@ -53,7 +62,7 @@
 -}
 oldest ::
    (Memory.C a) =>
-   T (Memory.Struct a) -> CodeGenFunction r a
+   T a -> CodeGenFunction r a
 oldest rb =
    Memory.load =<< LLVM.getElementPtr (buffer rb) (oldest_ rb, ())
 
@@ -70,40 +79,90 @@
 The initial value is also needed for determining the ring buffer element type.
 -}
 track ::
-   (Storable a,
-    Class.MakeValueTuple a, Class.ValueTuple a ~ al,
-    Memory.C al) =>
-   Param.T p a -> Param.T p Int -> CausalP.T p al (T (Memory.Struct al))
+   (Storable a, Class.MakeValueTuple a,
+    Class.ValueTuple a ~ al, Memory.C al) =>
+   Param.T p a -> Param.T p Int -> CausalP.T p al (T al)
 track initial time =
-   let time32 = fmap (fromIntegral :: Int -> Word32) time in
-   CausalP.Cons
-      (\(size,ptr) a remain0 -> Maybe.lift $ do
-         Memory.store a =<< LLVM.getElementPtr ptr (remain0, ())
-         cont <- A.cmp LLVM.CmpGT remain0 (LLVM.value LLVM.zero)
-         remain1 <-
-            C.ifThenSelect cont (Param.value time32 size)
-               (A.dec remain0)
-         size1 <- A.inc (Param.value time32 size)
-         return (Cons ptr size1 remain0 remain1, remain1))
-      (\(x, (size,ptr)) -> do
-         size1 <- A.inc (Param.value time32 size)
-         -- cf. LLVM.Storable.Signal.fill
-         C.arrayLoop size1 ptr () $ \ ptri () ->
-            Memory.store (Param.value initial x) ptri >> return ()
-         return size)
-      (\p -> do
-         let size = Param.get time p
-             x = Param.get initial p
-         {-
-         We allocate one element more than necessary
-         in order to simplify handling of delay time zero
-         -}
-         ptr <- Alloc.mallocArray (size+1)
-         let param =
-               (fromIntegral size :: Word32,
-                Memory.castStorablePtr (ptrAsTypeOf ptr x))
-         return ((size,ptr), (param, (x, param))))
-      (\(size,ptr) -> Alloc.freeArray (size + 1) ptr)
+   Param.with initial $ \getInitial valueInitial ->
+   Param.with (Param.word32 time) $ \getTime valueTime ->
+       CausalP.Cons
+          (trackNext valueTime)
+          (\(x, size) -> trackStart valueTime (valueInitial x, size))
+          trackStop
+          (trackCreate getInitial getTime)
+          trackDelete
 
-ptrAsTypeOf :: Ptr a -> a -> Ptr a
-ptrAsTypeOf p _ = p
+{- |
+Initialize with zero without the need of a Haskell zero value.
+
+We cannot get rid of the type 'a' so easily,
+because we need its Storable instance
+for allocating the buffer on the Haskell side.
+-}
+trackConst ::
+   (Memory.C al) =>
+   al -> Param.T p Int -> CausalP.T p al (T al)
+trackConst initial time =
+   Param.with (Param.word32 time) $ \getTime valueTime ->
+       CausalP.Cons
+          (trackNext valueTime)
+          (\size -> trackStart valueTime (initial, size))
+          trackStop
+          (trackConstCreate getTime)
+          trackDelete
+
+trackConstCreate ::
+   (p -> t) ->
+   p ->
+   IO ((), t)
+trackConstCreate getTime p =
+   return ((), getTime p)
+
+
+trackNext ::
+   (Memory.C al, Memory.Struct al ~ am) =>
+   (tl -> Value Word32) ->
+   (tl, Value (Ptr am)) ->
+   al -> Value Word32 ->
+   Maybe.T r z (T al, Value Word32)
+trackNext valueTime (size,ptr) a remain0 = Maybe.lift $ do
+   Memory.store a =<< LLVM.getElementPtr ptr (remain0, ())
+   cont <- A.cmp LLVM.CmpGT remain0 A.zero
+   let size0 = valueTime size
+   remain1 <- C.ifThenSelect cont size0 (A.dec remain0)
+   size1 <- A.inc size0
+   return (Cons ptr size1 remain0 remain1, remain1)
+
+trackStart ::
+   (Memory.C al, Memory.Struct al ~ am) =>
+   (tl -> Value Word32) ->
+   (al, tl) ->
+   CodeGenFunction r ((tl, Value (Ptr am)), Value Word32)
+trackStart valueTime (initial, size) = do
+   let size0 = valueTime size
+   size1 <- A.inc size0
+   ptr <- LLVM.arrayMalloc size1
+   -- cf. LLVM.Storable.Signal.fill
+   C.arrayLoop size1 ptr () $ \ ptri () ->
+      Memory.store initial ptri
+   return ((size,ptr), size0)
+
+trackStop ::
+   (LLVM.IsType am) =>
+   (tl, Value (Ptr am)) ->
+   Value Word32 ->
+   CodeGenFunction r ()
+trackStop (_size,ptr) _remain = LLVM.free ptr
+
+trackCreate ::
+   (Class.MakeValueTuple a, Class.ValueTuple a ~ al,
+    Memory.C al, Memory.Struct al ~ am) =>
+   (p -> a) ->
+   (p -> t) ->
+   p ->
+   IO ((), (a, t))
+trackCreate getInitial getTime p =
+   return ((), (getInitial p, getTime p))
+
+trackDelete :: () -> IO ()
+trackDelete () = return ()
diff --git a/src/Synthesizer/LLVM/RingBufferForward.hs b/src/Synthesizer/LLVM/RingBufferForward.hs
new file mode 100644
--- /dev/null
+++ b/src/Synthesizer/LLVM/RingBufferForward.hs
@@ -0,0 +1,293 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE Rank2Types #-}
+module Synthesizer.LLVM.RingBufferForward (
+   T, track, trackSkip, trackSkipHold,
+   index,
+   ) where
+
+import qualified Synthesizer.LLVM.CausalParameterized.Process as CausalP
+import qualified Synthesizer.LLVM.Parameterized.Signal as SigP
+import qualified Synthesizer.LLVM.Parameter as Param
+import Synthesizer.LLVM.CausalParameterized.Process (($<), ($*), )
+
+import qualified LLVM.Extra.MaybeContinuation as MaybeCont
+import qualified LLVM.Extra.Maybe as Maybe
+import qualified LLVM.Extra.Memory as Memory
+import qualified LLVM.Extra.Control as C
+import qualified LLVM.Extra.Arithmetic as A
+import qualified LLVM.Extra.Class as Class
+
+import qualified LLVM.Core as LLVM
+import LLVM.Util.Loop (Phi, )
+import LLVM.Core (CodeGenFunction, Value, )
+
+import Control.Arrow ((<<<), )
+import Control.Applicative (pure, )
+import Data.Tuple.HT (mapSnd, )
+
+import Data.Word (Word32, )
+import Foreign.Storable.Tuple ()
+import Foreign.Ptr (Ptr, )
+
+import Prelude hiding (length, )
+
+
+{- |
+This type is very similar to 'Synthesizer.LLVM.RingBuffer.T'
+but differs in several details:
+
+* It stores values in time order,
+  whereas 'Synthesizer.LLVM.RingBuffer.T' stores in opposite order.
+
+* Since it stores future values it is not causal
+  and can only track signal generators.
+
+* There is no need for an initial value.
+
+* It stores one value less than 'Synthesizer.LLVM.RingBuffer.T'
+  since it is meant to provide infixes of the signal
+  rather than providing the basis for a delay line.
+
+Those differences in detail would not justify a new type,
+you could achieve the same by a combination of
+'Synthesizer.LLVM.RingBuffer.track'
+and
+'Synthesizer.LLVM.CausalParameterized.Process.skip'.
+The fundamental problem of this combination is
+that it requires to keep the ring buffer alive
+longer than the providing signal exists.
+This is not possible with the current design.
+That's why we provide the combination of @track@ and @skip@
+in a way that does not suffer from that problem.
+This functionality is critical for
+'Synthesizer.LLVM.CausalParameterized.Helix.dynamic'.
+-}
+data T a =
+   Cons {
+      buffer :: Value (Ptr (Memory.Struct a)),
+      length :: Value Word32,
+      current :: Value Word32
+   }
+
+{- |
+This function does not check for range violations.
+If the ring buffer was generated by @track time@,
+then the minimum index is zero and the maximum index is @time-1@.
+Index zero refers to the current sample
+and index @time-1@ refers to the one that is farthermost in the future.
+-}
+index ::
+   (Memory.C a) =>
+   Value Word32 -> T a -> CodeGenFunction r a
+index i rb = do
+   k <- flip A.irem (length rb) =<< A.add (current rb) i
+   Memory.load =<< LLVM.getElementPtr (buffer rb) (k, ())
+
+
+{- |
+@track time signal@ bundles @time@ successive values of @signal@.
+The values can be accessed using 'index' with indices
+ranging from 0 to @time-1@.
+
+The @time@ parameter must be non-negative.
+-}
+track ::
+   (Memory.C a) =>
+   Param.T p Int -> SigP.T p a -> SigP.T p (T a)
+track time input = trackSkip time input $* 1
+
+{- |
+@trackSkip time input $* skips@
+is like
+@Process.skip (track time input) $* skips@
+but this composition would require a @Memory@ constraint for 'T'
+which we cannot provide.
+-}
+trackSkip ::
+   (Memory.C a) =>
+   Param.T p Int -> SigP.T p a -> CausalP.T p (Value Word32) (T a)
+trackSkip time (SigP.Cons next start stop create delete) =
+   Param.with (Param.word32 time) $ \getTime valueTime ->
+      CausalP.Cons
+         (trackNext next valueTime)
+         (trackStart start valueTime)
+         (trackStop stop)
+         (trackCreate create getTime)
+         (trackDelete delete)
+
+{- |
+Like @trackSkip@ but repeats the last buffer content
+when the end of the input signal is reached.
+The returned 'Bool' flag is 'True' if a skip could be performed completely
+and it is 'False' if the skip exceeds the end of the input.
+That is, once a 'False' is returned all following values are tagged with 'False'.
+The returned 'Word32' value is the number of actually skipped values.
+This lags one step behind the input of skip values.
+The number of an actual number of skips
+is at most the number of requested skips.
+If the flag is 'False', then the number of actual skips is zero.
+The converse does not apply.
+
+If the input signal is too short, the output is undefined.
+(Before the available data the buffer will be filled with arbitrary values.)
+We could fill the buffer with zeros,
+but this would require an Arithmetic constraint
+and the generated signal would not be very meaningful.
+We could also return an empty signal if the input is too short.
+However this would require a permanent check.
+-}
+trackSkipHold, trackSkipHold_ ::
+   (Memory.C a) =>
+   Param.T p Int -> SigP.T p a ->
+   CausalP.T p (Value Word32) ((Value Bool, Value Word32), T a)
+trackSkipHold time xs =
+   (CausalP.zipWithSimple
+       (\b ((c,x), buf) -> do
+          y <- C.select b x A.zero
+          return ((c, y), buf))
+      $< (CausalP.delay1 (pure False) $* SigP.constant (pure True)))
+{-
+   (CausalPV.zipWithSimple (\b ((c,x), buf) -> ((c, b ?? (x,0)), buf))
+      $< (CausalP.delay1 (pure False) $* SigP.constant (pure True)))
+-}
+   <<<
+   trackSkipHold_ time xs
+
+trackSkipHold_ time (SigP.Cons next start stop create delete) =
+   (Param.with (Param.word32 time) $ \getTime valueTime ->
+      CausalP.Cons
+         (trackNextHold next valueTime)
+         (trackStartHold start valueTime)
+         (trackStopHold stop)
+         (trackCreate create getTime)
+         (trackDelete delete))
+
+
+trackNext ::
+   (Memory.C al, Memory.Struct al ~ am, Phi z,
+    Phi state, Class.Undefined state) =>
+   (forall z0. (Phi z0) => context -> state -> MaybeCont.T r z0 (al, state)) ->
+   (tl -> Value Word32) ->
+   (context, (tl, Value (Ptr am))) ->
+   Value Word32 ->
+   (Value Word32, (state, Value Word32)) ->
+   MaybeCont.T r z (T al, (Value Word32, (state, Value Word32)))
+trackNext next valueTime (context, (size,ptr)) n1 (n0, statePos) = do
+   let size0 = valueTime size
+   (state3, pos3) <-
+      MaybeCont.fromMaybe $ fmap snd $
+      MaybeCont.fixedLengthLoop n0 statePos $ \(state0, pos0) -> do
+         (a, state1) <- next context state0
+         MaybeCont.lift $
+            fmap ((,) state1) $ storeNext (size0,ptr) a pos0
+   return (Cons ptr size0 pos3, (n1, (state3, pos3)))
+
+trackStart ::
+   (LLVM.IsSized am,
+    Phi state, Class.Undefined state) =>
+   (param -> CodeGenFunction r (context, state)) ->
+   (tl -> Value Word32) ->
+   (param, tl) ->
+   CodeGenFunction r
+      ((context, (tl, Value (Ptr am))),
+       (Value Word32, (state, Value Word32)))
+trackStart start valueTime (param, size) = do
+   (context, state) <- start param
+   let size0 = valueTime size
+   ptr <- LLVM.arrayMalloc size0
+   return ((context, (size,ptr)), (size0, (state, A.zero)))
+
+trackStop ::
+   (LLVM.IsType am) =>
+   (context -> state -> CodeGenFunction r ()) ->
+   (context, (tl, Value (Ptr am))) ->
+   (Value Word32, (state, Value Word32)) ->
+   CodeGenFunction r ()
+trackStop stop (context, (_size,ptr)) (_n, (state, _remain)) = do
+   LLVM.free ptr
+   stop context state
+
+
+trackNextHold ::
+   (Memory.C al, Memory.Struct al ~ am, Phi z,
+    Phi state, Class.Undefined state) =>
+   (forall z0. (Phi z0) => context -> state -> MaybeCont.T r z0 (al, state)) ->
+   (tl -> Value Word32) ->
+   (context, (tl, Value (Ptr am))) ->
+   Value Word32 ->
+   (Value Word32, (Maybe.T state, Value Word32)) ->
+   MaybeCont.T r z
+      (((Value Bool, Value Word32), T al),
+       (Value Word32, (Maybe.T state, Value Word32)))
+trackNextHold next valueTime (context, (size,ptr)) nNext (n0, (mstate0, pos0)) =
+      MaybeCont.lift $ do
+   let size0 = valueTime size
+   (n3, (pos3, state3)) <-
+      Maybe.run mstate0
+         (return (n0, (pos0, mstate0)))
+         (\state0 ->
+            Maybe.loopWithExit (n0, (state0, pos0))
+               (\(n1, (state1, pos1)) -> do
+                  cont <- A.cmp LLVM.CmpGT n1 A.zero
+                  fmap (mapSnd ((,) n1 . (,) pos1)) $
+                     C.ifThen cont
+                        (Maybe.nothing, Maybe.just state1)
+                        (do aState <- MaybeCont.toMaybe $ next context state1
+                            return (aState, fmap snd aState)))
+               (\((a,state), (n1, (pos1, _mstate))) -> do
+                  pos2 <- storeNext (size0,ptr) a pos1
+                  n2 <- A.dec n1
+                  return (n2, (state, pos2))))
+   skipped <- A.sub n0 n3
+   return (((Maybe.isJust state3, skipped), Cons ptr size0 pos3),
+           (nNext, (state3, pos3)))
+
+storeNext ::
+   (Memory.C al, Memory.Struct al ~ am) =>
+   (Value Word32, Value (Ptr am)) ->
+   al -> Value Word32 -> CodeGenFunction r (Value Word32)
+storeNext (size0,ptr) a pos0 = do
+   Memory.store a =<< LLVM.getElementPtr ptr (pos0, ())
+   pos1 <- A.inc pos0
+   cont <- A.cmp LLVM.CmpLT pos1 size0
+   C.select cont pos1 A.zero
+
+
+trackStartHold ::
+   (LLVM.IsSized am,
+    Phi state, Class.Undefined state) =>
+   (param -> CodeGenFunction r (context, state)) ->
+   (tl -> Value Word32) ->
+   (param, tl) ->
+   CodeGenFunction r
+      ((context, (tl, Value (Ptr am))),
+       (Value Word32, (Maybe.T state, Value Word32)))
+trackStartHold start valueTime (param, size) = do
+   (context, state) <- start param
+   let size0 = valueTime size
+   ptr <- LLVM.arrayMalloc size0
+   return ((context, (size,ptr)), (size0, (Maybe.just state, A.zero)))
+
+trackStopHold ::
+   (LLVM.IsType am) =>
+   (context -> state -> CodeGenFunction r ()) ->
+   (context, (tl, Value (Ptr am))) ->
+   (Value Word32, (Maybe.T state, Value Word32)) ->
+   CodeGenFunction r ()
+trackStopHold stop (context, (_size,ptr)) (_n, (state, _remain)) = do
+   LLVM.free ptr
+   Maybe.for state $ stop context
+
+
+trackCreate ::
+   (p -> IO (ioContext, param)) ->
+   (p -> t) ->
+   p ->
+   IO (ioContext, (param, t))
+trackCreate create getTime p = do
+   (context, param) <- create p
+   return (context, (param, getTime p))
+
+trackDelete :: (ioContext -> IO ()) -> ioContext -> IO ()
+trackDelete = id
diff --git a/src/Synthesizer/LLVM/Server/CausalPacked/Arrange.hs b/src/Synthesizer/LLVM/Server/CausalPacked/Arrange.hs
--- a/src/Synthesizer/LLVM/Server/CausalPacked/Arrange.hs
+++ b/src/Synthesizer/LLVM/Server/CausalPacked/Arrange.hs
@@ -6,11 +6,14 @@
 
 import qualified Synthesizer.LLVM.Server.CausalPacked.Speech as Speech
 import qualified Synthesizer.LLVM.Server.CausalPacked.Instrument as Instr
+import qualified Synthesizer.LLVM.Server.CausalPacked.InstrumentPlug as InstrPlug
 import qualified Synthesizer.LLVM.Server.SampledSound as Sample
 import Synthesizer.LLVM.Server.Common
 
+import qualified Synthesizer.MIDI.PiecewiseConstant.ControllerSet as PCS
 import qualified Synthesizer.MIDI.CausalIO.ControllerSet as MCS
 import qualified Synthesizer.MIDI.CausalIO.Process as MIO
+import qualified Synthesizer.MIDI.Value as MV
 import qualified Synthesizer.CausalIO.Process as PIO
 import qualified Synthesizer.PiecewiseConstant.Signal as PC
 
@@ -18,6 +21,7 @@
 import qualified Synthesizer.LLVM.CausalParameterized.Process as CausalP
 import qualified Synthesizer.LLVM.CausalParameterized.ProcessPacked as CausalPS
 import qualified Synthesizer.LLVM.Storable.Process as CausalSt
+import qualified Synthesizer.LLVM.Storable.Signal as SigStL
 
 import qualified Synthesizer.LLVM.Frame.StereoInterleaved as StereoInt
 import qualified Synthesizer.LLVM.Frame.Stereo as Stereo
@@ -29,16 +33,18 @@
 
 import qualified Synthesizer.Zip as Zip
 
-import qualified Synthesizer.MIDI.Dimensional.ValuePlain as MV
+import qualified Synthesizer.MIDI.Dimensional.ValuePlain as DMV
 import qualified Sound.MIDI.Message.Channel.Voice as VoiceMsg
 import qualified Sound.MIDI.Message.Channel as ChannelMsg
+import qualified Sound.MIDI.Message.Class.Construct as Construct
 import qualified Sound.MIDI.Message.Class.Check as Check
 
-import Control.Arrow (Arrow, (<<<), (<<^), (^<<), arr, first, )
+import Control.Arrow (Arrow, arr, first, (<<<), (^<<), )
 import Control.Category (id, )
-import Control.Monad (guard, )
+import Control.Applicative ((<*>), )
 
 import qualified Data.List.HT as ListHT
+import Data.Maybe.HT (toMaybe, )
 
 import qualified Data.Map as Map
 
@@ -100,7 +106,7 @@
 controllerExponentialDirect chan ctrl bnds initial =
    MIO.slice
       (Check.controller chan ctrl)
-      (MV.controllerExponential bnds)
+      (DMV.controllerExponential bnds)
       initial
 
 shortTime ::
@@ -168,10 +174,32 @@
 controllerExponentialDim ctrl bnds initial =
    MCS.slice
       (MCS.Controller ctrl)
-      (MV.controllerExponential bnds)
+      (DMV.controllerExponential bnds)
       initial
 
 
+timeControlPercussive, timeControlString ::
+   PIO.T
+      (PCS.T MCS.Controller Int)
+      (Zip.T
+         (Instr.Control Instr.Time)
+         (Instr.Control Instr.Time))
+
+timeControlPercussive =
+   controllerExponentialDim Ctrl.attackTime
+      (DN.time 0.1, DN.time 2.5) (DN.time 0.8)
+   &+&
+   controllerExponentialDim Ctrl.releaseTime
+      (DN.time 0.03, DN.time 0.3) (DN.time 0.1)
+
+timeControlString =
+   controllerExponentialDim Ctrl.attackTime
+      (DN.time 0.005, DN.time 0.1) (DN.time 0.1)
+   &+&
+   controllerExponentialDim Ctrl.releaseTime
+      (DN.time 0.03, DN.time 0.3) (DN.time 0.2)
+
+
 keyboardDetuneFMCore ::
    (Check.C msg, POut.Default b) =>
    CausalP.T () (Stereo.T VectorValue) (POut.Element b) ->
@@ -179,13 +207,27 @@
    IO (ChannelMsg.Channel -> VoiceMsg.Program ->
        SampleRate Real -> PIO.T (MIO.Events msg) b)
 keyboardDetuneFMCore emitStereo smpDir = do
-   arrange <- CausalSt.makeArranger
+   arrange <- keyboardDetuneFMConstVolume smpDir
    amp <-
       CausalP.processIO
          (emitStereo <<<
           CausalP.envelopeStereo <<<
           first (CausalP.mapSimple Serial.upsample))
+   return $ \chan initPgm rate ->
+      amp ()
+      <<<
+      MIO.controllerExponential chan controllerVolume (0.001, 1) (0.2::Float)
+      &+&
+      arrange chan initPgm rate
 
+keyboardDetuneFMConstVolume ::
+   (Check.C msg) =>
+   FilePath ->
+   IO (ChannelMsg.Channel -> VoiceMsg.Program -> SampleRate Real ->
+       PIO.T (MIO.Events msg) (SV.Vector (Stereo.T Vector)))
+keyboardDetuneFMConstVolume smpDir = do
+   arrange <- CausalSt.makeArranger
+
    tine <- Instr.tineStereoFM
    ping <- Instr.pingStereoReleaseFM
    filterSaw <- Instr.filterSawStereoFM
@@ -195,6 +237,7 @@
    windPhaser <- Instr.windPhaser
    string <- Instr.softStringShapeFM
    fmString <- Instr.fmStringStereoFM
+   helixNoise <- InstrPlug.helixNoise
    arcs <- sequence $
       Instr.cosineStringStereoFM :
       Instr.arcSawStringStereoFM :
@@ -203,25 +246,18 @@
       Instr.arcTriangleStringStereoFM :
       []
 
-   tmt0 <- Instr.makeSampledSounds smpDir Sample.tomatensalat
-   hal0 <- Instr.makeSampledSounds smpDir Sample.hal
-   grp0 <- Instr.makeSampledSounds smpDir Sample.graphentheorie
-
-   let timeControlPercussive =
-          controllerExponentialDim Ctrl.attackTime
-             (DN.time 0.1, DN.time 2.5) (DN.time 0.8)
-          &+&
-          controllerExponentialDim Ctrl.releaseTime
-             (DN.time 0.03, DN.time 0.3) (DN.time 0.1)
+   helixSound <- Instr.helixSound
+   sampledSound <- Instr.sampledSound
 
-       timeControlString =
-          controllerExponentialDim Ctrl.attackTime
-             (DN.time 0.005, DN.time 0.1) (DN.time 0.1)
-          &+&
-          controllerExponentialDim Ctrl.releaseTime
-             (DN.time 0.03, DN.time 0.3) (DN.time 0.2)
+   syllables <-
+      fmap concat $
+      mapM (Sample.loadRanges smpDir) $
+      Sample.tomatensalat :
+      Sample.hal :
+      Sample.graphentheorie :
+      []
 
-       frequencyControlPercussive =
+   let frequencyControlPercussive =
           MCS.controllerLinear controllerDetune (0,0.005) 0.001
           &+&
           MCS.bendWheelPressure 2 0.04 0.03
@@ -337,6 +373,16 @@
                &+&
                frequencyControlString))
 
+       helixNoiseProc rate vel freq =
+          helixNoise rate vel freq
+          <<<
+          Zip.arrowSecond
+             (timeControlString
+              &+&
+              (MCS.controllerExponential controllerTimbre0 (1,0.01) 0.1
+               &+&
+               frequencyControlString))
+
        makeArc proc rate vel freq =
           proc rate vel freq
           <<<
@@ -352,38 +398,65 @@
           <<<
           Zip.arrowSecond frequencyControlPercussive
 
+       helixed smp rate vel freq =
+          smp rate vel freq
+          <<<
+          Zip.arrowSecond
+             (MCS.controllerExponential Ctrl.attackTime (0.25, 4) 1
+              &+&
+              frequencyControlPercussive)
+
        bank =
           Map.fromAscList $ zip [VoiceMsg.toProgram 0 ..] $
           [tineProc, pingProc, filterSawProc, bellNoiseProc,
-           stringProc, fmStringProc] ++
+           stringProc, fmStringProc, helixNoiseProc] ++
           map makeArc arcs ++ windProc : windPhaserProc :
-          map sampled (tmt0 ++ hal0 ++ grp0)
+          ([helixed . helixSound, sampled . sampledSound] <*> syllables)
 
    return $ \chan initPgm rate ->
-      amp ()
+      arrange
       <<<
-      (MCS.controllerExponential controllerVolume (0.001, 1) (0.2::Float)
-       <<^ Zip.second)
-      &+&
-      (arrange
-       <<<
-       arr shortTime
-       <<<
-       MIO.sequenceModulatedMultiProgram chan initPgm
-          (\pgm -> Map.findWithDefault pingProc pgm bank rate))
+      arr shortTime
       <<<
+      MIO.sequenceModulatedMultiProgram chan initPgm
+         (\pgm -> Map.findWithDefault pingProc pgm bank rate)
+      <<<
       id &+& MCS.fromChannel chan
 
 
-data Phoneme = Phoneme Bool VoiceMsg.Pitch
+keyboardMultiChannel ::
+   (Check.C msg) =>
+   FilePath ->
+   IO (SampleRate Real ->
+       PIO.T (MIO.Events msg) (SV.Vector (Stereo.T Real)))
+keyboardMultiChannel smpDir = do
+   proc <-
+      keyboardDetuneFMCore
+         (CausalP.mapSimple StereoInt.interleave)
+         smpDir
+   mix <- CausalP.processIO CausalP.mix
 
+   return $ \ sampleRate ->
+      arr SigStL.unpackStereoStrict
+      <<<
+      foldl1
+         (\x y -> mix () <<< Zip.arrowFanout x y)
+         (map
+             (\chan ->
+                proc (ChannelMsg.toChannel chan) (VoiceMsg.toProgram 0)
+                     sampleRate)
+             [0 .. 3])
+
+
+
+data Phoneme = Phoneme Bool VoiceMsg.Velocity VoiceMsg.Pitch
+
 instance Check.C Phoneme where
-   note _chan (Phoneme on p) =
-      Just (VoiceMsg.normalVelocity, p, on)
+   note _chan (Phoneme on v p) = Just (v, p, on)
 
 
 voderSplit ::
-   (Check.C msg, Arrow arrow) =>
+   (Check.C msg, Construct.C msg, Arrow arrow) =>
    ChannelMsg.Channel ->
    arrow
       (MIO.Events msg)
@@ -394,20 +467,30 @@
    arr $
    uncurry Zip.Cons .
    EventListTT.unzip .
-   fmap (ListHT.partitionMaybe $ \ev -> do
-      (_v,p,b) <- Check.note chan ev
-      guard $ p < VoiceMsg.toPitch 53
-      return $ Phoneme b p)
+   fmap
+      (ListHT.unzipEithers .
+       fmap (\ev ->
+          case Check.note chan ev of
+             Nothing -> Right ev
+             Just (v,p,b) ->
+                if p >= VoiceMsg.toPitch 36
+                  then
+                     let p0 = VoiceMsg.increasePitch (-36) p
+                     in  if p0 <= VoiceMsg.toPitch 29
+                           then Left $ Phoneme b v p0
+                           else Right $ Construct.note chan
+                                   (v, VoiceMsg.increasePitch (-12) p, b)
+                  else Right ev))
 
 voder ::
-   (Check.C msg, POut.Default b) =>
+   (Check.C msg, Construct.C msg, POut.Default b) =>
    CausalP.T () (Stereo.T VectorValue) (POut.Element b) ->
+   Speech.VowelSynth ->
    FilePath ->
    IO (ChannelMsg.Channel -> VoiceMsg.Program ->
        SampleRate Real -> PIO.T (MIO.Events msg) b)
-voder emitStereo smpDir = do
+voder emitStereo voice smpDir = do
    carrier <- keyboardDetuneFMCore id smpDir
-   voice <- Speech.phoneme
    arrange <- CausalSt.makeArranger
    interleave <- CausalP.processIO emitStereo
 
@@ -425,3 +508,146 @@
       Zip.arrowSecond (carrier chan initPgm sampleRate)
       <<<
       voderSplit chan
+
+voderBand ::
+   (Check.C msg, Construct.C msg, POut.Default b) =>
+   CausalP.T () (Stereo.T VectorValue) (POut.Element b) ->
+   FilePath ->
+   IO (ChannelMsg.Channel -> VoiceMsg.Program ->
+       SampleRate Real -> PIO.T (MIO.Events msg) b)
+voderBand emitStereo smpDir = do
+   voice <- Speech.vowelBand
+   voder emitStereo voice smpDir
+
+voderMask ::
+   (Check.C msg, Construct.C msg, POut.Default b) =>
+   CausalP.T () (Stereo.T VectorValue) (POut.Element b) ->
+   FilePath ->
+   IO (ChannelMsg.Channel -> VoiceMsg.Program ->
+       SampleRate Real -> PIO.T (MIO.Events msg) b)
+voderMask emitStereo smpDir = do
+   voice <-
+      Speech.vowelMask <*>
+      fmap
+         (Map.mapMaybe (\(typ,smp) ->
+            toMaybe (typ==Speech.Filtered Speech.Continuous Speech.Voiced) smp))
+         Speech.loadMasksKeyboard
+   voder emitStereo voice smpDir
+
+
+voderEnv ::
+   (Check.C msg, Construct.C msg, POut.Default b) =>
+   CausalP.T () (Stereo.T VectorValue) (POut.Element b) ->
+   Speech.VowelSynthEnv ->
+   FilePath ->
+   IO (ChannelMsg.Channel -> VoiceMsg.Program ->
+       SampleRate Real -> PIO.T (MIO.Events msg) b)
+voderEnv emitStereo voice smpDir = do
+   carrier <- keyboardDetuneFMConstVolume smpDir
+   arrange <- CausalSt.makeArranger
+   amp <-
+      CausalP.processIO
+         (emitStereo <<<
+          CausalP.envelopeStereo <<<
+          first (CausalP.mapSimple Serial.upsample))
+
+   return $ \chan initPgm sampleRate ->
+      amp ()
+      <<<
+      MIO.controllerExponential chan controllerVolume (0.001, 1) (0.2::Float)
+      &+&
+      (arrange
+       <<<
+       arr shortTime
+       <<<
+       MIO.sequenceModulatedMultiProgramVelocityPitch
+          chan (VoiceMsg.toProgram 0)
+          (\ _pgm vel -> voice sampleRate (MV.velocity vel))
+       <<<
+       Zip.arrowSecond
+          (Zip.arrowFanout
+             (timeControlString <<< MCS.fromChannel chan)
+             (carrier chan initPgm sampleRate))
+       <<<
+       voderSplit chan)
+
+voderMaskEnv ::
+   (Check.C msg, Construct.C msg, POut.Default b) =>
+   CausalP.T () (Stereo.T VectorValue) (POut.Element b) ->
+   FilePath ->
+   IO (ChannelMsg.Channel -> VoiceMsg.Program ->
+       SampleRate Real -> PIO.T (MIO.Events msg) b)
+voderMaskEnv emitStereo smpDir = do
+   voice <- Speech.phonemeMask <*> Speech.loadMasksKeyboard
+   voderEnv emitStereo voice smpDir
+
+
+voderSeparated ::
+   (Check.C msg, Construct.C msg, POut.Default b) =>
+   CausalP.T (SampleRate Real) (Stereo.T VectorValue) (POut.Element b) ->
+   Speech.VowelSynthEnv ->
+   FilePath ->
+   IO (ChannelMsg.Channel -> ChannelMsg.Channel -> VoiceMsg.Program ->
+       SampleRate Real -> PIO.T (MIO.Events msg) b)
+voderSeparated emitStereo voice smpDir = do
+   carrier <- keyboardDetuneFMCore id smpDir
+   arrange <- CausalSt.makeArranger
+   amp <-
+      CausalP.processIO
+         (emitStereo <<<
+          CausalP.envelopeStereo <<<
+          first (CausalP.mapSimple Serial.upsample))
+
+   return $ \carrierChan phonemeChan initPgm sampleRate ->
+      amp sampleRate
+      <<<
+      MIO.controllerExponential phonemeChan controllerVolume (0.001, 1) (0.2::Float)
+      &+&
+      (arrange
+       <<<
+       arr shortTime
+       <<<
+       MIO.sequenceModulatedMultiProgramVelocityPitch
+          phonemeChan (VoiceMsg.toProgram 0)
+          (\ _pgm vel -> voice sampleRate (MV.velocity vel))
+       <<<
+       Zip.arrowFanout id
+          (Zip.arrowFanout
+             (timeControlString <<< MCS.fromChannel phonemeChan)
+             (carrier carrierChan initPgm sampleRate)))
+
+voderMaskSeparated ::
+   (Check.C msg, Construct.C msg, POut.Default b) =>
+   CausalP.T (SampleRate Real) (Stereo.T VectorValue) (POut.Element b) ->
+   FilePath ->
+   IO (ChannelMsg.Channel -> ChannelMsg.Channel -> VoiceMsg.Program ->
+       SampleRate Real -> PIO.T (MIO.Events msg) b)
+voderMaskSeparated emitStereo smpDir = do
+   voice <- Speech.phonemeMask <*> Speech.loadMasksGrouped
+   voderSeparated emitStereo voice smpDir
+
+voderMaskMulti ::
+   (Check.C msg, Construct.C msg) =>
+   FilePath ->
+   IO (SampleRate Real ->
+       PIO.T (MIO.Events msg) (SV.Vector (Stereo.T Real)))
+voderMaskMulti smpDir = do
+   mix <- CausalP.processIO CausalP.mix
+   proc <-
+      voderMaskSeparated
+         (CausalP.mapSimple StereoInt.interleave)
+         smpDir
+
+   return $ \ sampleRate ->
+      arr SigStL.unpackStereoStrict
+      <<<
+      foldl1
+         (\x y -> mix () <<< Zip.arrowFanout x y)
+         (map
+             (\chan ->
+                proc
+                   (ChannelMsg.toChannel chan)
+                   (ChannelMsg.toChannel $ succ chan)
+                   (VoiceMsg.toProgram 4)
+                   sampleRate)
+             [0, 2, 4, 6])
diff --git a/src/Synthesizer/LLVM/Server/CausalPacked/Instrument.hs b/src/Synthesizer/LLVM/Server/CausalPacked/Instrument.hs
--- a/src/Synthesizer/LLVM/Server/CausalPacked/Instrument.hs
+++ b/src/Synthesizer/LLVM/Server/CausalPacked/Instrument.hs
@@ -22,6 +22,7 @@
 import qualified Synthesizer.CausalIO.Gate as Gate
 import qualified Synthesizer.CausalIO.Process as PIO
 
+import Synthesizer.LLVM.CausalParameterized.Process (($<), )
 import Synthesizer.LLVM.CausalParameterized.Functional (($&), (&|&), )
 import qualified Synthesizer.LLVM.Filter.Universal as UniFilter
 import qualified Synthesizer.LLVM.Filter.Allpass as Allpass
@@ -30,14 +31,19 @@
 import qualified Synthesizer.LLVM.Frame.Stereo as Stereo
 import qualified Synthesizer.LLVM.Frame as Frame
 import qualified Synthesizer.LLVM.Frame.SerialVector as Serial
+import qualified Synthesizer.LLVM.CausalParameterized.Helix as Helix
 import qualified Synthesizer.LLVM.CausalParameterized.Functional as F
 import qualified Synthesizer.LLVM.CausalParameterized.ControlledPacked as CtrlPS
 import qualified Synthesizer.LLVM.CausalParameterized.ProcessPacked as CausalPS
+import qualified Synthesizer.LLVM.CausalParameterized.ProcessValue as CausalPV
 import qualified Synthesizer.LLVM.CausalParameterized.Process as CausalP
 import qualified Synthesizer.LLVM.Parameterized.SignalPacked as SigPS
 import qualified Synthesizer.LLVM.Parameterized.Signal as SigP
 import qualified Synthesizer.LLVM.Parameter as Param
+import qualified Synthesizer.LLVM.Interpolation as Interpolation
 import qualified Synthesizer.LLVM.Wave as WaveL
+import qualified Synthesizer.LLVM.Simple.Value as Value
+import Synthesizer.LLVM.Simple.Value ((%>), (%<=), )
 
 import qualified Synthesizer.LLVM.MIDI.BendModulation as BM
 import qualified Synthesizer.LLVM.MIDI as MIDIL
@@ -50,9 +56,6 @@
 import qualified Data.StorableVector.Lazy as SVL
 import qualified Data.StorableVector as SV
 
-import System.FilePath ((</>), )
-
-import qualified LLVM.Extra.Arithmetic as A
 import qualified LLVM.Extra.Monad as LM
 
 import qualified LLVM.Core as LLVM
@@ -62,9 +65,10 @@
 import qualified Data.Traversable as Trav
 import Control.Arrow (Arrow, arr, first, second, (&&&), (<<^), (^<<), )
 import Control.Category (id, (.), )
-import Control.Monad (liftM2, liftM3, (<=<), )
+import Control.Monad (liftM2, liftM3, liftM4, (<=<), )
 import Control.Applicative (pure, liftA2, liftA3, )
 import Data.Monoid (mappend, )
+import Data.Tuple.HT (fst3, snd3, thd3, )
 
 import qualified Number.DimensionTerm as DN
 
@@ -79,6 +83,8 @@
 type Time = DN.Time Real
 type Frequency = DN.Frequency Real
 
+type Chunk = SV.Vector Vector
+type StereoChunk = SV.Vector (Stereo.T Vector)
 type BendModControl = Control (BM.T Real)
 type DetuneBendModControl = Zip.T (Control Real) (Control (BM.T Real))
 
@@ -122,18 +128,8 @@
    Param.T p Real ->
    CausalP.T p VectorValue VectorValue
 takeThreshold =
-   CausalP.takeWhile
-      (\threshold y ->
-         A.cmp LLVM.CmpLE threshold =<< Serial.subsample y)
-
-
-fanoutShorten ::
-   (CutG.Transform a, CutG.Transform b, CutG.Transform c) =>
-   PIO.T a b -> PIO.T a c -> PIO.T a (Zip.T b c)
-fanoutShorten a b =
-   Zip.arrowFirstShorten a .
-   Zip.arrowSecondShorten b .
-   arr (\x -> Zip.Cons x x)
+   CausalPV.takeWhile
+      (\threshold y -> threshold %<= Value.lift1 Serial.subsample y)
 
 
 type EnvelopeControl =
@@ -157,7 +153,17 @@
          (Zip.consChecked "ping gate times" gate times) ctrl
 
 
-ping :: IO (Instrument Real (SV.Vector Vector))
+zipEnvelope ::
+   (Arrow arrow, CutG.Transform a, CutG.Transform b) =>
+   arrow EnvelopeControl a ->
+   arrow (WithEnvelopeControl b) (Zip.T a b)
+zipEnvelope env =
+   Zip.arrowFirstShorten env
+   .
+   reorderEnvelopeControl
+
+
+ping :: IO (Instrument Real Chunk)
 ping =
    fmap (\proc sampleRate vel freq ->
       proc (sampleRate, (vel,freq))
@@ -175,7 +181,7 @@
 pingReleaseEnvelope ::
    IO (Real -> Real ->
        SampleRate Real -> Real ->
-       PIO.T MIO.GateChunk (SV.Vector Vector))
+       PIO.T MIO.GateChunk Chunk)
 pingReleaseEnvelope =
    liftM2
       (\sustain release dec rel sr vel ->
@@ -201,9 +207,7 @@
              CausalP.fromSignal
                 (SigPS.exponential2 release level))
 
-pingRelease ::
-   IO (Real -> Real ->
-       Instrument Real (SV.Vector Vector))
+pingRelease :: IO (Real -> Real -> Instrument Real Chunk)
 pingRelease =
    liftM2
       (\osci envelope dec rel sr vel freq ->
@@ -221,9 +225,7 @@
 pingControlledEnvelope ::
    Maybe Real ->
    IO (SampleRate Real -> Real ->
-       PIO.T
-          EnvelopeControl
-          (SV.Vector Vector))
+       PIO.T EnvelopeControl Chunk)
 pingControlledEnvelope threshold =
    liftM2
       (\sustain release sr vel ->
@@ -258,7 +260,7 @@
                 (Zip.T
                    (Zip.T (Control Real) (Control Time))
                    DetuneBendModControl)))
-          (SV.Vector (Stereo.T Vector)))
+          StereoChunk)
 pingStereoReleaseFM =
    liftA2
       (\osc env sr vel freq ->
@@ -273,9 +275,7 @@
                 (Zip.arrowFirst $ Zip.arrowSecond $
                    arr $ halfLifeControl sr)))
          .
-         Zip.arrowFirstShorten (env sr vel)
-         .
-         reorderEnvelopeControl)
+         zipEnvelope (env sr vel))
       (CausalP.processIO
          (CausalP.envelopeStereo
           .
@@ -306,7 +306,7 @@
              (Zip.T
                 (Zip.T (Control Frequency) (Control Time))
                 DetuneBendModControl))
-          (SV.Vector (Stereo.T Vector)))
+          StereoChunk)
 filterSawStereoFM =
    liftA2
       (\osc env sr vel freq ->
@@ -320,9 +320,7 @@
                (Zip.arrowSecond $
                   arr $ transposeModulation sr freq))
          .
-         Zip.arrowFirstShorten (env sr vel)
-         .
-         reorderEnvelopeControl)
+         zipEnvelope (env sr vel))
       (CausalP.processIO
          (CausalP.envelopeStereo
           .
@@ -349,7 +347,7 @@
                    expo)
                   &|&
                   (CausalP.stereoFromMono
-                     (CausalPS.osciSimple WaveL.saw . CausalP.feedFst zero) $&
+                     (CausalPS.osciSimple WaveL.saw $< zero) $&
                      freqs))))
       (pingControlledEnvelope (Just 0.01))
 
@@ -360,7 +358,7 @@
              (Zip.T
                 (Zip.T (Control Real) (Control Real))
                 DetuneBendModControl))
-          (SV.Vector (Stereo.T Vector)))
+          StereoChunk)
 tineStereoFM =
    liftA2
       (\osc env sr vel freq ->
@@ -370,9 +368,7 @@
           Zip.arrowSecond $
             arr $ transposeModulation sr freq)
          .
-         Zip.arrowFirstShorten (env sr vel)
-         .
-         reorderEnvelopeControl)
+         zipEnvelope (env sr vel))
       (CausalP.processIO
          (CausalP.envelopeStereo
           .
@@ -385,7 +381,7 @@
                   index = CausalP.mapSimple Serial.upsample $& index0
                   depth = CausalP.mapSimple Serial.upsample $& depth0
                   expo =
-                     F.lift $ CausalP.fromSignal $
+                     F.fromSignal $
                      SigPS.exponential2 (timeConst 1) (1 + vel)
                   osci freq =
                      CausalPS.osciSimple WaveL.approxSine2 $&
@@ -405,7 +401,7 @@
              (Zip.T
                 (Zip.T (Control Real) (Control Real))
                 DetuneBendModControl))
-          (SV.Vector (Stereo.T Vector)))
+          StereoChunk)
 bellNoiseStereoFM =
    liftA3
       (\osc env envInf sr vel freq ->
@@ -415,8 +411,8 @@
           Zip.arrowSecond $
             arr $ transposeModulation sr freq)
          .
-         Zip.arrowFirstShorten
-            (fanoutShorten
+         zipEnvelope
+            (Zip.arrowFanoutShorten
                (env sr (vel*0.5))
                (let shortenTimes ::
                        Real ->
@@ -432,9 +428,7 @@
                        Zip.arrowSecond (shortenTimes 4))
                       (envInf sr (vel*4)
                        .
-                       Zip.arrowSecond (shortenTimes 7))))
-         .
-         reorderEnvelopeControl)
+                       Zip.arrowSecond (shortenTimes 7)))))
       (CausalP.processIO
          (F.withArgs $ \((env1,(env4,env7)),((noiseAmp0,noiseReson),fm)) ->
           let noiseAmp = CausalP.mapSimple Serial.upsample $& noiseAmp0
@@ -443,9 +437,7 @@
                     (100 / fromIntegral vectorSize :: Param.T p Real)
                     (CausalP.zipWithSimple (Moog.parameter TypeNum.d8))
               noise =
-                 F.lift
-                    (CausalP.fromSignal
-                       (SigPS.noise 12 (noiseReference 20000)))
+                 F.fromSignal (SigPS.noise 12 (noiseReference 20000))
               freqs =
                  stereoFrequenciesFromDetuneBendModulation
                     (frequencyConst 5) fm
@@ -454,8 +446,7 @@
                  CausalP.envelopeStereo $&
                  env &|&
                  (CausalP.stereoFromMono
-                    (CausalPS.osciSimple WaveL.approxSine4 .
-                     CausalP.feedFst zero)
+                    (CausalPS.osciSimple WaveL.approxSine4 $< zero)
                   $&
                   CausalPS.amplifyStereo n
                   $&
@@ -481,7 +472,7 @@
 
 stringControlledEnvelope ::
    IO (SampleRate Real -> Real ->
-       PIO.T EnvelopeControl (SV.Vector Vector))
+       PIO.T EnvelopeControl Chunk)
 stringControlledEnvelope =
    liftM3
       (\attack sustain release sr vel ->
@@ -528,17 +519,16 @@
            (MIDIL.frequencyFromBendModulationPacked
               (frequencyConst 0.2) $& fm))
    in  CausalP.stereoFromMonoControlled CtrlPS.process $&
-          (CausalP.zipWithSimple
-                (Moog.parameter TypeNum.d8) $&
+          (CausalP.zipWithSimple (Moog.parameter TypeNum.d8) $&
              reson &|& modu)
           &|&
-          F.lift (CausalP.fromSignal stereoNoise)
+          F.fromSignal stereoNoise
 
 wind ::
    IO (SampleRate Real -> Real -> Real ->
        PIO.T
           (WithEnvelopeControl DetuneBendModControl)
-          (SV.Vector (Stereo.T Vector)))
+          StereoChunk)
 wind =
    liftA2
       (\osc env sr vel freq ->
@@ -547,9 +537,7 @@
          (Zip.arrowSecond $ Zip.arrowSecond $
             arr $ transposeModulation sr freq)
          .
-         Zip.arrowFirstShorten (env sr vel)
-         .
-         reorderEnvelopeControl)
+         zipEnvelope (env sr vel))
       (CausalP.processIO
          (F.withArgs $ \(env,(reson,fm)) ->
               CausalP.envelopeStereo $&
@@ -564,7 +552,7 @@
           (WithEnvelopeControl
              (Zip.T (Control Real)
                 (Zip.T (Control Frequency) DetuneBendModControl)))
-          (SV.Vector (Stereo.T Vector)))
+          StereoChunk)
 windPhaser =
    liftA2
       (\osc env sr vel freq ->
@@ -577,9 +565,7 @@
              (Zip.arrowSecond $
               arr $ transposeModulation sr freq))
          .
-         Zip.arrowFirstShorten (env sr vel)
-         .
-         reorderEnvelopeControl)
+         zipEnvelope (env sr vel))
       (CausalP.processIO
          (F.withArgs $ \(env,(phaserMix0,(phaserFreq,(reson,fm)))) ->
           let phaserMix = CausalP.mapSimple Serial.upsample $& phaserMix0
@@ -614,7 +600,7 @@
       PIO.T
          (WithEnvelopeControl
             (Zip.T (Control Real) DetuneBendModControl))
-         (SV.Vector (Stereo.T Vector))
+         StereoChunk
 
 softStringShapeCore ::
    (forall r.
@@ -631,9 +617,7 @@
           Zip.arrowSecond $
             arr $ transposeModulation sr freq)
          .
-         Zip.arrowFirstShorten (env sr vel)
-         .
-         reorderEnvelopeControl)
+         zipEnvelope (env sr vel))
       (CausalP.processIO
          (CausalP.envelopeStereo
           .
@@ -700,7 +684,7 @@
              (Zip.T
                 (Zip.T (Control Real) (Control Real))
                 DetuneBendModControl))
-          (SV.Vector (Stereo.T Vector)))
+          StereoChunk)
 fmStringStereoFM =
    liftA2
       (\osc env sr vel freq ->
@@ -710,9 +694,7 @@
           Zip.arrowSecond $
             arr $ transposeModulation sr freq)
          .
-         Zip.arrowFirstShorten (env sr vel)
-         .
-         reorderEnvelopeControl)
+         zipEnvelope (env sr vel))
       (CausalP.processIO
          (F.withArgs $ \(env,((depth0,shape0),(det0,fm))) ->
           let det = CausalP.mapSimple Serial.upsample $& det0
@@ -762,131 +744,186 @@
        SampleRate Real -> Real -> Real ->
        PIO.T
           (Zip.T MIO.GateChunk DetuneBendModControl)
-          (SV.Vector (Stereo.T Vector)))
+          StereoChunk)
 sampledSound =
    liftA2
       (\osc freqMod smp sr vel freq ->
-         {-
-         We split the frequency modulation signal
-         in order to get a smooth frequency modulation curve.
-         Without (periodic) frequency modulation
-         we could just split the piecewise constant control curve @fm@.
-         -}
          let pos = Sample.positions smp
-             amp = 2 * amplitudeFromVelocity vel
-             (attack, sustain, release) = Sample.parts smp
-             osci smpBody = osc (sr, (amp, smpBody))
-         in  mappend
-                (osci
-                   (attack `SigSt.append`
-                    SVL.cycle (SigSt.take (Sample.loopLength pos) sustain))
-                 .
-                 Gate.shorten)
-                (osci release <<^ Zip.second)
+         in  assembleParts osc smp sr vel
              .
              Zip.arrowSecond
-                ((id :: PIOId (SV.Vector (Stereo.T Vector)))
+                ((id :: PIOId StereoChunk)
                  .
                  freqMod (sr, ())
                  .
                  (Zip.arrowSecond $ arr $
-                    transposeModulation sr (freq * Sample.period smp))))
-      (CausalP.processIO
-         (let amp = number fst
-              smp = signal snd
-          in  CausalPS.amplifyStereo amp
-              .
-              CausalP.stereoFromMono
-                 (CausalPS.pack
-                    (CausalP.frequencyModulationLinear
-                       {-
-                       (SigP.fromStorableVector $
-                          fmap (SV.concat . SVL.chunks . SVL.take 1000000) smp)
-                       -}
-                       (SigP.fromStorableVectorLazy smp)
-                       {- (SigP.osciSimple WaveL.saw 0 (1 / 324 {- samplePeriod smp -})) -}))))
+                    transposeModulation sr (freq * Sample.period pos))))
+      (CausalP.processIO (CausalP.stereoFromMono resamplingProc))
       (CausalP.processIO
          (F.withArgs $ stereoFrequenciesFromDetuneBendModulation (frequencyConst 3)))
 
-makeSampledSounds ::
-   FilePath ->
-   Sample.Info ->
-   IO [SampleRate Real -> Real -> Real ->
-       PIO.T
-          (Zip.T MIO.GateChunk DetuneBendModControl)
-          (SV.Vector (Stereo.T Vector))]
-makeSampledSounds dir (file, positions, period) = do
-   liftA2
-      (\makeSmp smp ->
-          map (\pos -> makeSmp (Sample.Cons smp pos period))
-             positions)
-      sampledSound
-      (Sample.load (dir </> file))
 
-
 {- |
 mainly for testing purposes
 -}
 sampledSoundMono ::
    IO (Sample.T ->
        SampleRate Real -> Real -> Real ->
-       PIO.T
-          (Zip.T MIO.GateChunk BendModControl)
-          (SV.Vector Vector))
+       PIO.T (Zip.T MIO.GateChunk BendModControl) Chunk)
 sampledSoundMono =
    liftA2
       (\osc freqMod smp sr vel freq ->
-         {-
-         We split the frequency modulation signal
-         in order to get a smooth frequency modulation curve.
-         Without (periodic) frequency modulation
-         we could just split the piecewise constant control curve @fm@.
-         -}
          let pos = Sample.positions smp
-             amp = 2 * amplitudeFromVelocity vel
-             (attack, sustain, release) = Sample.parts smp
-             osci smpBody = osc (sr, (amp, smpBody))
-         in  mappend
-                (osci
-                   (attack `SigSt.append`
-                    SVL.cycle (SigSt.take (Sample.loopLength pos) sustain))
-                 .
-                 Gate.shorten)
-                (osci release <<^ Zip.second)
+         in  assembleParts osc smp sr vel
              .
              Zip.arrowSecond
-                ((id :: PIOId (SV.Vector Vector))
+                ((id :: PIOId Chunk)
                  .
                  freqMod (sr, ())
                  .
-                 (arr $ transposeModulation sr (freq * Sample.period smp))))
-      (CausalP.processIO
-         (let amp = number fst
-              smp = signal snd
-          in  CausalPS.amplify amp
-              .
-              CausalPS.pack
-                 (CausalP.frequencyModulationLinear
-                    {-
-                    (SigP.fromStorableVector $
-                       fmap (SV.concat . SVL.chunks . SVL.take 1000000) smp)
-                    -}
-                    (SigP.fromStorableVectorLazy smp)
-                    {- (SigP.osciSimple WaveL.saw 0 (1 / 324 {- samplePeriod smp -})) -})))
+                 (arr $ transposeModulation sr (freq * Sample.period pos))))
+      (CausalP.processIO resamplingProc)
       (CausalP.processIO
          (MIDIL.frequencyFromBendModulationPacked (frequencyConst 3)))
 
-makeSampledSoundsMono ::
-   FilePath ->
-   Sample.Info ->
-   IO [SampleRate Real -> Real -> Real ->
+{-
+We split the frequency modulation signal
+in order to get a smooth frequency modulation curve.
+Without (periodic) frequency modulation
+we could just split the piecewise constant control curve @fm@.
+-}
+assembleParts ::
+   (CutG.Transform a, CutG.Transform b) =>
+   ((SampleRate Real, (Real, SVL.Vector Real)) -> PIO.T a b) ->
+   Sample.T -> SampleRate Real -> Real ->
+   PIO.T (Zip.T (Gate.Chunk gate) a) b
+assembleParts osc smp sr vel =
+   let pos = Sample.positions smp
+       amp = 2 * amplitudeFromVelocity vel
+       (attack, sustain, release) = Sample.parts smp
+       osci smpBody = osc (sr, (amp, smpBody))
+   in  mappend
+          (osci
+             (attack `SigSt.append`
+              SVL.cycle (SigSt.take (Sample.loopLength pos) sustain))
+           .
+           Gate.shorten)
+          (osci release <<^ Zip.second)
+
+resamplingProc ::
+   CausalP.T
+      (SampleRate Real, (Real, SigSt.T Real))
+      VectorValue VectorValue
+resamplingProc =
+   let amp = number fst
+       smp = signal snd
+   in  CausalPS.amplify amp
+       .
+       CausalPS.pack
+          (CausalP.frequencyModulationLinear
+             {-
+             (SigP.fromStorableVector $
+                fmap (SV.concat . SVL.chunks . SVL.take 1000000) smp)
+             -}
+             (SigP.fromStorableVectorLazy smp)
+             {- (SigP.osciSimple WaveL.saw 0 (1 / 324 {- samplePeriod smp -})) -})
+
+helixSound ::
+   IO (Sample.T ->
+       SampleRate Real -> Real -> Real ->
        PIO.T
-          (Zip.T MIO.GateChunk BendModControl)
-          (SV.Vector Vector)]
-makeSampledSoundsMono dir (file, positions, period) = do
-   liftA2
-      (\makeSmp smp ->
-          map (\pos -> makeSmp (Sample.Cons smp pos period))
-             positions)
-      sampledSoundMono
-      (Sample.load (dir </> file))
+          (Zip.T MIO.GateChunk
+              (Zip.T (Control Real) DetuneBendModControl))
+          StereoChunk)
+helixSound =
+   liftM4
+      (\helix zigZag integrate freqMod smp sr vel freq ->
+         let pos = Sample.positions smp
+             amp = 2 * amplitudeFromVelocity vel
+             rateFactor =
+                DN.divToScalar
+                   (Sample.sampleRate smp)
+                   (frequencyFromSampleRate sr)
+             releaseStart =
+                fromIntegral $
+                Sample.loopStart pos + Sample.loopLength pos
+             releaseStop =
+                fromIntegral $
+                Sample.start pos + Sample.length pos
+             poss =
+                (fromIntegral $ Sample.start pos,
+                 fromIntegral $ Sample.loopStart pos,
+                 fromIntegral $ Sample.loopLength pos)
+         in  helix (sr, ((amp, Sample.period pos), Sample.body smp))
+             .
+             Zip.arrowFirstShorten
+                (mappend
+                    (zigZag (sr, poss) . Gate.shorten)
+                    (integrate (sr, (releaseStart, releaseStop))
+                        <<^ Zip.second))
+             .
+             Zip.arrowSecond
+                (freqMod (sr, ())
+                 .
+                 (Zip.arrowSecond $ arr $ transposeModulation sr freq))
+             .
+             arr (\(Zip.Cons gate (Zip.Cons speed fm)) ->
+                       Zip.Cons (Zip.Cons gate (fmap (rateFactor*) speed)) fm))
+      makeHelix
+      makeZigZag
+      makeIntegrate
+      (CausalP.processIO
+         (F.withArgs $ stereoFrequenciesFromDetuneBendModulation (frequencyConst 3)))
+
+makeHelix ::
+   IO ((SampleRate Real, ((Real, Real), SigSt.T Real)) ->
+       PIO.T (Zip.T Chunk StereoChunk) StereoChunk)
+makeHelix =
+   CausalP.processIO
+      (let amp = number (fst.fst)
+           per = number (snd.fst)
+           smp = signal snd
+       in  CausalPS.amplifyStereo amp
+           .
+           CausalP.stereoFromMono
+              (Helix.staticPacked
+                  Interpolation.linear
+                  Interpolation.linear
+                  (fmap round per) per
+                  (fmap (SV.concat . SVL.chunks) smp)
+               .
+               second (CausalPS.osciCore $< 0))
+           .
+           arr (\(shape, freq) -> fmap ((,) shape) freq))
+
+makeZigZag ::
+   IO ((SampleRate Real, (Real, Real, Real)) ->
+       PIO.T (Control Real) Chunk)
+makeZigZag =
+   CausalP.processIO
+      (let start = number fst3
+           loopStart = number snd3
+           loopLength = number thd3
+
+       in  CausalPS.raise start
+           .
+           -- CausalPS.pack (Helix.zigZagLong (loopStart-start) loopLength)
+           Helix.zigZagLongPacked (loopStart-start) loopLength
+           .
+           CausalP.mapSimple Serial.upsample)
+
+makeIntegrate ::
+   IO ((SampleRate Real, (Real, Real)) ->
+       PIO.T (Control Real) Chunk)
+makeIntegrate =
+   CausalP.processIO
+      (let start = number fst
+           stop = number snd
+
+       in  CausalPV.takeWhile
+              (\s v ->  s %> Value.lift1 Serial.subsample v)
+              stop
+           .
+           CausalPS.integrate start
+           .
+           CausalP.mapSimple Serial.upsample)
diff --git a/src/Synthesizer/LLVM/Server/CausalPacked/InstrumentPlug.hs b/src/Synthesizer/LLVM/Server/CausalPacked/InstrumentPlug.hs
--- a/src/Synthesizer/LLVM/Server/CausalPacked/InstrumentPlug.hs
+++ b/src/Synthesizer/LLVM/Server/CausalPacked/InstrumentPlug.hs
@@ -10,11 +10,12 @@
 
 import Synthesizer.LLVM.Server.CausalPacked.Instrument (
           Control, DetuneBendModControl,
-          WithEnvelopeControl,
+          WithEnvelopeControl, StereoChunk,
           pingControlledEnvelope,
+          stringControlledEnvelope,
           reorderEnvelopeControl, )
 import Synthesizer.LLVM.Server.CommonPacked (
-          Param, Vector, VectorValue, )
+          Param, VectorValue, )
 import Synthesizer.LLVM.Server.Common (
           SampleRate, Real,
           frequencyConst, timeConst,
@@ -25,18 +26,20 @@
 import Synthesizer.LLVM.CausalParameterized.FunctionalPlug (($&), (&|&), )
 import qualified Synthesizer.LLVM.Frame.Stereo as Stereo
 import qualified Synthesizer.LLVM.Frame.SerialVector as Serial
+import qualified Synthesizer.LLVM.CausalParameterized.Helix as Helix
 import qualified Synthesizer.LLVM.CausalParameterized.FunctionalPlug as FP
 import qualified Synthesizer.LLVM.CausalParameterized.ProcessPacked as CausalPS
 import qualified Synthesizer.LLVM.CausalParameterized.Process as CausalP
 import qualified Synthesizer.LLVM.Parameterized.SignalPacked as SigPS
+import qualified Synthesizer.LLVM.Parameterized.Signal as SigP
+import qualified Synthesizer.LLVM.Parameter as Param
+import qualified Synthesizer.LLVM.Interpolation as Interpolation
 import qualified Synthesizer.LLVM.Wave as WaveL
 
 import qualified Synthesizer.LLVM.MIDI.BendModulation as BM
 import qualified Synthesizer.LLVM.MIDI as MIDIL
 import qualified Synthesizer.Zip as Zip
 
-import qualified Data.StorableVector as SV
-
 import qualified LLVM.Core as LLVM
 
 import qualified Data.Traversable as Trav
@@ -69,7 +72,7 @@
              (Zip.T
                 (Zip.T (Control Real) (Control Real))
                 DetuneBendModControl))
-          (SV.Vector (Stereo.T Vector)))
+          StereoChunk)
 tineStereoFM =
    liftA2
       (\osc env sr vel freq ->
@@ -100,3 +103,41 @@
          in  CausalP.envelopeStereo $&
                 FP.plug env &|& Stereo.liftApplicative osci freqs)
       (pingControlledEnvelope (Just 0.01))
+
+
+helixNoise ::
+   IO (SampleRate Real -> Real -> Real ->
+       PIO.T
+          (WithEnvelopeControl
+             (Zip.T (Control Real) DetuneBendModControl))
+          StereoChunk)
+helixNoise =
+   liftA2
+      (\osc env sr vel freq ->
+         osc (sr, freq) (sr, vel)
+         .
+         Zip.arrowFirstShorten (env sr vel)
+         .
+         reorderEnvelopeControl)
+      (FP.withArgs $ \(env, (speed0, (detune,fm))) ->
+         let freqs =
+                stereoFrequenciesFromDetuneBendModulation
+                   (frequencyConst 5)
+                   (FP.plug detune,
+                    FP.plug $ liftA2 (uncurry transposeModulation) FP.askParameter fm)
+             speed = CausalP.mapSimple Serial.upsample $& FP.plug speed0
+         in  CausalP.envelopeStereo $&
+                FP.plug env &|& Stereo.liftApplicative (helixOsci speed) freqs)
+      stringControlledEnvelope
+
+helixOsci ::
+   FP.T pp pl inp VectorValue ->
+   FP.T pp pl inp VectorValue ->
+   FP.T pp pl inp VectorValue
+helixOsci speed freq =
+   CausalPS.pack
+      (Helix.dynamicLimited Interpolation.cubic Interpolation.cubic
+          64 (64 :: Param.T p Real) (SigP.noise 66 0.2))
+   $&
+   speed &|&
+   (CausalPS.osciCore $& 0 &|& freq)
diff --git a/src/Synthesizer/LLVM/Server/CausalPacked/Speech.hs b/src/Synthesizer/LLVM/Server/CausalPacked/Speech.hs
--- a/src/Synthesizer/LLVM/Server/CausalPacked/Speech.hs
+++ b/src/Synthesizer/LLVM/Server/CausalPacked/Speech.hs
@@ -2,21 +2,27 @@
 module Synthesizer.LLVM.Server.CausalPacked.Speech where
 
 import Synthesizer.LLVM.Server.CausalPacked.Instrument
-          (Control, Frequency, frequencyControl, )
-import Synthesizer.LLVM.Server.CommonPacked (Vector, VectorValue, )
-import Synthesizer.LLVM.Server.Common (SampleRate, Real, frequency, )
+          (StereoChunk, Control, Frequency, frequencyControl,
+           WithEnvelopeControl, zipEnvelope,
+           stringControlledEnvelope, pingControlledEnvelope, )
+import Synthesizer.LLVM.Server.CommonPacked (VectorValue, )
+import Synthesizer.LLVM.Server.Common
+          (SampleRate(SampleRate), Real, parameter, noiseReference, frequency, )
+import qualified Synthesizer.LLVM.Server.SampledSound as Sample
 
 import qualified Synthesizer.MIDI.CausalIO.Process as MIO
 import qualified Synthesizer.CausalIO.Gate as Gate
 import qualified Synthesizer.CausalIO.Process as PIO
 
-import Synthesizer.LLVM.CausalParameterized.Process (($<), )
+import Synthesizer.LLVM.CausalParameterized.Process (($<), ($>), ($*), )
 import Synthesizer.LLVM.CausalParameterized.FunctionalPlug (($&), (&|&), )
 import qualified Synthesizer.LLVM.Frame.Stereo as Stereo
 import qualified Synthesizer.LLVM.Frame.SerialVector as Serial
+import qualified Synthesizer.LLVM.Filter.NonRecursive as FiltNR
 import qualified Synthesizer.LLVM.CausalParameterized.FunctionalPlug as FP
 import qualified Synthesizer.LLVM.CausalParameterized.ControlledPacked as CtrlPS
 import qualified Synthesizer.LLVM.CausalParameterized.Process as CausalP
+import qualified Synthesizer.LLVM.Parameterized.SignalPacked as SigPS
 import qualified Synthesizer.LLVM.Parameterized.Signal as SigP
 
 import qualified Synthesizer.Zip as Zip
@@ -24,19 +30,28 @@
 
 import qualified Synthesizer.PiecewiseConstant.Signal as PC
 
+import qualified Synthesizer.Generic.Control as CtrlG
+import qualified Synthesizer.Generic.Signal as SigG
+
 import qualified Synthesizer.Plain.Filter.Recursive.Universal as UniFilter
 import Synthesizer.Plain.Filter.Recursive (Pole(Pole))
 
+import qualified Data.StorableVector.Lazy as SVL
 import qualified Data.StorableVector as SV
+import qualified Data.Map as Map ; import Data.Map (Map)
 
 import qualified LLVM.Core as LLVM
 
-import Control.Arrow (Arrow, arr, (^<<), )
+import System.FilePath ((</>), (<.>), )
+
+import Control.Arrow (arr, second, (^<<), (***), )
 import Control.Category ((.), )
-import Control.Applicative (liftA, liftA3, )
+import Control.Applicative (pure, liftA, liftA3, (<*>), )
 
+import Data.Traversable (Traversable, traverse, forM, )
+
 import NumericPrelude.Numeric
-import NumericPrelude.Base hiding (id, (.), )
+import NumericPrelude.Base hiding ((.), )
 
 
 {-
@@ -63,17 +78,22 @@
 sch - highpass cutoff 1500 Hz
 -}
 
-phoneme ::
-   IO (SampleRate Real -> VoiceMsg.Pitch ->
-       PIO.T (Zip.T MIO.GateChunk (SV.Vector (Stereo.T Vector)))
-             (SV.Vector (Stereo.T Vector)))
-phoneme =
+type
+   VowelSynth =
+      SampleRate Real -> VoiceMsg.Pitch ->
+      PIO.T (Zip.T MIO.GateChunk StereoChunk) StereoChunk
+
+{- |
+Synthesize vowels using bandpass filters.
+-}
+vowelBand :: IO VowelSynth
+vowelBand =
    liftA
-      (\osc sr p ->
+      (\filt sr p ->
          case formants p of
             Nothing -> arr $ const SV.empty
             Just fs ->
-               osc (sr, fs)
+               filt (sr, fs)
                .
                Gate.shorten)
       (CausalP.processIO
@@ -89,7 +109,7 @@
 
 formants :: VoiceMsg.Pitch -> Maybe (Real, Real)
 formants p =
-   case VoiceMsg.fromPitch p - 36 of
+   case VoiceMsg.fromPitch p of
       00 -> Just ( 320,  800) -- u
       02 -> Just ( 500, 1000) -- o
       04 -> Just (1000, 1400) -- a
@@ -101,6 +121,280 @@
       _ -> Nothing
 
 
+{- |
+Synthesize vowels using sampled impulse responses.
+-}
+vowelMask ::
+   IO (Map VoiceMsg.Pitch (SV.Vector Real) -> VowelSynth)
+vowelMask =
+   liftA
+      (\filt dict sr p ->
+         case Map.lookup p dict of
+            Nothing -> arr $ const SV.empty
+            Just mask ->
+               filt (sr, mask)
+               .
+               Gate.shorten)
+      (CausalP.processIO
+         (CausalP.stereoFromMono (FiltNR.convolvePacked (parameter id))))
+
+
+type
+   VowelSynthEnv =
+      SampleRate Real -> Real {- Velocity -} -> VoiceMsg.Pitch ->
+      PIO.T (WithEnvelopeControl StereoChunk) StereoChunk
+
+data EnvelopeType = Continuous | Percussive
+   deriving (Eq, Ord, Show)
+
+data CarrierType = Voiced | Unvoiced | Rasp
+   deriving (Eq, Ord, Show)
+
+data PhonemeType = Filtered EnvelopeType CarrierType | Sampled
+   deriving (Eq, Ord, Show)
+
+{- |
+Like 'vowelMask', but it does not simply open and close the gate abruptly.
+Instead we use an envelope for fading the filtered sound in and out.
+-}
+phonemeMask ::
+   IO (Map VoiceMsg.Pitch (PhonemeType, SV.Vector Real) -> VowelSynthEnv)
+phonemeMask =
+   pure
+      (\filt filtRasp filtNoise smp contEnv percEnv dict sr vel p ->
+         case Map.lookup p dict of
+            Nothing -> arr $ const SV.empty
+            Just (typ, mask) ->
+               case typ of
+                  Filtered env carrier ->
+                     (case carrier of
+                        Voiced -> filt (sr, mask)
+                        Unvoiced -> filtNoise (sr, mask) . arr Zip.first
+                        Rasp ->
+                           filtRasp (sr, (mask,
+                              case sr of
+                                 SampleRate r ->
+                                    SVL.cycle $ SVL.take (round $ r/20) $
+                                    CtrlG.exponential SigG.defaultLazySize
+                                       (r/40) 1)))
+                     .
+                     zipEnvelope
+                        (case env of
+                           Continuous -> contEnv sr vel
+                           Percussive -> percEnv sr vel)
+                  Sampled ->
+                     smp (sr, SVL.fromChunks $ repeat mask)
+                     .
+                     arr Zip.first
+                     .
+                     zipEnvelope (contEnv sr vel))
+   <*> CausalP.processIO
+         (CausalP.envelopeStereo
+          .
+          second
+             (CausalP.stereoFromMono (FiltNR.convolvePacked (parameter id))))
+   <*> CausalP.processIO
+         (CausalP.envelopeStereo
+          .
+          ((CausalP.envelope
+              $< SigPS.pack (SigP.fromStorableVectorLazy (parameter snd)))
+           ***
+           CausalP.stereoFromMono (FiltNR.convolvePacked (parameter fst))))
+   <*> CausalP.processIO
+         (CausalP.envelopeStereo $>
+             traverse
+                (\seed ->
+                   FiltNR.convolvePacked (parameter id) $*
+                   (SigPS.noise seed $ noiseReference 1e7))
+                (Stereo.cons 42 23))
+   <*> CausalP.processIO
+         (let smp = parameter id
+          in  pure ^<<
+              (CausalP.envelope $>
+                 (SigPS.pack $ SigP.fromStorableVectorLazy smp)))
+   <*> stringControlledEnvelope
+   <*> pingControlledEnvelope (Just 0.01)
+
+
+phonemeRr,
+   phonemeU,
+   phonemeO,
+   phonemeA,
+   phonemeOe,
+   phonemeOn,
+   phonemeUe,
+   phonemeAe,
+   phonemeE,
+   phonemeI,
+
+   phonemeNg,
+   phonemeL,
+   phonemeM,
+   phonemeN,
+   phonemeR,
+   phonemeJ,
+
+   phonemeW,
+   phonemeF,
+   phonemeSch,
+   phonemeH,
+   phonemeTh,
+   phonemeIch,
+   phonemeAch,
+   phonemeS,
+
+   phonemeP,
+   phonemeK,
+   phonemeT,
+
+   phonemeB,
+   phonemeG,
+   phonemeD
+      :: (PhonemeType, FilePath)
+phonemeU   = (Filtered Continuous Voiced, "u")
+phonemeO   = (Filtered Continuous Voiced, "o")
+phonemeA   = (Filtered Continuous Voiced, "a")
+phonemeOe  = (Filtered Continuous Voiced, "oe")
+phonemeOn  = (Filtered Continuous Voiced, "on")
+phonemeUe  = (Filtered Continuous Voiced, "ue")
+phonemeAe  = (Filtered Continuous Voiced, "ae")
+phonemeE   = (Filtered Continuous Voiced, "e")
+phonemeI   = (Filtered Continuous Voiced, "i")
+
+phonemeNg  = (Filtered Continuous Voiced, "ng")
+phonemeL   = (Filtered Continuous Voiced, "l")
+phonemeM   = (Filtered Continuous Voiced, "m")
+phonemeN   = (Filtered Continuous Voiced, "n")
+phonemeR   = (Filtered Continuous Voiced, "r")
+phonemeJ   = (Filtered Continuous Voiced, "j")
+
+phonemeW   = (Filtered Continuous Unvoiced, "w")
+phonemeF   = (Filtered Continuous Unvoiced, "f")
+phonemeSch = (Filtered Continuous Unvoiced, "sch")
+phonemeH   = (Filtered Continuous Unvoiced, "h")
+phonemeTh  = (Filtered Continuous Unvoiced, "th")
+phonemeIch = (Filtered Continuous Unvoiced, "ich")
+phonemeAch = (Filtered Continuous Unvoiced, "ach")
+phonemeS   = (Filtered Continuous Unvoiced, "s")
+
+phonemeP  = (Filtered Percussive Unvoiced, "p")
+phonemeK  = (Filtered Percussive Unvoiced, "k")
+phonemeT  = (Filtered Percussive Unvoiced, "t")
+
+phonemeB  = (Filtered Percussive Voiced, "b")
+phonemeG  = (Filtered Percussive Voiced, "g")
+phonemeD  = (Filtered Percussive Voiced, "d")
+
+-- phonemeRr = (Sampled, "r")) :
+phonemeRr = (Filtered Continuous Rasp, "ng")
+
+
+maskNamesKeyboard :: Map VoiceMsg.Pitch (PhonemeType, FilePath)
+maskNamesKeyboard =
+   Map.fromList $
+   zip [VoiceMsg.toPitch 0 ..] $
+
+   phonemeL :   phonemeNg :
+   phonemeM :   phonemeJ :
+   phonemeN :
+   phonemeR :
+                phonemeP :
+   phonemeB :   phonemeK :
+   phonemeG :   phonemeT :
+   phonemeD :
+
+   phonemeU :   phonemeUe :
+   phonemeO :   phonemeOe :
+   phonemeA :
+   phonemeE :   phonemeAe :
+   phonemeI :
+                phonemeRr :
+
+   phonemeW :   phonemeF :
+   phonemeSch :
+   phonemeH :   phonemeTh :
+   phonemeIch : phonemeAch :
+   phonemeS :
+   []
+
+loadMasksKeyboard :: IO (Map VoiceMsg.Pitch (PhonemeType, SV.Vector Real))
+loadMasksKeyboard =
+   fmap (Map.insert (VoiceMsg.toPitch 29)
+           (Filtered Continuous Voiced, SV.singleton 1)) $
+   loadMasks maskNamesKeyboard
+
+
+maskNamesGrouped :: Map VoiceMsg.Pitch (PhonemeType, FilePath)
+maskNamesGrouped =
+   Map.fromList $
+
+   (zip [VoiceMsg.toPitch 0 ..] $
+      phonemeU :
+      phonemeO :
+      phonemeA :
+      phonemeOe :
+      phonemeUe :
+      phonemeAe :
+      phonemeE :
+      phonemeI :
+      phonemeOn :
+      [])
+   ++
+   (zip [VoiceMsg.toPitch 16 ..] $
+      phonemeJ :
+      phonemeL :
+      phonemeM :
+      phonemeN :
+      phonemeNg :
+      phonemeR :
+      [])
+   ++
+   (zip [VoiceMsg.toPitch 32 ..] $
+      phonemeW :
+      phonemeF :
+      phonemeSch :
+      phonemeH :
+      phonemeTh :
+      phonemeIch :
+      phonemeAch :
+      phonemeS :
+      [])
+   ++
+   (zip [VoiceMsg.toPitch 48 ..] $
+      phonemeRr :
+      [])
+   ++
+   (zip [VoiceMsg.toPitch 64 ..] $
+      phonemeP :
+      phonemeK :
+      phonemeT :
+      [])
+   ++
+   (zip [VoiceMsg.toPitch 80 ..] $
+      phonemeB :
+      phonemeG :
+      phonemeD :
+      [])
+
+loadMasksGrouped :: IO (Map VoiceMsg.Pitch (PhonemeType, SV.Vector Real))
+loadMasksGrouped =
+   fmap (Map.insert (VoiceMsg.toPitch 127)
+           (Filtered Continuous Voiced, SV.singleton 8)) $
+   loadMasks maskNamesGrouped
+
+
+loadMasks ::
+   (Traversable dict) =>
+   dict (PhonemeType, FilePath) ->
+   IO (dict (PhonemeType, SV.Vector Real))
+loadMasks maskNames =
+   forM maskNames $ \(typ, name) ->
+      fmap ((,) typ . SV.concat . SVL.chunks) $
+      Sample.load
+         ((if typ==Sampled then "phoneme" else "mask") </> name <.> "wav")
+
+
+
 type Input a = FP.Input (SampleRate Real) a
 
 plugUniFilterParameter ::
@@ -124,7 +418,7 @@
 singleFormant ::
    (Input inp (Control Real),
       (Input inp (Control Real), Input inp (Control Frequency))) ->
-   Input inp (SV.Vector (Stereo.T Vector)) ->
+   Input inp StereoChunk ->
    FP.T (SampleRate Real) pl inp (Stereo.T VectorValue)
 singleFormant (amp, (reson, freq)) x =
    CausalP.envelopeStereo $&
@@ -139,8 +433,8 @@
 filterFormant ::
    IO (SampleRate Real ->
        PIO.T
-          (Zip.T FormantControl (SV.Vector (Stereo.T Vector)))
-          (SV.Vector (Stereo.T Vector)))
+          (Zip.T FormantControl StereoChunk)
+          StereoChunk)
 filterFormant =
    liftA
       (\filt sr -> filt sr (sr, ()))
@@ -153,8 +447,8 @@
                      (Zip.T FormantControl
                          (Zip.T FormantControl
                              (Zip.T FormantControl FormantControl))))
-                 (SV.Vector (Stereo.T Vector)))
-             (SV.Vector (Stereo.T Vector)))
+                 StereoChunk)
+             StereoChunk)
 filterFormants =
    liftA
       (\filt sr -> filt sr (sr, ()))
diff --git a/src/Synthesizer/LLVM/Server/CausalPacked/SpeechExplore.hs b/src/Synthesizer/LLVM/Server/CausalPacked/SpeechExplore.hs
new file mode 100644
--- /dev/null
+++ b/src/Synthesizer/LLVM/Server/CausalPacked/SpeechExplore.hs
@@ -0,0 +1,358 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+module Main where
+
+import Synthesizer.LLVM.Server.Common (Real, )
+
+import qualified Synthesizer.LLVM.Server.SampledSound as Sample
+import qualified Sound.Sox.Write as SoxWrite
+
+import qualified Graphics.Gnuplot.Advanced as Plot
+import qualified Graphics.Gnuplot.Terminal.WXT as WXT
+import qualified Graphics.Gnuplot.Plot.TwoDimensional as Plot2D
+import qualified Graphics.Gnuplot.Graph.TwoDimensional as Graph2D
+
+import Synthesizer.LLVM.CausalParameterized.Process (($*), ($<), ($<#), )
+import qualified Synthesizer.LLVM.CausalParameterized.Controlled as CtrlP
+import qualified Synthesizer.LLVM.CausalParameterized.Process as CausalP
+import qualified Synthesizer.LLVM.Parameterized.Signal as SigP
+import qualified Synthesizer.LLVM.Filter.FirstOrder as Filt1
+import qualified Synthesizer.LLVM.Filter.NonRecursive as FiltNR
+
+import qualified Synthesizer.Plain.Filter.Recursive.Universal as UniFilter
+import qualified Synthesizer.Plain.Filter.Recursive.FirstOrder as FirstOrder
+import Synthesizer.Plain.Filter.Recursive (Pole(Pole))
+
+import qualified Synthesizer.Generic.Filter.NonRecursive as FiltNRG
+import qualified Synthesizer.Generic.Fourier as Fourier
+import qualified Synthesizer.Generic.Analysis as Analysis
+import qualified Synthesizer.Generic.Signal as SigG
+import qualified Synthesizer.Generic.Piece as Piece
+import qualified Synthesizer.Causal.Filter.NonRecursive as FiltNRC
+import qualified Synthesizer.Causal.Process as Causal
+import qualified Synthesizer.State.Signal as SigS
+import Synthesizer.Piecewise ((#|-), (-|#), (#|), (|#), )
+
+import qualified Data.StorableVector.Lazy.Pattern as SVP
+import qualified Data.StorableVector.Lazy as SVL
+import qualified Data.StorableVector as SV
+import Foreign.Storable (Storable)
+
+import Control.Arrow (arr, (<<<), (^<<), )
+import Control.Category ((.), id, )
+
+import Control.Functor.HT (void, )
+
+import qualified Data.List.HT as ListHT
+import qualified Data.List as List
+import Data.Foldable (forM_, )
+import Data.Maybe.HT (toMaybe, )
+import Data.Maybe (catMaybes, )
+import Data.Tuple.HT (mapSnd, )
+import Data.Ord.HT (comparing, )
+import Data.Monoid (mempty, mappend, )
+
+import System.FilePath ((</>), (<.>), )
+
+import qualified Number.Complex as Complex
+
+import NumericPrelude.Numeric
+import NumericPrelude.Base hiding (id, (.), )
+
+
+sampleRateInt :: Int
+sampleRateInt = 44100
+
+sampleRate :: Real
+sampleRate = fromIntegral sampleRateInt
+
+spectrum :: SVL.Vector Real -> SVL.Vector Real
+spectrum xs =
+   SVL.map Complex.magnitude $
+   SVL.take (div (SVL.length xs) 2) $
+   Fourier.transformBackward $
+   SVL.map Complex.fromReal xs
+
+timeDomain :: SVL.Vector Real -> SVL.Vector (Complex.T Real)
+timeDomain xs =
+   Fourier.transformForward $
+   SVL.append
+      (SVL.map Complex.fromReal xs)
+      (SVL.replicate SVL.defaultChunkSize (SVL.length xs) 0)
+
+chop :: Int -> SVL.Vector Real -> [SVL.Vector Real]
+chop n =
+   map (SVL.take n) .
+   takeWhile (not . SVL.null) .
+   iterate (SVL.drop n)
+
+spectrumPlot :: SVL.Vector Real -> Plot2D.T Real Real
+spectrumPlot xs =
+   let k = sampleRate / fromIntegral (SVL.length xs)
+       step = 16
+       avg chunk = SVL.foldl (+) zero chunk / fromIntegral step
+   in  Plot2D.list Graph2D.lines $
+       zip (iterate (fromIntegral step * k +) 0) $
+       map avg $ chop step $
+       spectrum xs
+
+plotSpectrum :: SVL.Vector Real -> IO ()
+plotSpectrum xs =
+   void $
+   Plot.plot WXT.cons $
+   spectrumPlot xs
+
+saveSound :: FilePath -> SVL.Vector Real -> IO ()
+saveSound path xs =
+   void $ SoxWrite.simple SVL.hPut mempty path sampleRateInt xs
+
+
+-- * modelling formants using bandpass filters
+
+type Formant a = (UniFilter.Result a -> a, Pole Real, Real)
+
+formants_a_noise :: [Formant a]
+formants_a_noise =
+   (UniFilter.bandpass, Pole 20 900, 1) :
+   (UniFilter.bandpass, Pole 20 1200, 0.4) :
+   (UniFilter.bandpass, Pole 10 2600, 0.07) :
+   []
+
+formants_f :: [Formant a]
+formants_f =
+   (UniFilter.lowpass, Pole 2 4000, 0.6) :
+   (UniFilter.lowpass, Pole 2 11000, 0.3) :
+   []
+
+formants_sch :: [Formant a]
+formants_sch =
+   (UniFilter.bandpass, Pole 5 1500, 1.3) :
+   (UniFilter.lowpass, Pole 2 3000, 0.6) :
+   []
+
+synthesis :: IO (SVL.ChunkSize -> () -> SVL.Vector Real)
+synthesis =
+   SigP.runChunky $
+      (sum (map (\(typ, Pole q f, amp) ->
+                   CausalP.amplify (return amp)
+                   <<<
+                   typ
+                   ^<<
+                   CtrlP.process
+                   $<
+                   (SigP.constant $ return $
+                    UniFilter.parameter $ Pole q $ f / sampleRate))
+                formants_sch)
+        $* SigP.noise 174373 0.02)
+
+compareSpec ::IO ()
+compareSpec = do
+   sampled <- Sample.load "phoneme/sch.wav"
+   synthesized <- synthesis
+   void $ Plot.plot WXT.cons $
+      spectrumPlot sampled
+      `mappend`
+      spectrumPlot
+         (SVL.take (SVL.length sampled) $
+          synthesized (SVL.chunkSize 4096) ())
+
+render ::IO ()
+render = do
+   synthesized <- synthesis
+   saveSound "sch-synth.wav" $
+      SVL.take sampleRateInt $
+      synthesized (SVL.chunkSize 4096) ()
+
+
+-- * purification of sampled periods
+
+-- ** using a comb filter
+
+type Comb = (Real, Int) -> SVL.Vector Real -> SVL.Vector Real
+
+makeComb :: IO Comb
+makeComb =
+   CausalP.runStorableChunky $ CausalP.comb (arr fst) (arr snd)
+
+makeHighComb :: IO Comb
+makeHighComb =
+   CausalP.runStorableChunky $
+      CausalP.comb (arr fst) (arr snd)
+      .
+      (Filt1.highpassCausal $<# FirstOrder.parameter (1000/sampleRate))
+
+{- |
+Take n values from the end of the vector in a lazy way.
+-}
+takeEnd :: (Storable a) => Int -> SVL.Vector a -> SVL.Vector a
+takeEnd n xs =
+   SVP.drop (SVP.length (SVL.drop n xs)) xs
+
+scorePeriod :: Comb -> Real -> Int -> SVL.Vector Real -> (Real, SVL.Vector Real)
+scorePeriod comb gain period sig =
+   let end = takeEnd (3*period) $ comb (gain, period) sig
+   in  (Analysis.volumeEuclideanSqr end, end)
+
+vowelNames :: [String]
+vowelNames = ["a", "e", "i", "o", "on", "u", "oe", "ue", "ae"]
+
+tonalNames :: [String]
+tonalNames = vowelNames ++ ["l", "m", "n", "ng", "r", "j"]
+
+sibilantNames :: [String]
+sibilantNames = ["f", "h", "w", "s", "sch", "th", "ich", "ach"]
+
+stopConsonantNames :: [String]
+stopConsonantNames = ["p", "k", "t", "b", "g", "d"]
+
+scanPeriods ::IO ()
+scanPeriods = do
+   comb <- makeComb
+   forM_ tonalNames $ \name -> do
+      let path = "phoneme" </> name <.> "wav"
+      sampled <- Sample.load path
+      putStrLn path
+      let scores =
+             flip map [350 .. 400] $ \period ->
+                (period,
+                 flip map [0.9, 0.99, 0.999] $ \gain ->
+                    fst $ scorePeriod comb gain period sampled)
+      -- mapM_ print scores
+      putStrLn $
+         "maximum: " ++
+         show (List.maximumBy (comparing snd) $ map (mapSnd maximum) scores)
+
+
+normalize :: SVL.Vector Real -> SVL.Vector Real
+normalize =
+   FiltNRG.normalize ((4*) . Analysis.volumeEuclidean)
+
+
+{-
+We use the zero with the least derivative
+in order to reduce jumps at the loop point.
+In order to further reduce jumps, we cross-fade two adjacent periods.
+It must be @length period3 = 3*len@.
+@period3@ must contain a zero in the center chunk of size @len@.
+-}
+bestRotation :: Int -> SVL.Vector Real -> SVL.Vector Real
+bestRotation len period3 =
+   let start =
+          fst $
+          List.minimumBy (comparing snd) $ catMaybes $
+          zipWith (fmap . (,)) [0..] $
+          ListHT.mapAdjacent
+             (\x y -> toMaybe (signum x /= signum y) (abs(x-y))) $
+          SVL.unpack $ SVL.take len $ SVL.drop (len-1) period3
+   in  Causal.apply
+          (Causal.applyFst
+              (FiltNRC.crossfade len)
+              (SVL.drop (start+len) period3))
+          (SVL.drop start period3)
+
+findPeriod :: Comb -> SVL.Vector Real -> SVL.Vector Real
+findPeriod comb sampled =
+   normalize $
+   uncurry bestRotation $
+   mapSnd snd $
+   List.maximumBy (comparing (fst . snd)) $
+   flip map [350 .. 400] $ \period ->
+      (period, scorePeriod comb 0.99 period sampled)
+
+extractPeriods ::IO ()
+extractPeriods = do
+   comb <- makeHighComb
+   forM_ tonalNames $ \name -> do
+      let readPath = "phoneme" </> name <.> "wav"
+      sampled <- Sample.load readPath
+      putStrLn readPath
+      let writePath = "mask" </> name <.> "wav"
+      saveSound writePath $ findPeriod comb sampled
+
+
+-- ** using the frequency spectrum
+
+makeFilter :: IO (SV.Vector Real -> SVL.Vector Real -> SVL.Vector Real)
+makeFilter =
+   CausalP.runStorableChunky $ FiltNR.convolve id
+
+normalizeMax :: SVL.Vector Real -> SVL.Vector Real
+normalizeMax = FiltNRG.normalize Analysis.volumeMaximum
+
+envelope :: Int -> SVL.Vector Real
+envelope sizeInt =
+   let size = fromIntegral sizeInt
+       rampSize = size / 8
+   in  Piece.run SigG.defaultLazySize $
+          0  |# (rampSize, Piece.cosine) #|-
+          1 -|# (size-2*rampSize, Piece.step) #|-
+          1 -|# (rampSize, Piece.cosine) #| (0::Float)
+
+data Transfer =
+   Transfer {
+      transferSpectrum,
+      transferShrunkenSpectrum,
+      transferEnvelope,
+      transferWindow :: SVL.Vector Real
+   }
+
+transfer :: SVL.Vector Real -> Transfer
+transfer sampled =
+   let halfResponseSize = 256
+       responseSize = 2*halfResponseSize
+       halfShrink = div (SVL.length sampled) (2*responseSize)
+       shrink = 2*halfShrink
+       spec = spectrum $ SVL.take (shrink*responseSize) sampled
+       shrunkenSpec =
+          SigG.fromState SigG.defaultLazySize $
+          SigS.init $ SigS.cons 0 $ SigS.map SigG.sum $
+          SigG.sliceVertical shrink $ SVL.drop halfShrink spec
+       env = envelope responseSize
+       window =
+          FiltNRG.envelope env $
+          uncurry (flip SVL.append) $
+          SVL.splitAt halfResponseSize $
+          normalizeMax $ SVL.map Complex.real $
+          timeDomain shrunkenSpec
+   in  Transfer {
+          transferSpectrum = spec,
+          transferShrunkenSpectrum = shrunkenSpec,
+          transferEnvelope = env,
+          transferWindow = window
+       }
+
+testTransfer ::IO ()
+testTransfer = do
+   sampled <- Sample.load "phoneme/o-noise.wav"
+   filt <- makeFilter
+   let trans = transfer sampled
+   saveSound "/tmp/spectrum.wav" $
+      normalizeMax $ transferSpectrum trans
+   saveSound "/tmp/shrunkenspectrum.wav" $
+      normalizeMax $ transferShrunkenSpectrum trans
+   saveSound "/tmp/envelope.wav" $ transferEnvelope trans
+   saveSound "/tmp/window.wav" $ transferWindow trans
+   let window = SV.concat $ SVL.chunks $ transferWindow trans
+   saveSound "/tmp/filtered.wav" $
+      filt window $ SVL.concat $ replicate 100 $ SVL.cons 1 $
+      SVL.replicate SVL.defaultChunkSize 380 0
+   saveSound "/tmp/chirp.wav" $
+      filt window $ SVL.concat $
+      map (\n -> SVL.cons 1 $ SVL.replicate SVL.defaultChunkSize n 0) $
+      [350..450]
+
+transferMasks ::IO ()
+transferMasks = do
+--   forM_ (map (++"-noise") vowelNames) $ \name -> do
+   forM_ (tonalNames++sibilantNames++stopConsonantNames) $ \name -> do
+      let readPath = "phoneme" </> name <.> "wav"
+      sampled <- Sample.load readPath
+      putStrLn readPath
+      let writePath = "mask" </> name <.> "wav"
+      let trans = transfer sampled
+      saveSound writePath $ normalize $ transferWindow trans
+      let spectrumPath = "/tmp" </> "spec-" ++ name <.> "wav"
+      saveSound spectrumPath $ normalizeMax $ transferShrunkenSpectrum trans
+
+
+main :: IO ()
+main = transferMasks
diff --git a/src/Synthesizer/LLVM/Server/Common.hs b/src/Synthesizer/LLVM/Server/Common.hs
--- a/src/Synthesizer/LLVM/Server/Common.hs
+++ b/src/Synthesizer/LLVM/Server/Common.hs
@@ -1,9 +1,9 @@
 {-# LANGUAGE TypeFamilies #-}
 module Synthesizer.LLVM.Server.Common (
-   Real,
+   Real, Param,
    SampleRate(SampleRate),
    Instrument,
-   frequency, time, number, control, signal, parameter,
+   frequency, time, noiseReference, number, control, signal, parameter,
    frequencyConst, timeConst,
    ($/),
 
@@ -53,35 +53,41 @@
 
 type Real = Float
 
+type Param p = Param.T (SampleRate Real, p)
+
 type Instrument a sig = SampleRate a -> MidiSt.Instrument a sig
 
 
-frequency :: (p -> Real) -> Param.T (SampleRate Real, p) Real
+frequency :: (p -> Real) -> Param p Real
 frequency param =
    arr (\(SampleRate sampleRate, p) -> param p / sampleRate)
 
-time :: (p -> Real) -> Param.T (SampleRate Real, p) Real
+time :: (p -> Real) -> Param p Real
 time param =
    arr (\(SampleRate sampleRate, p) -> param p * sampleRate)
 
-number :: (p -> Real) -> Param.T (SampleRate Real, p) Real
+noiseReference :: Real -> Param p Real
+noiseReference freq =
+   arr (\(SampleRate sampleRate, _p) -> sampleRate/freq)
+
+number :: (p -> Real) -> Param p Real
 number param = arr (param . snd)
 
-control :: (p -> PC.T Real) -> Param.T (SampleRate Real, p) (PC.T Real)
+control :: (p -> PC.T Real) -> Param p (PC.T Real)
 control param = arr (param . snd)
 
-signal :: (p -> SigSt.T a) -> Param.T (SampleRate Real, p) (SigSt.T a)
+signal :: (p -> SigSt.T a) -> Param p (SigSt.T a)
 signal param = arr (param . snd)
 
-parameter :: (p -> a) -> Param.T (SampleRate Real, p) a
+parameter :: (p -> a) -> Param p a
 parameter param = arr (param . snd)
 
 
-frequencyConst :: Real -> Param.T (SampleRate Real, p) Real
+frequencyConst :: Real -> Param p Real
 frequencyConst param =
    arr (\(SampleRate sampleRate, _p) -> param / sampleRate)
 
-timeConst :: Real -> Param.T (SampleRate Real, p) Real
+timeConst :: Real -> Param p Real
 timeConst param =
    arr (\(SampleRate sampleRate, _p) -> param * sampleRate)
 
diff --git a/src/Synthesizer/LLVM/Server/CommonPacked.hs b/src/Synthesizer/LLVM/Server/CommonPacked.hs
--- a/src/Synthesizer/LLVM/Server/CommonPacked.hs
+++ b/src/Synthesizer/LLVM/Server/CommonPacked.hs
@@ -1,4 +1,7 @@
-module Synthesizer.LLVM.Server.CommonPacked where
+module Synthesizer.LLVM.Server.CommonPacked (
+   module Synthesizer.LLVM.Server.CommonPacked,
+   Param,
+   ) where
 
 import Synthesizer.LLVM.Server.Common
 
@@ -7,9 +10,8 @@
 import qualified Synthesizer.LLVM.CausalParameterized.Process as CausalP
 import qualified Synthesizer.LLVM.CausalParameterized.Functional as F
 import qualified Synthesizer.LLVM.Parameterized.Signal as SigP
-import qualified Synthesizer.LLVM.Parameter as Param
 
-import qualified Data.List.Match as Match
+import qualified Data.NonEmpty as NonEmpty
 
 import qualified Algebra.Additive as Additive
 
@@ -22,14 +24,8 @@
 
 
 sumNested :: (Additive.C a) => [a] -> a
-sumNested [] = Additive.zero
-sumNested xs@(_:rs) =
-   let ys = xs ++ Match.take rs (sum2 ys)
-   in  last ys
-
-sum2 :: (Additive.C a) => [a] -> [a]
-sum2 (x:y:rest) = (x+y) : sum2 rest
-sum2 xs = xs
+sumNested =
+   maybe Additive.zero (NonEmpty.foldBalanced (+)) . NonEmpty.fetch
 
 
 -- maybe this can be merged into a PCS.controllerDiscrete
@@ -40,7 +36,6 @@
    in  n + 0.01*r
 
 
-type Param p = Param.T (SampleRate Real, p)
 type SigP p = SigP.T (SampleRate Real, p)
 type CausalP p = CausalP.T (SampleRate Real, p)
 type FuncP p = F.T (SampleRate Real, p)
@@ -63,7 +58,3 @@
 vectorTime param =
    arr (\(SampleRate sampleRate, p) ->
           param p * sampleRate / fromIntegral vectorSize)
-
-noiseReference :: Real -> Param p Real
-noiseReference freq =
-   arr (\(SampleRate sampleRate, _p) -> sampleRate/freq)
diff --git a/src/Synthesizer/LLVM/Server/Packed/Instrument.hs b/src/Synthesizer/LLVM/Server/Packed/Instrument.hs
--- a/src/Synthesizer/LLVM/Server/Packed/Instrument.hs
+++ b/src/Synthesizer/LLVM/Server/Packed/Instrument.hs
@@ -81,8 +81,6 @@
 import qualified Synthesizer.MIDI.PiecewiseConstant as PC
 import qualified Synthesizer.MIDI.EventList as Ev
 
-import System.FilePath ((</>), )
-
 import Synthesizer.MIDI.Storable (chunkSizesFromLazyTime, )
 
 import qualified Synthesizer.LLVM.Frame.Stereo as Stereo
@@ -103,7 +101,7 @@
 import qualified Synthesizer.LLVM.Wave as WaveL
 import Synthesizer.LLVM.CausalParameterized.Process (($<), ($>), ($*), )
 import Synthesizer.LLVM.CausalParameterized.Functional (($&), (&|&), )
-import Synthesizer.LLVM.Parameterized.Signal (($#), )
+import Synthesizer.LLVM.Parameter (($#), )
 
 import qualified LLVM.Extra.Monad as LM
 import qualified LLVM.Extra.Arithmetic as A
@@ -1375,7 +1373,7 @@
          let fmSig =
                 freqMod
                    (chunkSizesFromLazyTime (PC.duration fm))
-                   (sr, (fm, freq * Sample.period smp)) :: SigSt.T Vector
+                   (sr, (fm, freq * Sample.period pos)) :: SigSt.T Vector
              pos = Sample.positions smp
              amp = 2 * amplitudeFromVelocity vel
              (attack, sustain, release) = Sample.parts smp
@@ -1427,7 +1425,7 @@
                 SVP.splitAt (chunkSizesFromLazyTime dur) $
                 (freqMod
                    (chunkSizesFromLazyTime (PC.duration fm))
-                   (sr, (fm, freq * Sample.period smp)) :: SigSt.T Vector)
+                   (sr, (fm, freq * Sample.period pos)) :: SigSt.T Vector)
              pos = Sample.positions smp
              amp = 2 * amplitudeFromVelocity vel
              (attack, sustain, release) = Sample.parts smp
@@ -1454,25 +1452,3 @@
                  (CausalPS.amplify 1.001)))
       (SigP.runChunkyPattern
          (frequencyFromBendModulation (frequencyConst 3) (modulation id)))
-
-
--- ToDo: flag failure if files cannot be found, or just remain silent
-makeSampledSounds ::
-   FilePath ->
-   Sample.Info ->
-   IO [-- PC.T Real ->
-       PC.T (BM.T Real) ->
-       Instrument Real (Stereo.T Vector)]
-makeSampledSounds dir (file, positions, period) = do
-{-
-   sound <-
-      (SoxRead.withHandle1 (SVL.hGetContentsSync chunkSize) =<<
-       SoxRead.open SoxOption.none "speech/tomatensalat2.wav")
-   play (44100::Real) (sound::SVL.Vector Real)
--}
-   liftA2
-      (\makeSmp smp ->
-          map (\pos -> makeSmp (Sample.Cons smp pos period))
-             positions)
-      sampledSound
-      (Sample.load (dir </> file))
diff --git a/src/Synthesizer/LLVM/Server/SampledSound.hs b/src/Synthesizer/LLVM/Server/SampledSound.hs
--- a/src/Synthesizer/LLVM/Server/SampledSound.hs
+++ b/src/Synthesizer/LLVM/Server/SampledSound.hs
@@ -5,12 +5,15 @@
 import qualified Sound.Sox.Read          as SoxRead
 import qualified Sound.Sox.Option.Format as SoxOption
 import Control.Exception (bracket, )
+import System.FilePath ((</>), )
 
 import qualified Synthesizer.Storable.Signal      as SigSt
 import qualified Data.StorableVector.Lazy         as SVL
 
 import Data.Tuple.HT (mapPair, )
 
+import qualified Number.DimensionTerm as DN
+
 import Prelude hiding (Real, length, )
 
 
@@ -18,14 +21,15 @@
 data T =
    Cons {
       body :: SigSt.T Real,
-      positions :: Positions,
-      period :: Real
+      sampleRate :: DN.Frequency Real,
+      positions :: Positions
    }
 
 data Positions =
    Positions {
       start, length,
-      loopStart, loopLength :: Int
+      loopStart, loopLength :: Int,
+      period :: Real
    }
 
 
@@ -34,10 +38,22 @@
    bracket (SoxRead.open SoxOption.none path) SoxRead.close $
    SoxRead.withHandle1 (SVL.hGetContentsSync SVL.defaultChunkSize)
 
+loadRanges :: FilePath -> Info -> IO [T]
+loadRanges dir (Info file sr poss) =
+   fmap
+      (\smp -> map (Cons smp (DN.frequency sr)) poss)
+      (load (dir </> file))
 
-type Info = (FilePath, [Positions], Real)
 
+data
+   Info =
+      Info {
+         infoName :: FilePath,
+         infoRate :: Real,
+         infoPositions :: [Positions]
+      }
 
+
 parts :: T -> (SigSt.T Real, SigSt.T Real, SigSt.T Real)
 parts smp =
    let pos = positions smp
@@ -59,42 +75,50 @@
 
 tomatensalatPositions :: [Positions]
 tomatensalatPositions =
-   Positions      0 29499  12501 15073 :
-   Positions  29499 31672  38163 17312 :
-   Positions  67379 28610  81811 10667 :
-   Positions  95989 31253 106058 16111 :
-   Positions 127242 38596 136689 11514 :
+   Positions      0 29499  12501 15073 321.4 :
+   Positions  29499 31672  38163 17312 320.6 :
+   Positions  67379 28610  81811 10667 323.2 :
+   Positions  95989 31253 106058 16111 323.7 :
+   {-
+   vor dem 't' kommt noch das Ende vom 'a'
+   wir bräuchten eine weitere Positionsangabe,
+   um am Ende etwas überspringen zu können.
+   Ein Smart-Konstruktor wie 'positions'
+   könnte das bisherige Verhalten nachmachen.
+   -}
+   Positions 127242 38596 136689 11514 319.3 :
    []
 
+
 tomatensalat :: Info
 tomatensalat =
-   ("tomatensalat2.wav", tomatensalatPositions, 324.5)
+   Info "tomatensalat2.wav" 44100 tomatensalatPositions
 
 
 halPositions :: [Positions]
 halPositions =
 --   Positions   2371 25957   7362  6321 :
-   Positions   2371 25957 (2371+25957) 1 :
-   Positions  40546 34460  63540  9546 :
-   Positions  79128 32348  94367 14016 :
-   Positions 112027 21227 125880  5500 :
-   Positions 146057 23235 168941   352 :
+   Positions   2371 25957 (2371+25957) 1 320 :
+   Positions  40546 34460  63540  9546 317.4 :
+   Positions  79128 32348  94367 14016 317.8 :
+   Positions 112027 21227 125880  5500 322.5 :
+   Positions 146057 23235 168941   352 320 :
    []
 
 hal :: Info
 hal =
-   ("haskell-in-leipzig2.wav", halPositions, 316)
+   Info "haskell-in-leipzig2.wav" 44100 halPositions
 
 
 graphentheoriePositions :: [Positions]
 graphentheoriePositions =
-   Positions      0 29524  13267 14768 :
-   Positions  29524 35333  47624  9968 :
-   Positions  64857 31189  73818 16408 :
-   Positions  96046 31312 106206 18504 :
-   Positions 127358 32127 132469 16530 :
+   Positions      0 29524  13267 14768 301.1 :
+   Positions  29524 35333  47624  9968 301.6 :
+   Positions  64857 31189  73818 16408 297.3 :
+   Positions  96046 31312 106206 18504 302.9 :
+   Positions 127358 32127 132469 16530 299.4 :
    []
 
 graphentheorie :: Info
 graphentheorie =
-   ("graphentheorie0.wav", graphentheoriePositions, 301.15)
+   Info "graphentheorie0.wav" 44100 graphentheoriePositions
diff --git a/src/Synthesizer/LLVM/Server/SampledSoundAnalysis.hs b/src/Synthesizer/LLVM/Server/SampledSoundAnalysis.hs
new file mode 100644
--- /dev/null
+++ b/src/Synthesizer/LLVM/Server/SampledSoundAnalysis.hs
@@ -0,0 +1,143 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+module Main where
+-- module Synthesizer.LLVM.Server.SampledSoundAnalysis where
+
+import qualified Synthesizer.LLVM.Server.SampledSound as Sample
+
+import Synthesizer.LLVM.Server.Common (Real, )
+
+import qualified Graphics.Gnuplot.Advanced as Plot
+import qualified Graphics.Gnuplot.Plot.TwoDimensional as Plot2D
+import qualified Graphics.Gnuplot.Graph.TwoDimensional as Graph2D
+
+import qualified Synthesizer.Generic.Fourier as Fourier
+import qualified Synthesizer.Generic.Signal  as SigG
+
+import qualified Synthesizer.State.Signal         as SigS
+import qualified Synthesizer.Storable.Signal      as SigSt
+import qualified Data.StorableVector.Lazy         as SVL
+
+import qualified Data.Foldable as Fold
+import Control.Functor.HT (void, )
+import Control.Monad (when, )
+import Data.Tuple.HT (snd3, )
+import Data.Monoid ((<>), )
+import Data.Ord.HT (comparing, )
+
+import qualified Number.Complex as Complex
+import qualified Algebra.Field as Field
+import qualified Algebra.Additive as Additive
+
+import NumericPrelude.Numeric
+import NumericPrelude.Base hiding (id, )
+import Prelude ()
+
+{-
+I want to find the maximum of a peak with sub-sample precision.
+Model: Lay parabola through maximum point and its left and right neighbors.
+
+Parabola through three points: (-1,a), (0,b), (1,c):
+
+Lagrange polynomial L_i:
+
+f(t) = a*L_-1(t) + b*L_0(t) + c*L_1(t)
+  = a*t*(t-1)/2 - b*(t+1)*(t-1) + c*t*(t+1)/2
+  = a*(t^2-t)/2 + b*(1-t^2) + c*(t^2+t)/2
+
+0 =!= f'(t)
+  = a*L_-1'(t) + b*L_0'(t) + c*L_1'(t)
+  = a*(2*t-1)/2 - b*2*t + c*(2*t+1)/2
+0 = a*(2*t-1) - b*4*t + c*(2*t+1)
+  = c-a + (2*a - 4*b + 2*c)*t
+t = (a-c) / (2*a - 4*b + 2*c)
+  = (c-a) / (2 * (2*b - a - c))
+
+t is always between -0.5 and 0.5.
+An SMT solver at least is convinced of it:
+
+Prelude Data.SBV> prove $ \(a::SReal) (b::SReal) (c::SReal) -> a.<b &&& c.<b ==> abs ((a-c) / (a - 2*b + c)) .<= 1
+Q.E.D.
+
+Precondition: a>=0, b>=0, c>=0, a<b, c<b:
+
+2*c  <  2*b
+c  <  2*b - c
+c-a  <  2*b - a - c
+
+=> t<0.5
+
+p = b-a
+q = b-c
+
+t = (p-q)/(2*(p+q))
+
+Parabola maximum is invariant with respect to vertical shifts.
+
+For non-negative data like in the absolute spectrum
+this would not be a good model.
+In this case we could model a peak with a Gaussian.
+Essentially this means to apply the parabola model
+to the logarithms of the non-negative values.
+
+However, autocorrelation data can contain negative values.
+-}
+{- |
+The three numbers must not be equal,
+and the center value must be the largest one.
+-}
+peakMaximum :: (Field.C a) => (a,a,a) -> a
+peakMaximum (a,b,c) =
+   (c-a) / (2 * (2*b - a - c))
+
+
+{-
+weight autocorrelation coefficients
+since the later ones are computed from less overlapped signal parts.
+
+However, this emphasises later coefficients
+and in one case the wrong maximum is chosen this way.
+-}
+weight :: Int -> SVL.Vector Real -> SVL.Vector Real
+weight len =
+   SigG.zipWithState (\w c -> c / fromIntegral w)
+      (SigS.takeWhile (>0) $
+       SigS.iterate (subtract 1) len)
+
+autocorrelation :: SVL.Vector Real -> SVL.Vector Real
+autocorrelation xs =
+   SigSt.map Complex.real $
+   Fourier.transformForward $
+   SigSt.map (Complex.fromReal . Complex.magnitudeSqr) $
+   Fourier.transformBackward $
+   SigSt.map Complex.fromReal xs <> SigSt.map (const Additive.zero) xs
+
+argMax :: (Ord a) => [a] -> Int
+argMax =
+   fst . Fold.maximumBy (comparing snd) .
+   zip (iterate succ 0)
+
+main :: IO ()
+main =
+   Fold.forM_ [Sample.tomatensalat, Sample.hal, Sample.graphentheorie] $
+         \info -> do
+      putStrLn $ Sample.infoName info
+      ranges <- Sample.loadRanges "speech" info
+      Fold.forM_ ranges $ \smp ->
+         let ignoreBeginning = 30
+             body = snd3 $ Sample.parts smp
+             ac =
+                SVL.take (SVL.length body `div` 2) $
+                -- weight (SVL.length body) $
+                autocorrelation body
+             maxi =
+                (ignoreBeginning+) $ argMax $ SigSt.toList $
+                SigSt.drop ignoreBeginning ac
+             a:b:c:_ = SigSt.toList $ SigSt.drop (maxi-1) ac
+         in  if SVL.length body < 1000
+               then putStrLn "no loop"
+               else do
+                  when False $ print $ SVL.length body
+                  when False $ print $ SVL.length ac
+                  when False $ void $ Plot.plotDefault $
+                     Plot2D.list Graph2D.listLines $ SigSt.toList ac
+                  print $ fromIntegral maxi + peakMaximum (a,b,c)
diff --git a/src/Synthesizer/LLVM/Simple/Signal.hs b/src/Synthesizer/LLVM/Simple/Signal.hs
--- a/src/Synthesizer/LLVM/Simple/Signal.hs
+++ b/src/Synthesizer/LLVM/Simple/Signal.hs
@@ -6,28 +6,33 @@
 {-# LANGUAGE ForeignFunctionInterface #-}
 module Synthesizer.LLVM.Simple.Signal where
 
-import qualified Synthesizer.LLVM.Wave as Wave
+import qualified Synthesizer.LLVM.Frame.Stereo as Stereo
 import qualified Synthesizer.LLVM.Frame as Frame
+import qualified Synthesizer.LLVM.Wave as Wave
 import qualified Synthesizer.LLVM.Execution as Exec
-import qualified LLVM.Extra.ForeignPtr as ForeignPtr
-import qualified LLVM.Extra.Memory as Memory
-import qualified LLVM.Extra.ScalarOrVector as SoV
-import qualified LLVM.Extra.MaybeContinuation as Maybe
 
 import qualified Synthesizer.LLVM.Storable.ChunkIterator as ChunkIt
+import qualified Synthesizer.LLVM.Storable.Vector as SVU
 import qualified Data.StorableVector.Lazy as SVL
 import qualified Data.StorableVector as SV
 import qualified Data.StorableVector.Base as SVB
 
-import qualified Synthesizer.LLVM.Frame.Stereo as Stereo
-
+import qualified LLVM.Extra.ForeignPtr as ForeignPtr
+import qualified LLVM.Extra.Memory as Memory
+import qualified LLVM.Extra.ScalarOrVector as SoV
+import qualified LLVM.Extra.MaybeContinuation as MaybeCont
+import qualified LLVM.Extra.Maybe as Maybe
 import qualified LLVM.Extra.Arithmetic as A
 import LLVM.Extra.Arithmetic (advanceArrayElementPtr, )
 import LLVM.Extra.Control (whileLoop, ifThen, )
-import LLVM.Extra.Class (MakeValueTuple, ValueTuple, Undefined, undefTuple, )
+import LLVM.Extra.Class (MakeValueTuple, ValueTuple, undefTuple, )
 
-import LLVM.Core as LLVM
+import qualified LLVM.Core as LLVM
 import LLVM.Util.Loop (Phi, )
+import LLVM.Core
+          (CodeGenFunction, ret, Value, valueOf,
+           IsSized, IsConst, IsArithmetic, IsFloating,
+           Linkage(ExternalLinkage), createNamedFunction)
 
 import Control.Monad (liftM2, liftM3, )
 import Control.Applicative (Applicative, pure, (<*>), liftA2, )
@@ -38,15 +43,13 @@
 import qualified Algebra.Ring as Ring
 import qualified Algebra.Additive as Additive
 
-import Data.Word (Word32, )
+import qualified System.Unsafe as Unsafe
 import Foreign.Storable.Tuple ()
 import Foreign.Storable (Storable, )
-import Foreign.Marshal.Array (advancePtr, )
-import qualified Synthesizer.LLVM.Alloc as Alloc
 import Foreign.ForeignPtr (touchForeignPtr, withForeignPtr, )
-import Foreign.Ptr (FunPtr, nullPtr, )
+import Foreign.Ptr (FunPtr, Ptr, nullPtr, )
+import Data.Word (Word32, )
 import Control.Exception (bracket, )
-import qualified System.Unsafe as Unsafe
 
 import NumericPrelude.Numeric
 import NumericPrelude.Base hiding (and, iterate, map, zip, zipWith, )
@@ -70,7 +73,7 @@
       Cons (forall r c.
             (Phi c) =>
             ioContext ->
-            state -> Maybe.T r c (a, state))
+            state -> MaybeCont.T r c (a, state))
                -- compute next value
            (forall r.
             ioContext ->
@@ -87,7 +90,7 @@
 simple ::
    (Memory.C state) =>
    (forall r c.
-    state -> Maybe.T r c (a, state)) ->
+    state -> MaybeCont.T r c (a, state)) ->
    (forall r. CodeGenFunction r state) ->
    T a
 simple next start =
@@ -104,7 +107,7 @@
    Cons
       (\ioContext sa0 -> do
          (a,sa1) <- next ioContext sa0
-         b <- Maybe.lift $ f a
+         b <- MaybeCont.lift $ f a
          return (b, sa1))
       start
       createIOContext deleteIOContext
@@ -119,7 +122,7 @@
    Cons
       (\ioContext (sa0,ss0) -> do
          (a,sa1) <- next ioContext sa0
-         (b,ss1) <- Maybe.lift $ f a ss0
+         (b,ss1) <- MaybeCont.lift $ f a ss0
          return (b, (sa1,ss1)))
       (\ioContext ->
          liftM2 (,) (start ioContext) startS)
@@ -135,7 +138,7 @@
       (\(ioContextA, ioContextB) (sa0,sb0) -> do
          (a,sa1) <- nextA ioContextA sa0
          (b,sb1) <- nextB ioContextB sb0
-         c <- Maybe.lift $ f a b
+         c <- MaybeCont.lift $ f a b
          return (c, (sa1,sb1)))
       (\(ioContextA, ioContextB) ->
          liftM2 (,)
@@ -198,33 +201,33 @@
 interpolateConstant ::
    (Memory.C a,
     Memory.FirstClass b, Memory.Stored b ~ bm, IsSized b, IsSized bm,
-    Ring.C b,
-    IsFloating b, LLVM.CmpRet b, LLVM.CmpResult b ~ Bool, IsConst b) =>
+    SoV.IntegerConstant b,
+    IsFloating b, LLVM.CmpRet b, LLVM.CmpResult b ~ Bool) =>
    b -> T a -> T a
 interpolateConstant k
       (Cons next start createIOContext deleteIOContext) =
    Cons
       (\ioContext ((y0,state0),ss0) ->
          do ((y1,state1), ss1) <-
-               Maybe.fromBool $
+               MaybeCont.fromBool $
                whileLoop
                   (valueOf True, ((y0,state0), ss0))
                   (\(cont1, (_, ss1)) ->
-                     and cont1 =<< A.fcmp FPOLE ss1 (valueOf 0))
+                     LLVM.and cont1 =<< A.fcmp LLVM.FPOLE ss1 A.zero)
                   (\(_, ((_,state01), ss1)) ->
-                     Maybe.toBool $ liftM2 (,)
+                     MaybeCont.toBool $ liftM2 (,)
                         (next ioContext state01)
-                        (Maybe.lift $ A.add ss1 (valueOf k)))
+                        (MaybeCont.lift $ A.add ss1 (valueOf k)))
 
-            ss2 <- Maybe.lift $ A.sub ss1 (valueOf Ring.one)
+            ss2 <- MaybeCont.lift $ A.sub ss1 A.one
             return (y1, ((y1,state1),ss2)))
 
 {- using this initialization code we would not need undefined values
       (do sa <- start
           (a,_) <- next sa
-          return (sa, a, valueOf 0))
+          return (sa, a, A.zero))
 -}
-      (fmap (\sa -> ((undefTuple, sa), valueOf 0)) . start)
+      (fmap (\sa -> ((undefTuple, sa), A.zero)) . start)
       createIOContext deleteIOContext
 
 
@@ -264,7 +267,7 @@
    Value a -> T (Value a)
 iterate f initial =
    simple
-      (\y -> Maybe.lift $ fmap (\y1 -> (y,y1)) (f y))
+      (\y -> MaybeCont.lift $ fmap (\y1 -> (y,y1)) (f y))
       (return initial)
 
 exponential2 ::
@@ -307,17 +310,17 @@
    SV.Vector a ->
    T value
 fromStorableVector xs =
-   let (fp,s,l) = SVB.toForeignPtr xs
+   let (fp,ptr,l) = SVU.unsafeToPointers xs
    in  Cons
           (\_ (p0,l0) -> do
-             cont <- Maybe.lift $ A.cmp CmpGT l0 (valueOf 0)
-             Maybe.withBool cont $ do
+             cont <- MaybeCont.lift $ A.cmp LLVM.CmpGT l0 A.zero
+             MaybeCont.withBool cont $ do
                 y1 <- Memory.load p0
                 p1 <- advanceArrayElementPtr p0
                 l1 <- A.dec l0
                 return (y1,(p1,l1)))
           (const $ return
-             (valueOf (Memory.castStorablePtr $ Unsafe.foreignPtrToPtr fp `advancePtr` s),
+             (valueOf ptr,
               valueOf (fromIntegral l :: Word32)))
           -- keep the foreign ptr alive
           (return fp)
@@ -334,25 +337,24 @@
    T value
 fromStorableVectorLazy sig =
    Cons
-      (\(stable, lenPtr) (buffer0,length0) -> do
-         (buffer1,length1) <- Maybe.lift $ do
-            nextChunkFn <- staticFunction ChunkIt.nextCallBack
-            needNext <- A.cmp CmpEQ length0 (valueOf 0)
+      (\stable (buffer0,length0) -> do
+         (buffer1,length1) <- MaybeCont.lift $ do
+            nextChunkFn <- LLVM.staticFunction ChunkIt.nextCallBack
+            needNext <- A.cmp LLVM.CmpEQ length0 A.zero
             ifThen needNext (buffer0,length0)
-               (liftM2 (,)
-                   (call nextChunkFn (valueOf stable) (valueOf lenPtr))
-                   (load (valueOf lenPtr)))
-         valid <- Maybe.lift $ A.cmp CmpNE buffer1 (valueOf nullPtr)
-         Maybe.withBool valid $ do
+               (do lenPtr <- LLVM.alloca
+                   liftM2 (,)
+                      (LLVM.call nextChunkFn (valueOf stable) lenPtr)
+                      (LLVM.load lenPtr))
+         valid <- MaybeCont.lift $ A.cmp LLVM.CmpNE buffer1 (valueOf nullPtr)
+         MaybeCont.withBool valid $ do
             x <- Memory.load buffer1
             buffer2 <- advanceArrayElementPtr buffer1
             length2 <- A.dec length1
             return (x, (buffer2,length2)))
-      (const $ return (valueOf nullPtr, valueOf 0))
-      (liftM2 (,) (ChunkIt.new sig) Alloc.malloc)
-      (\(stable,lenPtr) -> do
-          ChunkIt.dispose stable
-          Alloc.free lenPtr)
+      (const $ return (valueOf nullPtr, A.zero))
+      (ChunkIt.new sig)
+      ChunkIt.dispose
 
 
 {-
@@ -380,9 +382,9 @@
             Exec.runFunction $
             createNamedFunction ExternalLinkage "fillsignalblock" $ \ size bPtr -> do
                s <- start ioContext
-               (pos,_) <- Maybe.arrayLoop size bPtr s $ \ ptri s0 -> do
+               (pos,_) <- MaybeCont.arrayLoop size bPtr s $ \ ptri s0 -> do
                   (y,s1) <- next ioContext s0
-                  Maybe.lift $ Memory.store y ptri
+                  MaybeCont.lift $ Memory.store y ptri
                   return s1
                ret (pos :: Value Word32)
          fmap (fromIntegral :: Word32 -> Int) $
@@ -396,8 +398,9 @@
 compileChunky ::
    (Memory.C value, Memory.Struct value ~ struct,
     Memory.C state, Memory.Struct state ~ stateStruct) =>
-   (forall r.
-    state -> Maybe.T r (Value Bool, state) (value, state)) ->
+   (forall r z.
+    (Phi z) =>
+    state -> MaybeCont.T r z (value, state)) ->
    (forall r.
     CodeGenFunction r state) ->
    IO (FunPtr (IO (Ptr stateStruct)),
@@ -424,12 +427,12 @@
          (createNamedFunction ExternalLinkage "fillsignal" $
           \ sptr loopLen ptr -> do
              sInit <- Memory.load sptr
-             (pos,sExit) <- Maybe.arrayLoop loopLen ptr sInit $
+             (pos,sExit) <- MaybeCont.arrayLoop loopLen ptr sInit $
               \ ptri s0 -> do
                 (y,s1) <- next s0
-                Maybe.lift $ Memory.store y ptri
+                MaybeCont.lift $ Memory.store y ptri
                 return s1
-             Memory.store sExit sptr
+             Memory.store (Maybe.fromJust sExit) sptr
              ret (pos :: Value Word32))
 
 
diff --git a/src/Synthesizer/LLVM/Simple/Value.hs b/src/Synthesizer/LLVM/Simple/Value.hs
--- a/src/Synthesizer/LLVM/Simple/Value.hs
+++ b/src/Synthesizer/LLVM/Simple/Value.hs
@@ -7,18 +7,27 @@
 module Synthesizer.LLVM.Simple.Value (
    T, decons,
    twoPi, square, sqrt,
-   max, min, limit,
-   lift0, lift1, lift2,
-   unlift0, unlift1, unlift2,
+   max, min, limit, fraction,
+
+   (%==), (%/=), (%<), (%<=), (%>), (%>=),
+   (%&&), (%||),
+   (?), (??),
+
+   lift0, lift1, lift2, lift3,
+   unlift0, unlift1, unlift2, unlift3, unlift4, unlift5,
    constantValue, constant,
+   fromInteger', fromRational',
 
-   Flatten(flatten, unfold), Registers,
-   flattenTraversable, unfoldFunctor,
+   Flatten(flattenCode, unfoldCode), Registers,
+   flatten, unfold,
+   flattenCodeTraversable, unfoldCodeTraversable,
    flattenFunction,
    ) where
 
+import qualified LLVM.Extra.Control as C
 import qualified LLVM.Extra.Arithmetic as A
 
+import LLVM.Util.Loop (Phi, )
 import LLVM.Core (CodeGenFunction, )
 import qualified LLVM.Core as LLVM
 
@@ -28,6 +37,8 @@
 import qualified Control.Monad.Trans.Class as MT
 import qualified Control.Monad.Trans.State as MS
 import Control.Monad (liftM2, liftM3, )
+import Control.Applicative (Applicative, pure, (<*>), )
+import Control.Functor.HT (unzip, unzip3, )
 
 import qualified Synthesizer.LLVM.Frame.Stereo as Stereo
 
@@ -47,12 +58,13 @@
 import qualified Number.Complex as Complex
 
 import qualified Data.Traversable as Trav
+import qualified Data.Foldable as Fold
 
 import qualified System.Unsafe as Unsafe
 
 import qualified Prelude as P
-import NumericPrelude.Numeric hiding (pi, sqrt, )
-import NumericPrelude.Base hiding (min, max, )
+import NumericPrelude.Numeric hiding (pi, sqrt, fromRational', fraction, )
+import NumericPrelude.Base hiding (min, max, unzip, unzip3, )
 
 
 {-
@@ -75,7 +87,14 @@
 decons value =
    MS.evalStateT (code value) Vault.empty
 
+instance Functor T where
+   fmap f x = consUnique (fmap f (code x))
 
+instance Applicative T where
+   pure = constantValue
+   f <*> x = consUnique (code f <*> code x)
+
+
 type Compute r a =
    MS.StateT Vault.Vault (LLVM.CodeGenFunction r) a
 
@@ -107,16 +126,16 @@
 
 instance (A.PseudoRing a, A.IntegerConstant a) =>
       Ring.C (T a) where
-   one = constantValue (A.fromInteger' 1)
+   one = constantValue A.one
    (*) = lift2 A.mul
-   fromInteger = constantValue . A.fromInteger'
+   fromInteger = fromInteger'
 
 {-
 This instance is enough for Module here.
 The difference to Module instances on Haskell tuples is,
 that LLVM vectors cannot be nested.
 -}
-instance (A.PseudoModule a v, A.IntegerConstant a) =>
+instance (a ~ A.Scalar v, A.PseudoModule v, A.IntegerConstant a) =>
       Module.C (T a) (T v) where
    (*>) = lift2 A.scale
 
@@ -139,8 +158,7 @@
 
 instance (A.Field a, A.RationalConstant a) => Field.C (T a) where
    (/) = lift2 A.fdiv
-   fromRational' =
-      constantValue . A.fromRational' . fromRational'
+   fromRational' = fromRational' . Field.fromRational'
 
 {-
 instance (Cmp a b, Fractional a, IsConst a, IsFloating a) => RealFrac (T a) where
@@ -150,7 +168,7 @@
 instance (A.Transcendental a, A.RationalConstant a) => Algebraic.C (T a) where
    sqrt = lift1 A.sqrt
    root n x = lift2 A.pow x (1 / fromInteger n)
-   x^/r = lift2 A.pow x (fromRational' r)
+   x^/r = lift2 A.pow x (Field.fromRational' r)
 
 instance (A.Transcendental a, A.RationalConstant a) => Trans.C (T a) where
    pi = lift0 A.pi
@@ -168,7 +186,7 @@
 instance
    (A.PseudoRing a, A.Real a, A.IntegerConstant a) =>
       P.Num (T a) where
-   fromInteger = constantValue . A.fromInteger'
+   fromInteger = fromInteger'
    (+) = lift2 A.add
    (-) = lift2 A.sub
    (*) = lift2 A.mul
@@ -179,8 +197,7 @@
 instance
    (A.Field a, A.Real a, A.RationalConstant a) =>
       P.Fractional (T a) where
-   fromRational =
-      constantValue . A.fromRational' . P.fromRational
+   fromRational = fromRational'
    (/) = lift2 A.fdiv
 
 instance
@@ -231,7 +248,10 @@
 limit :: (A.Real a) => (T a, T a) -> T a -> T a
 limit (l,u) = max l . min u
 
+fraction :: (A.Fraction a) => T a -> T a
+fraction = lift1 A.fraction
 
+
 instance (A.Real a, A.PseudoRing a, A.IntegerConstant a) =>
       Absolute.C (T a) where
    abs = lift1 A.abs
@@ -241,11 +261,11 @@
 For useful instances with different scalar and vector type,
 we would need a more flexible superclass.
 -}
-instance (A.Real a, A.IntegerConstant a, A.PseudoModule a a) =>
+instance (A.Real a, A.IntegerConstant a, a ~ A.Scalar a, A.PseudoModule a) =>
       NormedSum.C (T a) (T a) where
    norm = lift1 A.abs
 
-instance (A.Real a, A.IntegerConstant a, A.PseudoModule a a) =>
+instance (A.Real a, A.IntegerConstant a, a ~ A.Scalar a, A.PseudoModule a) =>
       NormedEuc.Sqr (T a) (T a) where
    normSqr = lift1 A.square
 
@@ -262,6 +282,66 @@
 -}
 
 
+infix  4  %==, %/=, %<, %<=, %>=, %>
+
+(%==), (%/=), (%<), (%<=), (%>), (%>=) ::
+   (LLVM.CmpRet a) =>
+   T (LLVM.Value a) -> T (LLVM.Value a) -> T (LLVM.Value (LLVM.CmpResult a))
+(%==) = lift2 $ LLVM.cmp LLVM.CmpEQ
+(%/=) = lift2 $ LLVM.cmp LLVM.CmpNE
+(%>)  = lift2 $ LLVM.cmp LLVM.CmpGT
+(%>=) = lift2 $ LLVM.cmp LLVM.CmpGE
+(%<)  = lift2 $ LLVM.cmp LLVM.CmpLT
+(%<=) = lift2 $ LLVM.cmp LLVM.CmpLE
+
+infixr 3  %&&
+infixr 2  %||
+
+-- | Lazy AND
+(%&&) :: T (LLVM.Value Bool) -> T (LLVM.Value Bool) -> T (LLVM.Value Bool)
+a %&& b = a ? (b, constant False)
+
+-- | Lazy OR
+(%||) :: T (LLVM.Value Bool) -> T (LLVM.Value Bool) -> T (LLVM.Value Bool)
+a %|| b = a ? (constant True, b)
+
+infix  0 ?
+{- |
+@true ? (t,f)@ evaluates @t@,
+@false ? (t,f)@ evaluates @f@.
+@t@ and @f@ can reuse interim results,
+but they cannot contribute shared results,
+since only one of them will be run.
+Cf. '(??)'
+-}
+(?) ::
+   (Flatten value, Registers value ~ a, Phi a) =>
+   T (LLVM.Value Bool) -> (value, value) -> value
+c ? (t, f) =
+   unfoldCode $ consUnique $ do
+      b <- code c
+      shared <- MS.get
+      MT.lift $
+         C.ifThenElse b
+            (MS.evalStateT (flattenCode t) shared)
+            (MS.evalStateT (flattenCode f) shared)
+
+infix 0 ??
+{- |
+The expression @c ?? (t,f)@ evaluates both @t@ and @f@
+and selects components from @t@ and @f@ according to @c@.
+It is useful for vector values and
+for sharing @t@ or @f@ with other branches of an expression.
+-}
+(??) ::
+   (LLVM.IsFirstClass a, LLVM.CmpRet a) =>
+   T (LLVM.Value (LLVM.CmpResult a)) ->
+   (T (LLVM.Value a), T (LLVM.Value a)) ->
+   T (LLVM.Value a)
+c ?? (t, f) = lift3 LLVM.select c t f
+
+
+
 lift0 ::
    (forall r. CodeGenFunction r a) ->
    T a
@@ -283,25 +363,80 @@
       yv <- code y
       MT.lift $ f xv yv
 
+lift3 ::
+   (forall r. a -> b -> c -> CodeGenFunction r d) ->
+   T a -> T b -> T c -> T d
+lift3 f x y z =
+   consUnique $ do
+      xv <- code x
+      yv <- code y
+      zv <- code z
+      MT.lift $ f xv yv zv
 
-unlift0 ::
+
+_unlift0 ::
    T a ->
    (forall r. CodeGenFunction r a)
-unlift0 = decons
+_unlift0 = decons
 
-unlift1 ::
+unlift0 ::
+   (Flatten value) =>
+   value ->
+   (forall r. CodeGenFunction r (Registers value))
+unlift0 = flatten
+
+_unlift1 ::
    (T a -> T b) ->
    (forall r. a -> CodeGenFunction r b)
-unlift1 f x =
-   decons (f (constantValue x))
+_unlift1 = unlift1
 
-unlift2 ::
+{-
+Better type inference than flattenFunction.
+-}
+unlift1 ::
+   (Flatten value) =>
+   (T a -> value) ->
+   (forall r. a -> CodeGenFunction r (Registers value))
+unlift1 f a =
+   flatten (f (constantValue a))
+
+_unlift2 ::
    (T a -> T b -> T c) ->
    (forall r. a -> b -> CodeGenFunction r c)
-unlift2 f x y =
-   decons (f (constantValue x) (constantValue y))
+_unlift2 = unlift2
 
+unlift2 ::
+   (Flatten value) =>
+   (T a -> T b -> value) ->
+   (forall r. a -> b -> CodeGenFunction r (Registers value))
+unlift2 f a b =
+   flatten (f (constantValue a) (constantValue b))
 
+unlift3 ::
+   (Flatten value) =>
+   (T a -> T b -> T c -> value) ->
+   (forall r. a -> b -> c -> CodeGenFunction r (Registers value))
+unlift3 f a b c =
+   flatten (f (constantValue a) (constantValue b) (constantValue c))
+
+unlift4 ::
+   (Flatten value) =>
+   (T a -> T b -> T c -> T d -> value) ->
+   (forall r. a -> b -> c -> d -> CodeGenFunction r (Registers value))
+unlift4 f a b c d =
+   flatten $
+   f (constantValue a) (constantValue b) (constantValue c) (constantValue d)
+
+unlift5 ::
+   (Flatten value) =>
+   (T a -> T b -> T c -> T d -> T e -> value) ->
+   (forall r. a -> b -> c -> d -> e -> CodeGenFunction r (Registers value))
+unlift5 f a b c d e =
+   flatten $
+   f (constantValue a) (constantValue b) (constantValue c)
+      (constantValue d) (constantValue e)
+
+
 constantValue :: a -> T a
 constantValue x =
    consUnique (return x)
@@ -309,25 +444,54 @@
 constant :: (LLVM.IsConst a) => a -> T (LLVM.Value a)
 constant = constantValue . LLVM.valueOf
 
+fromInteger' :: (A.IntegerConstant a) => Integer -> T a
+fromInteger' = constantValue . A.fromInteger'
 
+fromRational' :: (A.RationalConstant a) => P.Rational -> T a
+fromRational' = constantValue . A.fromRational'
+
+
 class Flatten value where
    type Registers value :: *
-   flatten :: value -> CodeGenFunction r (Registers value)
-   unfold :: (Registers value) -> value
+   flattenCode :: value -> Compute r (Registers value)
+   unfoldCode :: T (Registers value) -> value
 
-flattenTraversable ::
+flatten ::
+   (Flatten value) =>
+   value -> CodeGenFunction r (Registers value)
+flatten x = MS.evalStateT (flattenCode x) Vault.empty
+
+unfold ::
+   (Flatten value) =>
+   (Registers value) -> value
+unfold x = unfoldCode $ pure x
+
+flattenCodeTraversable ::
    (Flatten value, Trav.Traversable f) =>
-   f value -> CodeGenFunction r (f (Registers value))
-flattenTraversable =
-   Trav.mapM flatten
+   f value -> Compute r (f (Registers value))
+flattenCodeTraversable =
+   Trav.mapM flattenCode
 
-unfoldFunctor ::
-   (Flatten value, Functor f) =>
-   f (Registers value) -> f value
-unfoldFunctor =
-   fmap unfold
+unfoldCodeTraversable ::
+   (Flatten value, Trav.Traversable f, Applicative f) =>
+   T (f (Registers value)) -> f value
+unfoldCodeTraversable =
+   unfoldFromGetters getters
 
+unfoldFromGetters ::
+   (Functor f, Flatten b) =>
+   f (a -> Registers b) -> T a -> f b
+unfoldFromGetters g x =
+   fmap (unfoldCode . flip fmap x) g
 
+getters ::
+   (Trav.Traversable f, Applicative f) =>
+   f (f a -> a)
+getters =
+   fmap (\n x -> Fold.toList x !! n) $
+   MS.evalState (Trav.sequenceA (pure (MS.state $ \n -> (n, succ n)))) 0
+
+
 flattenFunction ::
    (Flatten a, Flatten b) =>
    (a -> b) -> (Registers a -> CodeGenFunction r (Registers b))
@@ -353,46 +517,49 @@
 
 instance (Flatten a, Flatten b) => Flatten (a,b) where
    type Registers (a,b) = (Registers a, Registers b)
-   flatten (a,b) =
-      liftM2 (,) (flatten a) (flatten b)
-   unfold (a,b) =
-      (unfold a, unfold b)
+   flattenCode (a,b) =
+      liftM2 (,) (flattenCode a) (flattenCode b)
+   unfoldCode x =
+      case unzip x of
+         (a,b) -> (unfoldCode a, unfoldCode b)
 
 instance (Flatten a, Flatten b, Flatten c) => Flatten (a,b,c) where
    type Registers (a,b,c) = (Registers a, Registers b, Registers c)
-   flatten (a,b,c) =
-      liftM3 (,,) (flatten a) (flatten b) (flatten c)
-   unfold (a,b,c) =
-      (unfold a, unfold b, unfold c)
+   flattenCode (a,b,c) =
+      liftM3 (,,) (flattenCode a) (flattenCode b) (flattenCode c)
+   unfoldCode x =
+      case unzip3 x of
+         (a,b,c) -> (unfoldCode a, unfoldCode b, unfoldCode c)
 
 instance Flatten a => Flatten (Stereo.T a) where
    type Registers (Stereo.T a) = Stereo.T (Registers a)
-   flatten = flattenTraversable
-   unfold = unfoldFunctor
+   flattenCode = flattenCodeTraversable
+   unfoldCode = unfoldCodeTraversable
 
 instance Flatten a => Flatten (Complex.T a) where
    type Registers (Complex.T a) = Complex.T (Registers a)
-   flatten s =
+   flattenCode s =
       liftM2 (Complex.+:)
-         (flatten $ Complex.real s)
-         (flatten $ Complex.imag s)
-   unfold = unfoldFunctor
+         (flattenCode $ Complex.real s)
+         (flattenCode $ Complex.imag s)
+   unfoldCode =
+      unfoldFromGetters $ Complex.real Complex.+: Complex.imag
 
 instance (RealRing.C a, Flatten a) => Flatten (Phase.T a) where
    type Registers (Phase.T a) = Registers a
-   flatten s =
-      flatten $ Phase.toRepresentative s
-   unfold s =
+   flattenCode s =
+      flattenCode $ Phase.toRepresentative s
+   unfoldCode s =
       -- could also be unsafeFromRepresentative
-      Phase.fromRepresentative $ unfold s
+      Phase.fromRepresentative $ unfoldCode s
 
 
 instance Flatten (T a) where
    type Registers (T a) = a
-   flatten = decons
-   unfold  = constantValue
+   flattenCode = code
+   unfoldCode = id
 
 instance Flatten () where
    type Registers () = ()
-   flatten = return
-   unfold  = id
+   flattenCode = return
+   unfoldCode _ = ()
diff --git a/src/Synthesizer/LLVM/Simple/Vanilla.hs b/src/Synthesizer/LLVM/Simple/Vanilla.hs
--- a/src/Synthesizer/LLVM/Simple/Vanilla.hs
+++ b/src/Synthesizer/LLVM/Simple/Vanilla.hs
@@ -43,7 +43,7 @@
       (\y ->
          Maybe.lift $
          fmap (\y1 -> (Value.constantValue y, y1))
-              (Value.decons (f (Value.constantValue y))))
+              (Value.unlift1 f y))
       (Value.decons initial)
 
 iterate ::
@@ -55,7 +55,7 @@
       (\y ->
          Maybe.lift $
          fmap (\y1 -> (Value.unfold y, y1))
-              (Value.flatten (f (Value.unfold y))))
+              (Value.flattenFunction f y))
       (Value.flatten initial)
 
 
@@ -75,8 +75,7 @@
    Value t -> Value t -> Sig.T (Value y)
 osciReg wave phase freq =
    Sig.map
-      (Value.decons . Wave.apply wave .
-       Phase.fromRepresentative . Value.constantValue) $
+      (Value.unlift1 $ Wave.apply wave . Phase.fromRepresentative) $
    Sig.iterate (SoV.incPhase freq) phase
 
 osciVal ::
diff --git a/src/Synthesizer/LLVM/Storable/ChunkIterator.hs b/src/Synthesizer/LLVM/Storable/ChunkIterator.hs
--- a/src/Synthesizer/LLVM/Storable/ChunkIterator.hs
+++ b/src/Synthesizer/LLVM/Storable/ChunkIterator.hs
@@ -1,13 +1,17 @@
 {-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE ForeignFunctionInterface #-}
 module Synthesizer.LLVM.Storable.ChunkIterator where
 
 import qualified Data.StorableVector.Lazy as SVL
 import qualified Data.StorableVector.Base as SVB
 
+import qualified LLVM.Extra.Memory as Memory
+import qualified LLVM.Extra.Class as Class
+
 import Data.Word (Word32, )
 import Foreign.Storable (Storable, poke, )
-import Foreign.Ptr (FunPtr, Ptr, nullPtr, castPtr, )
+import Foreign.Ptr (FunPtr, Ptr, nullPtr, )
 
 import Control.Monad (liftM2, )
 
@@ -15,50 +19,46 @@
 import Data.IORef (IORef, newIORef, readIORef, writeIORef, )
 
 
-data T =
-   forall a. Storable a =>
-      Cons (IORef [SVB.Vector a]) (IORef (SVB.Vector a))
-
 {-
-I do not see a way,
-how to bind the result type @Ptr a@
-to the input type @SV.Vector a@.
-We cannot make the element type of the storable vector
-a type parameter of 'T'
-since then we would also need to make Storable
-a constraint of the FFI interface,
-and this is forbidden.
+FFI declarations must not have constraints.
+Thus we put them in the iterator datatype.
 -}
+data T a =
+   (Storable a, Class.MakeValueTuple a, Memory.C (Class.ValueTuple a)) =>
+      Cons (IORef [SVB.Vector a]) (IORef (SVB.Vector a))
+
+type MemoryPtr a = Ptr (Memory.Struct (Class.ValueTuple a))
+
+
 foreign import ccall "&nextChunk"
    nextCallBack ::
       FunPtr (
-         StablePtr T ->
-         Ptr Word32 -> IO (Ptr a)
+         StablePtr (T a) ->
+         Ptr Word32 -> IO (MemoryPtr a)
       )
 
 foreign export ccall "nextChunk"
    next ::
-      StablePtr T ->
-      Ptr Word32 -> IO (Ptr a)
+      StablePtr (T a) ->
+      Ptr Word32 -> IO (MemoryPtr a)
 
 
 new ::
-   Storable a =>
-   SVL.Vector a -> IO (StablePtr T)
+   (Storable a, Class.MakeValueTuple a, Memory.C (Class.ValueTuple a)) =>
+   SVL.Vector a -> IO (StablePtr (T a))
 new sig =
    newStablePtr =<<
    liftM2 Cons
       (newIORef (SVL.chunks sig))
-      (newIORef
-          (error "first chunk must be fetched with nextChunk"))
+      (newIORef (error "first chunk must be fetched with nextChunk"))
 
 dispose ::
-   StablePtr T -> IO ()
+   StablePtr (T a) -> IO ()
 dispose = freeStablePtr
 
 next ::
-   StablePtr T ->
-   Ptr Word32 -> IO (Ptr a)
+   StablePtr (T a) ->
+   Ptr Word32 -> IO (MemoryPtr a)
 next stable lenPtr =
    deRefStablePtr stable >>= \state ->
    case state of
@@ -71,5 +71,7 @@
                   in order to protect it against garbage collection -}
                writeIORef chunkRef x >>
                writeIORef listRef xs >>
-               SVB.withStartPtr x (\p l ->
-                  poke lenPtr (fromIntegral l) >> return (castPtr p))
+               SVB.withStartPtr x
+                  (\p l ->
+                     poke lenPtr (fromIntegral l) >>
+                     return (Memory.castStorablePtr p))
diff --git a/src/Synthesizer/LLVM/Storable/Signal.hs b/src/Synthesizer/LLVM/Storable/Signal.hs
--- a/src/Synthesizer/LLVM/Storable/Signal.hs
+++ b/src/Synthesizer/LLVM/Storable/Signal.hs
@@ -20,9 +20,6 @@
 import qualified Synthesizer.LLVM.Parameterized.SignalPacked as SigPS
 
 import qualified Synthesizer.LLVM.Execution as Exec
-import qualified LLVM.Extra.Memory as Memory
-import qualified LLVM.Extra.Arithmetic as A
-import LLVM.Extra.Control (arrayLoop, )
 
 import qualified Synthesizer.LLVM.Frame.SerialVector as Serial
 import qualified Synthesizer.LLVM.Frame.Stereo as Stereo
@@ -37,8 +34,10 @@
 import qualified Data.EventList.Absolute.TimeBody  as AbsEventList
 import qualified Number.NonNegative as NonNeg
 
+import qualified LLVM.Extra.Memory as Memory
+import qualified LLVM.Extra.Arithmetic as A
 import LLVM.Extra.Arithmetic (advanceArrayElementPtr, )
-
+import LLVM.Extra.Control (arrayLoop, )
 import LLVM.Extra.Class (MakeValueTuple, ValueTuple, )
 import LLVM.Core
    (Linkage(ExternalLinkage), createNamedFunction, ret,
diff --git a/src/Synthesizer/LLVM/Storable/Vector.hs b/src/Synthesizer/LLVM/Storable/Vector.hs
new file mode 100644
--- /dev/null
+++ b/src/Synthesizer/LLVM/Storable/Vector.hs
@@ -0,0 +1,25 @@
+{-# LANGUAGE TypeFamilies #-}
+module Synthesizer.LLVM.Storable.Vector where
+
+import qualified LLVM.Extra.Memory as Memory
+import LLVM.Extra.Class (MakeValueTuple, ValueTuple, )
+
+import qualified Data.StorableVector as SV
+import qualified Data.StorableVector.Base as SVB
+
+import Foreign.Storable (Storable, )
+import Foreign.Marshal.Array (advancePtr, )
+import Foreign.ForeignPtr (ForeignPtr, )
+import Foreign.Ptr (Ptr, )
+import qualified System.Unsafe as Unsafe
+
+
+unsafeToPointers ::
+   (Storable a, MakeValueTuple a, ValueTuple a ~ value, Memory.C value) =>
+   SV.Vector a ->
+   (ForeignPtr a, Ptr (Memory.Struct value), Int)
+unsafeToPointers v =
+   let (fp,s,l) = SVB.toForeignPtr v
+   in  (fp,
+        Memory.castStorablePtr $ Unsafe.foreignPtrToPtr fp `advancePtr` s,
+        l)
diff --git a/src/Synthesizer/LLVM/Wave.hs b/src/Synthesizer/LLVM/Wave.hs
--- a/src/Synthesizer/LLVM/Wave.hs
+++ b/src/Synthesizer/LLVM/Wave.hs
@@ -32,6 +32,33 @@
    A.truncate <=<
    A.mul (A.fromInteger' 2)
 
+{- |
+Discrete interpolation between triangle and square wave.
+For exponent 1 we get a triangle wave.
+The larger the exponent, the more we approach a square wave,
+the.more computing is necessary.
+-}
+triangleSquarePower ::
+   (A.PseudoRing a, A.RationalConstant a, A.Real a) =>
+   Integer -> a -> CodeGenFunction r a
+triangleSquarePower n = Value.unlift1 $ \x ->
+   let y = 2-4*x
+       z = abs (1-abs y)
+   in  (1-z^n)*signum y
+
+{- |
+Continuous interpolation between triangle and square wave.
+For factor 0 we get a square wave,
+for factor 1 we get a triangle wave.
+-}
+triangleSquareRatio ::
+   (A.Field a, A.RationalConstant a, A.Real a) =>
+   a -> a -> CodeGenFunction r a
+triangleSquareRatio = Value.unlift2 $ \c x ->
+   let y = 2-4*x
+       z = abs (1-abs y)
+   in  (1-z)/(1+(c-1)*z)*signum y
+
 triangle ::
    (A.PseudoRing a, A.RationalConstant a, A.Fraction a) =>
    a -> CodeGenFunction r a
diff --git a/synthesizer-llvm.cabal b/synthesizer-llvm.cabal
--- a/synthesizer-llvm.cabal
+++ b/synthesizer-llvm.cabal
@@ -1,5 +1,5 @@
 Name:           synthesizer-llvm
-Version:        0.5.0.2
+Version:        0.6
 License:        GPL
 License-File:   LICENSE
 Author:         Henning Thielemann <haskell@henning-thielemann.de>
@@ -58,7 +58,7 @@
   default:     True
 
 Source-Repository this
-  Tag:         0.5.0.2
+  Tag:         0.6
   Type:        darcs
   Location:    http://code.haskell.org/synthesizer/llvm/
 
@@ -69,30 +69,29 @@
 
 Library
   Build-Depends:
-    llvm-extra >=0.4.1 && <0.5,
+    llvm-extra >=0.5 && <0.6,
     -- llvm must be imported with restrictive version bounds,
     -- because we import implicitly and unqualified
     llvm-tf >=3.0 && <3.0.1,
     tfp >=0.7 && <0.9,
     vault >=0.1 && <0.3,
-    synthesizer-core >=0.6 && <0.7,
+    synthesizer-core >=0.7 && <0.8,
     synthesizer-midi >=0.6 && <0.7,
     midi >=0.2.1 && <0.3,
     storable-record >=0.0.2 && <0.1,
     storable-tuple >=0.0.2 && <0.1,
     sox >=0.2 && <0.3,
-    sample-frame-np >=0.0.1 && <0.1,
-    sample-frame >=0.0.1 && <0.1,
     storablevector >=0.2.6 && <0.3,
     unsafe >=0.0 && <0.1,
     numeric-prelude >=0.3 && <0.5,
     non-negative >=0.1 && <0.2,
+    non-empty >=0.2 && <0.3,
     event-list >=0.1 && <0.2,
     filepath >=1.1 && <1.4,
     random >=1.0 && <1.1,
     containers >=0.1 && <0.6,
     transformers >=0.2 && <0.4,
-    utility-ht >=0.0.8 && <0.1
+    utility-ht >=0.0.10 && <0.1
 
   Build-Depends:
     -- base-4 needed for Control.Category
@@ -117,6 +116,7 @@
     Synthesizer.LLVM.Storable.Signal
     Synthesizer.LLVM.Storable.Process
     Synthesizer.LLVM.Causal.Process
+    Synthesizer.LLVM.Causal.ProcessValue
     Synthesizer.LLVM.CausalParameterized.Process
     Synthesizer.LLVM.CausalParameterized.ProcessValue
     Synthesizer.LLVM.CausalParameterized.ProcessPacked
@@ -124,6 +124,7 @@
     Synthesizer.LLVM.CausalParameterized.ControlledPacked
     Synthesizer.LLVM.CausalParameterized.Functional
     Synthesizer.LLVM.CausalParameterized.FunctionalPlug
+    Synthesizer.LLVM.CausalParameterized.Helix
     Synthesizer.LLVM.Plug.Input
     Synthesizer.LLVM.Plug.Output
     Synthesizer.LLVM.Filter.Allpass
@@ -137,8 +138,11 @@
     Synthesizer.LLVM.Filter.SecondOrderCascade
     Synthesizer.LLVM.Filter.Moog
     Synthesizer.LLVM.Filter.Universal
+    Synthesizer.LLVM.Filter.NonRecursive
     Synthesizer.LLVM.Generator.Exponential2
     Synthesizer.LLVM.RingBuffer
+    Synthesizer.LLVM.RingBufferForward
+    Synthesizer.LLVM.Interpolation
     Synthesizer.LLVM.ConstantPiece
     Synthesizer.LLVM.Frame.SerialVector
     Synthesizer.LLVM.Frame
@@ -161,8 +165,10 @@
   Other-Modules:
     Synthesizer.LLVM.Random
     Synthesizer.LLVM.EventIterator
+    Synthesizer.LLVM.Storable.Vector
     Synthesizer.LLVM.Storable.ChunkIterator
     Synthesizer.LLVM.Storable.LazySizeIterator
+    Synthesizer.LLVM.Causal.ProcessPrivate
     Synthesizer.LLVM.Parameterized.SignalPrivate
     Synthesizer.LLVM.CausalParameterized.ProcessPrivate
     Synthesizer.LLVM.Debug.Counter
@@ -178,17 +184,15 @@
     Build-Depends:
       synthesizer-llvm,
 
-      llvm-extra >=0.4.1 && <0.5,
+      llvm-extra,
       llvm-tf,
       tfp,
-      synthesizer-core >=0.6 && <0.7,
+      synthesizer-core,
       synthesizer-midi >=0.6 && <0.7,
       midi >=0.2.1 && <0.3,
       storable-record >=0.0.2 && <0.1,
       storable-tuple >=0.0.2 && <0.1,
       sox >=0.2 && <0.3,
-      sample-frame-np >=0.0.1 && <0.1,
-      sample-frame >=0.0.1 && <0.1,
       storablevector >=0.2.6 && <0.3,
       numeric-prelude >=0.3 && <0.5,
       non-negative >=0.1 && <0.2,
@@ -196,7 +200,9 @@
       random >=1.0 && <1.1,
       containers >=0.1 && <0.6,
       transformers >=0.2 && <0.4,
-      utility-ht >=0.0.8 && <0.1,
+      non-empty >=0.2 && <0.3,
+      utility-ht,
+      filepath,
 
       synthesizer-alsa >=0.5 && <0.6,
       alsa-pcm >=0.6 && <0.7,
@@ -221,16 +227,14 @@
     Build-Depends:
       synthesizer-llvm,
 
-      llvm-extra >=0.4.1 && <0.5,
+      llvm-extra,
       llvm-tf,
       tfp,
-      synthesizer-core >=0.6 && <0.7,
+      synthesizer-core,
       synthesizer-midi >=0.6 && <0.7,
       midi >=0.2.1 && <0.3,
       storable-record >=0.0.2 && <0.1,
       storable-tuple >=0.0.2 && <0.1,
-      sample-frame-np >=0.0.1 && <0.1,
-      sample-frame >=0.0.1 && <0.1,
       storablevector >=0.2.6 && <0.3,
       numeric-prelude >=0.3 && <0.5,
       non-negative >=0.1 && <0.2,
@@ -238,7 +242,7 @@
       filepath >=1.1 && <1.4,
       containers >=0.1 && <0.6,
       transformers >=0.2 && <0.4,
-      utility-ht >=0.0.8 && <0.1,
+      utility-ht,
 
       synthesizer-alsa >=0.5 && <0.6,
       midi-alsa >=0.2.1 && <0.3,
@@ -275,25 +279,24 @@
 
       jack >=0.7 && <0.8,
 
-      llvm-extra >=0.4.1 && <0.5,
+      llvm-extra,
       llvm-tf,
       tfp,
-      synthesizer-core >=0.6 && <0.7,
+      synthesizer-core,
       synthesizer-midi >=0.6 && <0.7,
       midi >=0.2.1 && <0.3,
       storable-record >=0.0.2 && <0.1,
       storable-tuple >=0.0.2 && <0.1,
-      sample-frame-np >=0.0.1 && <0.1,
-      sample-frame >=0.0.1 && <0.1,
       storablevector >=0.2.6 && <0.3,
       numeric-prelude >=0.3 && <0.5,
       non-negative >=0.1 && <0.2,
+      random >=1.0 && <1.1,
       explicit-exception >=0.1.7 && <0.2,
       event-list >=0.1 && <0.2,
       filepath >=1.1 && <1.4,
       containers >=0.1 && <0.6,
       transformers >=0.2 && <0.4,
-      utility-ht >=0.0.8 && <0.1,
+      utility-ht,
 
       base >=4 && <5
 
@@ -318,17 +321,15 @@
     Build-Depends:
       synthesizer-llvm,
 
-      llvm-extra >=0.4.1 && <0.5,
+      llvm-extra,
       llvm-tf,
       tfp,
       sox >=0.2.1 && <0.3,
-      synthesizer-core >=0.6 && <0.7,
+      synthesizer-core,
       synthesizer-midi >=0.6 && <0.7,
       midi >=0.2.1 && <0.3,
       storable-record >=0.0.2 && <0.1,
       storable-tuple >=0.0.2 && <0.1,
-      sample-frame-np >=0.0.1 && <0.1,
-      sample-frame >=0.0.1 && <0.1,
       storablevector >=0.2.6 && <0.3,
       numeric-prelude >=0.3 && <0.5,
       non-negative >=0.1 && <0.2,
@@ -337,7 +338,7 @@
       filepath >=1.1 && <1.4,
       containers >=0.1 && <0.6,
       transformers >=0.2 && <0.4,
-      utility-ht >=0.0.8 && <0.1,
+      utility-ht,
 
       base >=4 && <5
 
@@ -357,19 +358,61 @@
   Other-Modules:
     Synthesizer.LLVM.Server.Option
 
+Executable synthi-llvm-sample
+  If flag(buildExamples)
+    Build-Depends:
+      gnuplot >=0.5 && <0.6,
+      synthesizer-llvm,
+      synthesizer-core,
+      numeric-prelude,
+      storablevector,
+      utility-ht,
+      base >=4 && <5
+  Else
+    Buildable: False
+  Default-Language: Haskell98
+  GHC-Options:    -Wall
+  If impl(ghc>=7.0)
+    GHC-Options: -fwarn-unused-do-bind -fcontext-stack=1000
+    CPP-Options: -DNoImplicitPrelude=RebindableSyntax
+    Default-Extensions: CPP
+  Main-Is:        src/Synthesizer/LLVM/Server/SampledSoundAnalysis.hs
+
+Executable synthi-llvm-speech
+  If flag(buildExamples)
+    Build-Depends:
+      gnuplot >=0.5 && <0.6,
+      filepath,
+      sox,
+      synthesizer-llvm,
+      synthesizer-core,
+      numeric-prelude,
+      storablevector,
+      utility-ht,
+      base >=4 && <5
+  Else
+    Buildable: False
+  Default-Language: Haskell98
+  GHC-Options:    -Wall
+  If impl(ghc>=7.0)
+    GHC-Options: -fwarn-unused-do-bind -fcontext-stack=1000
+    CPP-Options: -DNoImplicitPrelude=RebindableSyntax
+    Default-Extensions: CPP
+  Main-Is:        src/Synthesizer/LLVM/Server/CausalPacked/SpeechExplore.hs
+
 Executable synthi-llvm-test
   If flag(buildTests)
     Build-Depends:
       synthesizer-llvm,
 
-      llvm-extra >=0.4.1 && <0.5,
+      llvm-extra,
       llvm-tf,
       tfp,
-      synthesizer-core >=0.6 && <0.7,
+      synthesizer-core,
       storablevector >=0.2.6 && <0.3,
       numeric-prelude >=0.3 && <0.5,
       random >=1.0 && <1.1,
-      utility-ht >=0.0.8 && <0.1,
+      utility-ht,
 
       QuickCheck >=1 && <3,
       base >=4 && <5
@@ -384,6 +427,8 @@
   Hs-Source-Dirs: testsuite
   Main-Is:     Test/Main.hs
   Other-Modules:
+    Test.Synthesizer.LLVM.RingBufferForward
+    Test.Synthesizer.LLVM.Helix
     Test.Synthesizer.LLVM.Filter
     Test.Synthesizer.LLVM.Packed
     Test.Synthesizer.LLVM.Utility
diff --git a/testsuite/Test/Main.hs b/testsuite/Test/Main.hs
--- a/testsuite/Test/Main.hs
+++ b/testsuite/Test/Main.hs
@@ -1,5 +1,7 @@
 module Main where
 
+import qualified Test.Synthesizer.LLVM.RingBufferForward as RingBufferForward
+import qualified Test.Synthesizer.LLVM.Helix as Helix
 import qualified Test.Synthesizer.LLVM.Filter as Filter
 import qualified Test.Synthesizer.LLVM.Packed as Packed
 
@@ -17,6 +19,8 @@
    LLVM.initializeNativeTarget
    mapM_ (\(name,test) -> putStr (name ++ ": ") >> test) $
       concat $
+      prefix "Helix" Helix.tests :
+      prefix "RingBufferForward" RingBufferForward.tests :
       prefix "Filter" Filter.tests :
       prefix "Packed" Packed.tests :
       []
diff --git a/testsuite/Test/Synthesizer/LLVM/Filter.hs b/testsuite/Test/Synthesizer/LLVM/Filter.hs
--- a/testsuite/Test/Synthesizer/LLVM/Filter.hs
+++ b/testsuite/Test/Synthesizer/LLVM/Filter.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE Rank2Types #-}
 module Test.Synthesizer.LLVM.Filter (tests) where
 
@@ -10,6 +11,7 @@
 import qualified Synthesizer.LLVM.Filter.Moog as Moog
 import qualified Synthesizer.LLVM.Filter.ComplexFirstOrder as ComplexFilter
 import qualified Synthesizer.LLVM.Filter.ComplexFirstOrderPacked as ComplexFilterP
+import qualified Synthesizer.LLVM.Filter.NonRecursive as FiltNR
 
 import qualified Synthesizer.Plain.Filter.Recursive.Allpass    as AllpassCore
 import qualified Synthesizer.Plain.Filter.Recursive.FirstOrder as FirstOrderCore
@@ -24,7 +26,7 @@
 import qualified Synthesizer.LLVM.Parameterized.SignalPacked as SigPS
 import qualified Synthesizer.LLVM.Parameterized.Signal as SigP
 import Synthesizer.LLVM.CausalParameterized.Process (($<), ($*), )
-import Synthesizer.LLVM.Parameterized.Signal (($#), )
+import Synthesizer.LLVM.Parameter (($#), )
 
 import Synthesizer.Plain.Filter.Recursive (Pole(Pole))
 -- import qualified Synthesizer.Storable.Signal as SigSt
@@ -40,6 +42,7 @@
 import qualified Synthesizer.Basic.Phase as Phase
 
 import qualified Data.StorableVector.Lazy as SVL
+import qualified Data.StorableVector as SV
 import Data.StorableVector.Lazy (ChunkSize, )
 
 import Test.Synthesizer.LLVM.Utility
@@ -48,18 +51,23 @@
 
 import qualified Control.Category as Cat
 import Control.Category ((<<<), )
-import Control.Arrow ((&&&), (^<<), (<<^), )
+import Control.Arrow (arr, (&&&), (***), (^<<), (<<^), )
 
+import qualified LLVM.Extra.Arithmetic as A
 import qualified LLVM.Extra.Memory as Memory
 
 import LLVM.Core (Value, )
 import qualified LLVM.Core as LLVM
+import qualified Types.Data.Bool as TypeBool
 import qualified Types.Data.Num as TypeNum
 import Types.Data.Num (D4, )
 
 import qualified Number.Complex as Complex
 import qualified Synthesizer.LLVM.Frame.Stereo as Stereo
 
+import qualified System.Random as Rnd
+import Data.Word (Word32, )
+
 import Test.QuickCheck (quickCheck, )
 
 import NumericPrelude.Numeric
@@ -108,13 +116,13 @@
    SigP.T p (Value Float)
 allpassPhaserCausal reduct =
    CausalP.apply
-      (Allpass.phaserP
+      (Allpass.phaser
        $< allpassControl TypeNum.d16 reduct)
 
 allpassPhaserPipeline reduct xs =
    let order = TypeNum.d16
    in  (SigP.drop $# TypeNum.fromIntegerT order) $
-       (Allpass.phaserPipelineP
+       (Allpass.phaserPipeline
          $< allpassControl order reduct
          $* xs)
 
@@ -152,7 +160,7 @@
    SigP.T p VectorValue ->
    SigP.T p VectorValue
 allpassPhaserPacked reduct =
-   applyPacked Allpass.phaserPackedP
+   applyPacked Allpass.phaserPacked
       (allpassControl TypeNum.d16 reduct)
 
 allpassPacked :: IO (ChunkSize -> ((Int,Int), Int) -> SimFloat)
@@ -224,7 +232,7 @@
    SigP.T p (Value Float) ->
    SigP.T p (Value Float)
 firstOrderConstant cutOff xs =
-   FirstOrder.lowpassCausalP
+   FirstOrder.lowpassCausal
     $< SigP.constant (FirstOrderCore.parameter ^<< cutOff)
     $* xs
 
@@ -242,7 +250,7 @@
    SigP.T p (Value Float) ->
    SigP.T p (Value Float)
 firstOrderCausal reduct xs =
-   FirstOrder.lowpassCausalP
+   FirstOrder.lowpassCausal
     $< lfoSine FirstOrder.parameter reduct
     $* xs
 
@@ -275,7 +283,7 @@
    SigP.T p VectorValue
 firstOrderCausalPacked reduct =
    applyPacked
-      (FirstOrder.lowpassCausalPackedP)
+      FirstOrder.lowpassCausalPacked
       (lfoSine FirstOrder.parameter reduct)
 
 firstOrderPacked :: IO (ChunkSize -> ((Int,Int), Int) -> SimFloat)
@@ -295,7 +303,7 @@
    SigP.T p (Value Float) ->
    SigP.T p (Value Float)
 secondOrderCausal reduct xs =
-   SecondOrder.causalP
+   SecondOrder.causal
     $< lfoSine (SecondOrder.bandpassParameter (LLVM.valueOf (10::Float))) reduct
     $* xs
 
@@ -304,7 +312,7 @@
    SigP.T p VectorValue ->
    SigP.T p VectorValue
 secondOrderCausalPacked reduct =
-   applyPacked SecondOrder.causalPackedP
+   applyPacked SecondOrder.causalPacked
       (lfoSine (SecondOrder.bandpassParameter (LLVM.valueOf (10::Float))) reduct)
 
 secondOrderPacked :: IO (ChunkSize -> ((Int,Int), Int) -> SimFloat)
@@ -323,7 +331,7 @@
    SigP.T p (Value Float) ->
    SigP.T p (Value Float)
 secondOrderCausalPacked2 reduct xs =
-   SecondOrderP.causalP
+   SecondOrderP.causal
     $< lfoSine (SecondOrderP.bandpassParameter (LLVM.valueOf (10::Float))) reduct
     $* xs
 
@@ -350,7 +358,7 @@
    SigP.T p (Value Float) ->
    SigP.T p (UniFilter.Result (Value Float))
 universalCausal reduct xs =
-   UniFilter.causalP
+   UniFilter.causal
     $< lfoSine (UniFilter.parameter (LLVM.valueOf (10::Float))) reduct
     $* xs
 
@@ -387,13 +395,13 @@
 
 
 moogCausal ::
-   (TypeNum.NaturalT n) =>
+   (TypeNum.NaturalT n, TypeNum.IsNatural n ~ TypeBool.True) =>
    n ->
    Param.T p Float ->
    SigP.T p (Value Float) ->
    SigP.T p (Value Float)
 moogCausal order reduct xs =
-   Moog.causalP
+   Moog.causal
     $< lfoSine (Moog.parameter order (LLVM.valueOf (10::Float))) reduct
     $* xs
 
@@ -429,9 +437,9 @@
    SigP.T p (Stereo.T (Value Float))
 complexCausal reduct =
    CausalP.apply $
-      (ComplexFilter.causalP
+      (ComplexFilter.causal
         $< lfoSine (ComplexFilter.parameter (LLVM.valueOf (10::Float))) reduct)
-      <<^ (\x -> Stereo.cons x (LLVM.value LLVM.zero))
+      <<^ (\x -> Stereo.cons x A.zero)
 
 complexCausalPacked ::
    Param.T p Float ->
@@ -439,9 +447,9 @@
    SigP.T p (Stereo.T (Value Float))
 complexCausalPacked reduct =
    CausalP.apply $
-      (ComplexFilterP.causalP
+      (ComplexFilterP.causal
         $< lfoSine (ComplexFilterP.parameter (LLVM.valueOf (10::Float))) reduct)
-      <<^ (\x -> Stereo.cons x (LLVM.value LLVM.zero))
+      <<^ (\x -> Stereo.cons x A.zero)
 
 complexPacked :: IO (ChunkSize -> ((Int,Int), Int) -> SimFloat)
 complexPacked =
@@ -488,6 +496,21 @@
 -}
 
 
+convolvePacked :: IO (ChunkSize -> ((Int,Int), Word32) -> SimFloat)
+convolvePacked =
+   let mask =
+          (\(len, seed) ->
+             fst $ SV.packN len $ Rnd.randomRs (-1,1::Float) seed)
+          ^<< rangeFromInt (1,20) *** arr Rnd.mkStdGen <<^ fst
+       noise  = SigP.noise (arr snd) 1
+       noiseP = SigPS.noise (arr snd) 1
+       unpack :: SigP.T p VectorValue -> SigP.T p (Value Float)
+       unpack = SigPS.unpack
+   in  checkSimilarity 1e-3 limitFloat
+          (FiltNR.convolve mask $* noise)
+          (unpack $ (FiltNR.convolvePacked mask $* noiseP))
+
+
 tests :: [(String, IO ())]
 tests =
    ("secondOrderPacked", quickCheck =<< secondOrderPacked) :
@@ -502,4 +525,5 @@
    ("moog", quickCheck =<< moog) :
    ("complexPacked", quickCheck =<< complexPacked) :
    ("complex", quickCheck =<< complex) :
+   ("convolvePacked", quickCheck =<< convolvePacked) :
    []
diff --git a/testsuite/Test/Synthesizer/LLVM/Helix.hs b/testsuite/Test/Synthesizer/LLVM/Helix.hs
new file mode 100644
--- /dev/null
+++ b/testsuite/Test/Synthesizer/LLVM/Helix.hs
@@ -0,0 +1,115 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE Rank2Types #-}
+module Test.Synthesizer.LLVM.Helix (tests) where
+
+import qualified Synthesizer.LLVM.CausalParameterized.Helix as Helix
+import qualified Synthesizer.LLVM.CausalParameterized.Functional as Func
+import qualified Synthesizer.LLVM.CausalParameterized.Process as CausalP
+import qualified Synthesizer.LLVM.Parameterized.Signal as SigP
+import qualified Synthesizer.LLVM.Parameter as Param
+import qualified Synthesizer.LLVM.Interpolation as Interpolation
+import Synthesizer.LLVM.CausalParameterized.Functional (($&), (&|&), )
+import Synthesizer.LLVM.CausalParameterized.Process (($*), )
+import Synthesizer.LLVM.Parameter (($#), )
+
+import qualified Data.StorableVector.Lazy as SVL
+import qualified Data.StorableVector as SV
+import Data.StorableVector.Lazy (ChunkSize, )
+
+import Test.Synthesizer.LLVM.Utility
+          (CheckSimilarity, checkSimilarity, rangeFromInt, )
+
+import Control.Category ((<<<), )
+import Control.Arrow (arr, (***), (^<<), (<<^), )
+import Control.Applicative (pure, )
+
+import LLVM.Core (Value, )
+
+import Foreign.Storable (Storable, )
+
+import qualified System.Random as Rnd
+import Data.Word (Word32, )
+
+-- import qualified Graphics.Gnuplot.Simple as Gnuplot
+import Test.QuickCheck (quickCheck, )
+
+import NumericPrelude.Numeric
+import NumericPrelude.Base
+
+
+type SimFloat = CheckSimilarity Float
+
+signalLength :: Int
+signalLength = 500
+
+
+limitFloat :: (Storable a) => SVL.Vector a -> SVL.Vector a
+limitFloat = SVL.take signalLength
+
+
+randomSpeed :: Param.T p (Int, Int) -> SigP.T p (Value Float)
+randomSpeed p =
+   SigP.fromStorableVectorLazy
+      ((\(len, seed) ->
+          SVL.cycle $
+          SVL.fromChunks
+             [fst $ SV.packN len $ Rnd.randomRs (0,10::Float) seed])
+       ^<< rangeFromInt (1,100) *** arr Rnd.mkStdGen <<< p)
+
+randomPhase :: Param.T p (Int, Int) -> SigP.T p (Value Float)
+randomPhase p =
+   SigP.fromStorableVectorLazy
+      ((\(len, seed) ->
+          SVL.cycle $
+          SVL.fromChunks
+             [fst $ SV.packN len $ Rnd.randomRs (0,1::Float) seed])
+       ^<< rangeFromInt (1,100) *** arr Rnd.mkStdGen <<< p)
+
+staticDynamic ::
+   IO (ChunkSize -> (((Int, Int), (Int, Int)), (Int, Word32)) -> SimFloat)
+staticDynamic =
+   let len = 1000
+       speedParam = arr $ fst.fst
+       phaseParam = arr $ snd.fst
+       noiseParam = arr $ snd.snd
+       period = rangeFromInt (1,32::Float) <<^ fst.snd
+       noise seed = CausalP.take (pure len) $* SigP.noise seed 1
+
+       static =
+          Helix.static Interpolation.linear Interpolation.linear
+             (fmap round period) period
+             (fmap (\seed -> SigP.render (noise (arr id)) len seed :: SV.Vector Float) noiseParam)
+          $&
+          Func.fromSignal
+             ((CausalP.integrate $# (0::Float)) $* randomSpeed speedParam)
+          &|&
+          Func.fromSignal (randomPhase phaseParam)
+
+       dynamic =
+          Helix.dynamic Interpolation.linear Interpolation.linear
+             (fmap round period) period (noise noiseParam)
+          $&
+          Func.fromSignal (randomSpeed speedParam)
+          &|&
+          Func.fromSignal (randomPhase phaseParam)
+
+   in  checkSimilarity 5e-3 limitFloat
+          (Func.compileSignal static)
+          (Func.compileSignal dynamic)
+
+{-
+plot :: IO ()
+plot = do
+   render <- staticDynamic
+   case render (SVL.chunkSize 1) (((111,0),(0,23)),(107,11)) of
+      CheckSimilarity _tol xs ys ->
+         Gnuplot.plotLists [] [SVL.unpack xs, SVL.unpack ys]
+         >>
+         Gnuplot.plotList [] (zipWith (-) (SVL.unpack xs) (SVL.unpack ys))
+-}
+
+
+tests :: [(String, IO ())]
+tests =
+   ("staticDynamic", quickCheck =<< staticDynamic) :
+   []
diff --git a/testsuite/Test/Synthesizer/LLVM/Packed.hs b/testsuite/Test/Synthesizer/LLVM/Packed.hs
--- a/testsuite/Test/Synthesizer/LLVM/Packed.hs
+++ b/testsuite/Test/Synthesizer/LLVM/Packed.hs
@@ -16,14 +16,13 @@
 import qualified Synthesizer.LLVM.Parameterized.SignalPacked as SigPS
 import qualified Synthesizer.LLVM.Parameterized.Signal as SigP
 import qualified Synthesizer.LLVM.CausalParameterized.Process as CausalP
-import Synthesizer.LLVM.Parameterized.Signal (($#), )
 import Synthesizer.LLVM.CausalParameterized.Process (($*), )
 
 import qualified Synthesizer.LLVM.Storable.Signal as SigStL
 import qualified Data.StorableVector.Lazy as SVL
 import Data.StorableVector.Lazy (ChunkSize, )
 
-import Control.Arrow ((^<<), (<<^), (<<<), )
+import Control.Arrow (arr, (^<<), (<<^), (<<<), )
 
 import Data.Word (Word32, )
 
@@ -168,23 +167,23 @@
 limitPackedWord32 = SVL.take (div signalLength 4)
 
 
-noise :: IO (ChunkSize -> () -> CheckEquality Word32)
+noise :: IO (ChunkSize -> Word32 -> CheckEquality Word32)
 noise =
    checkEquality limitWord32
-      (SigP.noiseCore $# 0)
-      (SigP.noiseCoreAlt $# 0)
+      (SigP.noiseCore (arr id))
+      (SigP.noiseCoreAlt (arr id))
 
-noiseVector :: IO (ChunkSize -> () -> CheckEquality (Serial.Plain D4 Word32))
+noiseVector :: IO (ChunkSize -> Word32 -> CheckEquality (Serial.Plain D4 Word32))
 noiseVector =
    checkEquality limitPackedWord32
-      (SigPS.noiseCore $# 0)
-      (SigPS.noiseCoreAlt $# 0)
+      (SigPS.noiseCore (arr id))
+      (SigPS.noiseCoreAlt (arr id))
 
-noiseScalarVector :: IO (ChunkSize -> () -> CheckEquality (Serial.Plain D4 Word32))
+noiseScalarVector :: IO (ChunkSize -> Word32 -> CheckEquality (Serial.Plain D4 Word32))
 noiseScalarVector =
    checkEquality limitPackedWord32
-      (SigPS.noiseCore $# 0)
-      (SigPS.packSmall (SigP.noiseCore $# 0))
+      (SigPS.noiseCore (arr id))
+      (SigPS.packSmall (SigP.noiseCore (arr id)))
 
 
 tests :: [(String, IO ())]
diff --git a/testsuite/Test/Synthesizer/LLVM/RingBufferForward.hs b/testsuite/Test/Synthesizer/LLVM/RingBufferForward.hs
new file mode 100644
--- /dev/null
+++ b/testsuite/Test/Synthesizer/LLVM/RingBufferForward.hs
@@ -0,0 +1,135 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE Rank2Types #-}
+module Test.Synthesizer.LLVM.RingBufferForward (tests) where
+
+import qualified Synthesizer.LLVM.Parameter as Param
+import qualified Synthesizer.LLVM.RingBufferForward as RingBuffer
+import qualified Synthesizer.LLVM.CausalParameterized.Process as CausalP
+import qualified Synthesizer.LLVM.Parameterized.Signal as SigP
+import Synthesizer.LLVM.CausalParameterized.Process (($*), )
+
+import qualified Data.StorableVector.Lazy as SVL
+import qualified Data.StorableVector as SV
+import Data.StorableVector.Lazy (ChunkSize, )
+
+import Test.Synthesizer.LLVM.Utility
+          (CheckEquality, checkEquality, rangeFromInt, )
+
+import Control.Category ((<<<), )
+import Control.Arrow (arr, (***), (^<<), (<<^), )
+import Control.Applicative (pure, )
+import Data.Tuple.HT (fst3, snd3, thd3, )
+
+import qualified LLVM.Extra.Arithmetic as A
+
+import qualified LLVM.Core as LLVM
+import LLVM.Core (Value, )
+
+import Foreign.Storable (Storable, )
+
+import qualified System.Random as Rnd
+import Data.Word (Word32, )
+
+import Test.QuickCheck (quickCheck, )
+
+import NumericPrelude.Numeric
+import NumericPrelude.Base
+
+
+type EquFloat = CheckEquality Float
+
+signalLength :: Int
+signalLength = 10000
+
+
+limitFloat :: (Storable a) => SVL.Vector a -> SVL.Vector a
+limitFloat = SVL.take signalLength
+
+
+trackId :: IO (ChunkSize -> (Int, Word32) -> EquFloat)
+trackId =
+   let bufferSize = rangeFromInt (1,1000) <<^ fst
+       noise = SigP.noise (arr snd) 1
+   in  checkEquality limitFloat
+          noise
+          (CausalP.mapSimple (RingBuffer.index A.zero) $*
+           RingBuffer.track bufferSize noise)
+
+trackTail :: IO (ChunkSize -> (Int, Word32) -> EquFloat)
+trackTail =
+   let bufferSize = rangeFromInt (2,1000) <<^ fst
+       noise = SigP.noise (arr snd) 1
+   in  checkEquality limitFloat
+          (SigP.tail noise)
+          (CausalP.mapSimple (RingBuffer.index A.one) $*
+           RingBuffer.track bufferSize noise)
+
+trackDrop :: IO (ChunkSize -> (Int, Word32) -> EquFloat)
+trackDrop =
+   let n = rangeFromInt (0,1000) <<^ fst
+       noise = SigP.noise (arr snd) 1
+   in  checkEquality limitFloat
+          (SigP.drop n noise)
+          (CausalP.map RingBuffer.index (fmap (fromIntegral :: Int -> Word32) n) $*
+           RingBuffer.track (fmap succ n) noise)
+
+randomSkips :: Param.T p (Int, Int) -> SigP.T p (Value Word32)
+randomSkips p =
+   SigP.fromStorableVectorLazy
+      ((\(len, seed) ->
+          SVL.cycle $
+          SVL.fromChunks
+             [fst $ SV.packN len $ Rnd.randomRs (0,10::Word32) seed])
+       ^<< rangeFromInt (1,100) *** arr Rnd.mkStdGen <<< p)
+
+trackSkip :: IO (ChunkSize -> ((Int,Int), Word32) -> EquFloat)
+trackSkip =
+   let skips = randomSkips (arr fst)
+       noise = SigP.noise (arr snd) 1
+   in  checkEquality limitFloat
+          (CausalP.skip noise $* skips)
+          (CausalP.mapSimple (RingBuffer.index A.one) $*
+           (RingBuffer.trackSkip 1 noise $* skips))
+
+trackSkip1 :: IO (ChunkSize -> (Int, Word32) -> EquFloat)
+trackSkip1 =
+   let bufferSize = 1000
+       k = rangeFromInt (0, fromIntegral bufferSize-1 :: Word32) <<^ fst
+       noise = SigP.noise (arr snd) 1
+   in  checkEquality limitFloat
+          (CausalP.map RingBuffer.index k $*
+           (RingBuffer.track (pure bufferSize) noise))
+          (CausalP.map RingBuffer.index k $*
+           (RingBuffer.trackSkip (pure bufferSize) noise $* 1))
+
+trackSkipHold ::
+   IO (ChunkSize -> ((Int,Int), Int, Word32) -> CheckEquality (Bool, Float))
+trackSkipHold =
+   let bufferSize = 1000
+       skips = randomSkips (arr fst3)
+       k = rangeFromInt (0, fromIntegral bufferSize-1 :: Word32) <<^ snd3
+       noise = SigP.noise (arr thd3) 1
+   in  checkEquality limitFloat
+          (fmap ((,) (LLVM.valueOf True)) $
+           (CausalP.map RingBuffer.index k $*
+            (RingBuffer.trackSkip (pure bufferSize) noise $* skips)))
+          (CausalP.map
+              (\ki ((b,_s),buf) -> fmap ((,) b) $ RingBuffer.index ki buf) k $*
+           (RingBuffer.trackSkipHold (pure bufferSize) noise $* skips))
+
+{-
+To do:
+
+test that trackSkipHold returns False forever after it has returned False once.
+-}
+
+
+tests :: [(String, IO ())]
+tests =
+   ("trackId", quickCheck =<< trackId) :
+   ("trackTail", quickCheck =<< trackTail) :
+   ("trackDrop", quickCheck =<< trackDrop) :
+   ("trackSkip", quickCheck =<< trackSkip) :
+   ("trackSkip1", quickCheck =<< trackSkip1) :
+   ("trackSkipHold", quickCheck =<< trackSkipHold) :
+   []