diff --git a/Changes.md b/Changes.md
new file mode 100644
--- /dev/null
+++ b/Changes.md
@@ -0,0 +1,11 @@
+# Change log for the `synthesizer-core` package
+
+## 8.1
+
+* `Plain.Filter.Recursive.FirstOrder.highpassInit`,
+  `Plain.Filter.Recursive.FirstOrder.highpassModifierInit`
+  and derived functions change the meaning of the initial parameter.
+  The previous meaning was pretty unclear and useless
+  such that I consider it a bug.
+  We do no longer negate the initial value.
+  This is consistent with `lowpassInit`.
diff --git a/private/Synthesizer/Basic/NumberTheory.hs b/private/Synthesizer/Basic/NumberTheory.hs
--- a/private/Synthesizer/Basic/NumberTheory.hs
+++ b/private/Synthesizer/Basic/NumberTheory.hs
@@ -115,6 +115,7 @@
    primitiveRootsOfUnityFullOrbitTest,
    maximumOrderOfPrimitiveRootsOfUnityNaive,
    maximumOrderOfPrimitiveRootsOfUnityInteger,
+   divideByMaximumPowerRecursive,
    numbers3SmoothCorec,
    numbers3SmoothFoldr,
    numbers3SmoothSet,
@@ -759,11 +760,11 @@
    last $
    n : unfoldr (\m -> case divMod m b of (q,r) -> toMaybe (isZero r) (q,q)) n
 
-_divideByMaximumPowerRecursive ::
+divideByMaximumPowerRecursive ::
    (Integral.C a, Eq a, ZeroTestable.C a) => a -> a -> a
-_divideByMaximumPowerRecursive b =
+divideByMaximumPowerRecursive b =
    let recourse n =
-          case divMod b n of
+          case divMod n b of
              (q,0) -> recourse q
              _ -> n
    in  recourse
diff --git a/speedtest/SpeedTestExp.hs b/speedtest/SpeedTestExp.hs
--- a/speedtest/SpeedTestExp.hs
+++ b/speedtest/SpeedTestExp.hs
@@ -105,6 +105,7 @@
    withBinaryFile name WriteMode $ \h ->
    newArray_ (0,2*num-1) >>= \arr ->
       let k = 0.5**(1/hl)
+          loop :: Int -> Double -> IO ()
           loop i y =
              if i<num
                then writeArray (arr :: IOUArray Int Int16)
diff --git a/src/Synthesizer/Basic/Distortion.hs b/src/Synthesizer/Basic/Distortion.hs
--- a/src/Synthesizer/Basic/Distortion.hs
+++ b/src/Synthesizer/Basic/Distortion.hs
@@ -11,12 +11,14 @@
    zigZag, sine,
    oddChebyshev, {- swing, -}
    quantize,
+   powerSigned,
    ) where
 
 import qualified Algebra.Transcendental        as Trans
 import qualified Algebra.RealField             as RealField
 import qualified Algebra.Field                 as Field
 import qualified Algebra.RealRing              as RealRing
+import qualified Algebra.Absolute              as Absolute
 import qualified Algebra.Ring                  as Ring
 
 import Data.List.HT (mapAdjacent, )
@@ -142,3 +144,14 @@
 
 quantize :: (RealField.C a) => a -> a
 quantize x = fromIntegral (round x :: Int)
+
+
+{- * other -}
+
+{- |
+Power function.
+Roughly the map @\p x -> x**p@ but retains the sign of @x@.
+-}
+{-# INLINE powerSigned #-}
+powerSigned :: (Absolute.C a, Trans.C a) => a -> a -> a
+powerSigned p x = signum x * abs x ** p
diff --git a/src/Synthesizer/Basic/Wave.hs b/src/Synthesizer/Basic/Wave.hs
--- a/src/Synthesizer/Basic/Wave.hs
+++ b/src/Synthesizer/Basic/Wave.hs
@@ -51,6 +51,7 @@
    truncCosine,
    truncTriangle,
    powerNormed,
+   powerNormed2,
    logitSaw,
    logitSine,
    sineSquare,
@@ -78,6 +79,7 @@
    ) where
 
 import qualified Synthesizer.Basic.Phase as Phase
+import qualified Synthesizer.Basic.Distortion as Distort
 
 import qualified Algebra.RealTranscendental    as RealTrans
 import qualified Algebra.Transcendental        as Trans
@@ -590,19 +592,20 @@
 The sign is flipped with respect to 'saw' and 'sine'
 which is an historical artifact.
 -}
+{-# DEPRECATED powerNormed "Use powerNormed2 instead." #-}
 {-# INLINE powerNormed #-}
 powerNormed :: (Absolute.C a, Trans.C a) => a -> T a a
-powerNormed p = distort (negate . power01Normed p) saw
-
--- | auxiliary
-{-# INLINE power01Normed #-}
-power01Normed :: (Absolute.C a, Trans.C a) => a -> a -> a
-power01Normed p x = (p+0.5) * powerSigned p x
+powerNormed p = amplify (-p-0.5) $ distort (Distort.powerSigned p) saw
 
--- | auxiliary
-{-# INLINE powerSigned #-}
-powerSigned :: (Absolute.C a, Trans.C a) => a -> a -> a
-powerSigned p x = signum x * abs x ** p
+{- |
+Power function.
+Roughly the map @\p x -> x**p@
+but retains the sign of @x@ and
+normalizes the mapping over @[0,1]@ to an L2 norm of 1.
+-}
+{-# INLINE powerNormed2 #-}
+powerNormed2 :: (Absolute.C a, Trans.C a) => a -> T a a
+powerNormed2 p = amplify (sqrt (1+2*p)) $ distort (Distort.powerSigned p) saw
 
 
 {- |
@@ -633,7 +636,7 @@
       a {- ^ 0 for 'sine', 1 for 'square' -}
    -> T a a
 sineSquare c =
-   distort (powerSigned (1-c)) sine
+   distort (Distort.powerSigned (1-c)) sine
 
 
 
diff --git a/src/Synthesizer/Generic/Filter/NonRecursive.hs b/src/Synthesizer/Generic/Filter/NonRecursive.hs
--- a/src/Synthesizer/Generic/Filter/NonRecursive.hs
+++ b/src/Synthesizer/Generic/Filter/NonRecursive.hs
@@ -392,8 +392,7 @@
    (Additive.C v, SigG.Write sig v) =>
    Int -> sig v -> ([Int], [sig v])
 pyramid height sig =
-   let sizes =
-          reverse $ take (1+height) $ iterate (2*) 1
+   let sizes = reverse $ take (1+height) $ iterate (2*) 1
    in  (sizes,
         scanl (flip sumsDownsample2) sig (map SigG.LazySize $ tail sizes))
 
@@ -508,11 +507,8 @@
    sig (Int,Int) -> sig v
 accumulatePosModulatedFromPyramid accumulate (sizes,pyr0) ctrl =
    let blockSize = head sizes
-       pyrStarts =
-          iterate (zipWith SigG.drop sizes) pyr0
-       ctrlBlocks =
-          SigS.toList $
-          SigG.sliceVertical blockSize ctrl
+       pyrStarts = iterate (zipWith SigG.drop sizes) pyr0
+       ctrlBlocks = SigS.toList $ SigG.sliceVertical blockSize ctrl
    in  SigG.concat $
        zipWith
           (\pyr ->
@@ -561,8 +557,7 @@
 
 
 inverseFrequencyModulationFloor ::
-   (Ord t, Ring.C t,
-    SigG.Write sig v, SigG.Read sig t) =>
+   (Ord t, Ring.C t, SigG.Write sig v, SigG.Read sig t) =>
    SigG.LazySize ->
    sig t -> sig v -> sig v
 inverseFrequencyModulationFloor chunkSize ctrl xs =
diff --git a/src/Synthesizer/Generic/Filter/Recursive/MovingAverage.hs b/src/Synthesizer/Generic/Filter/Recursive/MovingAverage.hs
--- a/src/Synthesizer/Generic/Filter/Recursive/MovingAverage.hs
+++ b/src/Synthesizer/Generic/Filter/Recursive/MovingAverage.hs
@@ -155,7 +155,7 @@
 -}
 {-# INLINE sumsModulatedHalf #-}
 sumsModulatedHalf ::
-   (RealField.C a, Module.C a v, SigG.Transform sig a, SigG.Transform sig v, SigG.Write sig v) =>
+   (RealField.C a, Module.C a v, SigG.Transform sig a, SigG.Write sig v) =>
    Int -> sig a -> sig v -> sig v
 sumsModulatedHalf maxDInt ds xs =
    let maxD  = fromIntegral maxDInt
@@ -167,7 +167,7 @@
 
 {-# INLINE modulatedFrac #-}
 modulatedFrac ::
-   (RealField.C a, Module.C a v, SigG.Transform sig a, SigG.Transform sig v, SigG.Write sig v) =>
+   (RealField.C a, Module.C a v, SigG.Transform sig a, SigG.Write sig v) =>
    Int -> sig a -> sig v -> sig v
 modulatedFrac maxDInt ds xs =
    SigG.zipWith (\d y -> recip (2*d) *> y) ds $
diff --git a/src/Synthesizer/Generic/Fourier.hs b/src/Synthesizer/Generic/Fourier.hs
--- a/src/Synthesizer/Generic/Fourier.hs
+++ b/src/Synthesizer/Generic/Fourier.hs
@@ -681,7 +681,7 @@
 -}
 {- suffers from big inefficiency of repeated 'append'
    SigG.takeStateMatch sig $
-   SigS.monoidConcat $
+   SigS.fold $
    SigS.map (SigS.take (fromIntegral n) . powers sig) $
    SigS.take (fromIntegral m) $ -- necessary for strict storable vectors
    powers sig z
@@ -706,7 +706,7 @@
        Permutation.apply transposeNM .
 --       concatRechunk sig .
        SigG.zipWith (*) twiddle .
-       SigS.monoidConcat .
+       SigS.fold .
        SigS.map (transformWithCache subCacheN) .
        SigG.sliceVertical (fromInteger n) .
        Permutation.apply transposeMN $
@@ -786,7 +786,7 @@
 concatRechunk pattern =
    SigG.takeStateMatch pattern .
    SigG.toState .
-   SigS.monoidConcat
+   SigS.fold
 
 
 data LevelPrime =
diff --git a/src/Synthesizer/Generic/Oscillator.hs b/src/Synthesizer/Generic/Oscillator.hs
--- a/src/Synthesizer/Generic/Oscillator.hs
+++ b/src/Synthesizer/Generic/Oscillator.hs
@@ -71,7 +71,8 @@
 
 {- | oscillator with both shape and frequency modulation -}
 shapeFreqMod ::
-   (RealField.C a, SigG.Read sig c, SigG.Transform sig a, SigG.Transform sig b) =>
+   (RealField.C a,
+    SigG.Read sig c, SigG.Transform sig a, SigG.Transform sig b) =>
    (c -> Wave.T a b) -> Phase.T a -> sig c -> sig a -> sig b
 shapeFreqMod wave phase parameters =
    Causal.apply
@@ -97,7 +98,9 @@
 {- | oscillator with a sampled waveform with modulated frequency
 Should behave homogenously for different types of interpolation.
 -}
-freqModSample :: (RealField.C a, SigG.Read wave b, SigG.Transform sig a, SigG.Transform sig b) =>
+freqModSample ::
+   (RealField.C a,
+    SigG.Read wave b, SigG.Transform sig a, SigG.Transform sig b) =>
    Interpolation.T a b -> wave b -> Phase.T a -> sig a -> sig b
 freqModSample ip wave phase freqs =
    let len = fromIntegral $ SigG.length wave
diff --git a/src/Synthesizer/Generic/Signal.hs b/src/Synthesizer/Generic/Signal.hs
--- a/src/Synthesizer/Generic/Signal.hs
+++ b/src/Synthesizer/Generic/Signal.hs
@@ -798,10 +798,15 @@
       (foldL (Additive.+))
 -}
 
+
+{-# INLINE foldMap #-}
+foldMap :: (Read sig a, Monoid m) => (a -> m) -> sig a -> m
+foldMap f = foldR (mappend . f) mempty
+
+{-# DEPRECATED monoidConcatMap "Use foldMap instead." #-}
 {-# INLINE monoidConcatMap #-}
 monoidConcatMap :: (Read sig a, Monoid m) => (a -> m) -> sig a -> m
-monoidConcatMap f =
-   foldR (mappend . f) mempty
+monoidConcatMap = foldMap
 
 
 {-# INLINE tails #-}
diff --git a/src/Synthesizer/PiecewiseConstant/Generic.hs b/src/Synthesizer/PiecewiseConstant/Generic.hs
new file mode 100644
--- /dev/null
+++ b/src/Synthesizer/PiecewiseConstant/Generic.hs
@@ -0,0 +1,44 @@
+module Synthesizer.PiecewiseConstant.Generic (
+   toSignal,
+   toSignalInit,
+   toSignalInitWith,
+   ) where
+
+import qualified Synthesizer.PiecewiseConstant.Private as PC
+import Synthesizer.PiecewiseConstant.Private (StrictTime)
+
+import qualified Synthesizer.Generic.Signal as SigG
+import qualified Synthesizer.Generic.Cut    as CutG
+
+import qualified Data.EventList.Relative.BodyTime as EventListBT
+import qualified Data.EventList.Relative.TimeBody as EventList
+
+import qualified Numeric.NonNegative.Wrapper as NonNegW
+
+
+
+replicateLong ::
+   (SigG.Write sig y) =>
+   StrictTime -> y -> sig y
+replicateLong tl y =
+   CutG.concat $
+   map (\t ->
+      SigG.replicate
+--         (SigG.LazySize $ fromIntegral $ maxBound::Int)
+         SigG.defaultLazySize
+         (NonNegW.toNumber t) y) $
+   PC.chopLongTime tl
+
+{-# INLINE toSignal #-}
+toSignal :: (SigG.Write sig y) => EventListBT.T StrictTime y -> sig y
+toSignal = PC.toSignal replicateLong
+
+{-# INLINE toSignalInit #-}
+toSignalInit :: (SigG.Write sig y) => y -> EventList.T StrictTime y -> sig y
+toSignalInit = PC.toSignalInit replicateLong
+
+{-# INLINE toSignalInitWith #-}
+toSignalInitWith ::
+   (SigG.Write sig c) =>
+   (y -> c) -> c -> EventList.T StrictTime [y] -> sig c
+toSignalInitWith = PC.toSignalInitWith replicateLong
diff --git a/src/Synthesizer/PiecewiseConstant/Private.hs b/src/Synthesizer/PiecewiseConstant/Private.hs
new file mode 100644
--- /dev/null
+++ b/src/Synthesizer/PiecewiseConstant/Private.hs
@@ -0,0 +1,75 @@
+module Synthesizer.PiecewiseConstant.Private where
+
+import qualified Synthesizer.Generic.Signal as SigG
+
+import qualified Data.EventList.Relative.BodyTime  as EventListBT
+import qualified Data.EventList.Relative.TimeBody  as EventList
+
+import qualified Numeric.NonNegative.Wrapper as NonNegW
+
+import Control.Monad.Trans.State (evalState, get, put, )
+
+import qualified Data.List as List
+import Data.Traversable (traverse, )
+import Data.Foldable (traverse_, )
+
+
+
+type StrictTime = NonNegW.Integer
+type ShortStrictTime = NonNegW.Int
+
+
+{-# INLINE toSignal #-}
+toSignal ::
+   (SigG.Transform sig y) =>
+   (StrictTime -> y -> sig y) ->
+   EventListBT.T StrictTime y -> sig y
+toSignal replicateLong =
+   EventListBT.foldrPair
+      (\y t -> SigG.append (replicateLong t y))
+      SigG.empty
+
+{-# INLINE toSignalInit #-}
+toSignalInit ::
+   (SigG.Transform sig y) =>
+   (StrictTime -> y -> sig y) ->
+   y -> EventList.T StrictTime y -> sig y
+toSignalInit replicateLong initial =
+   (\ ~(t,rest) -> SigG.append (replicateLong t initial) rest)
+   .
+   EventList.foldr
+      (,)
+      (\y ~(t,rest) -> SigG.append (replicateLong t y) rest)
+      (0, SigG.empty)
+{-
+   toSignal .
+--   EventListBM.switchBodyR const .
+--   EventListBM.snocTime NonNeg.zero .
+--   EventListMB.consBody initial .
+   -- switchBodyR causes a space leak
+   EventListTM.switchBodyR EventListBT.empty
+      (\xs _ -> EventListMT.consBody initial xs)
+-}
+
+{-# INLINE toSignalInitWith #-}
+toSignalInitWith ::
+   (SigG.Transform sig c) =>
+   (StrictTime -> c -> sig c) ->
+   (y -> c) -> c -> EventList.T StrictTime [y] -> sig c
+toSignalInitWith replicateLong f initial =
+   toSignalInit replicateLong initial .
+   flip evalState initial .
+   traverse (\evs -> traverse_ (put . f) evs >> get)
+
+
+{- |
+Returns a list of non-zero times.
+-}
+{-# INLINE chopLongTime #-}
+chopLongTime :: StrictTime -> [ShortStrictTime]
+chopLongTime n =
+   let d = fromIntegral (maxBound :: Int)
+       (q,r) = divMod (NonNegW.toNumber n) d
+   in  map (NonNegW.fromNumberMsg "chopLongTime" . fromInteger) $
+       List.genericReplicate q d ++
+       if r/=0 then [r] else []
diff --git a/src/Synthesizer/PiecewiseConstant/Signal.hs b/src/Synthesizer/PiecewiseConstant/Signal.hs
--- a/src/Synthesizer/PiecewiseConstant/Signal.hs
+++ b/src/Synthesizer/PiecewiseConstant/Signal.hs
@@ -12,6 +12,9 @@
    zipWith,
    ) where
 
+import Synthesizer.PiecewiseConstant.Private
+         (StrictTime, ShortStrictTime, chopLongTime)
+
 import qualified Data.EventList.Relative.TimeTime  as EventListTT
 import qualified Data.EventList.Relative.MixedTime as EventListMT
 import qualified Data.EventList.Relative.BodyTime  as EventListBT
@@ -32,8 +35,6 @@
 import qualified Prelude as P
 
 
-type StrictTime = NonNegW.Integer
-type ShortStrictTime = NonNegW.Int
 type LazyTime = NonNegChunky.T StrictTime
 
 type T = EventListBT.T StrictTime
@@ -67,18 +68,6 @@
       (NonNegChunky.fromChunks .
        List.concatMap chopLongTime .
        NonNegChunky.toChunks)
-
-{- |
-Returns a list of non-zero times.
--}
-{-# INLINE chopLongTime #-}
-chopLongTime :: StrictTime -> [ShortStrictTime]
-chopLongTime n =
-   let d = fromIntegral (maxBound :: Int)
-       (q,r) = P.divMod (NonNegW.toNumber n) d
-   in  map (NonNegW.fromNumberMsg "chopLongTime" . fromInteger) $
-       List.genericReplicate q d ++
-       if not $ isZero r then [r] else []
 
 {-# INLINE longFromShortTime #-}
 longFromShortTime :: ShortStrictTime -> StrictTime
diff --git a/src/Synthesizer/PiecewiseConstant/Storable.hs b/src/Synthesizer/PiecewiseConstant/Storable.hs
new file mode 100644
--- /dev/null
+++ b/src/Synthesizer/PiecewiseConstant/Storable.hs
@@ -0,0 +1,47 @@
+module Synthesizer.PiecewiseConstant.Storable (
+   toSignal,
+   toSignalInit,
+   toSignalInitWith,
+   ) where
+
+import qualified Synthesizer.PiecewiseConstant.Private as PC
+import Synthesizer.PiecewiseConstant.Private (StrictTime)
+
+import qualified Synthesizer.Storable.Signal     as SigSt
+import qualified Data.StorableVector.Lazy.Pattern as SigStV
+import qualified Data.StorableVector.Lazy        as SVL
+
+import qualified Data.EventList.Relative.BodyTime  as EventListBT
+import qualified Data.EventList.Relative.TimeBody  as EventList
+
+import Foreign.Storable (Storable, )
+
+import qualified Numeric.NonNegative.Wrapper as NonNegW
+import qualified Numeric.NonNegative.Chunky as NonNegChunky
+
+
+
+chunkSizesFromStrictTime :: StrictTime -> NonNegChunky.T SigSt.ChunkSize
+chunkSizesFromStrictTime =
+   NonNegChunky.fromChunks .
+   map (SVL.ChunkSize . NonNegW.toNumber) .
+   PC.chopLongTime
+
+
+replicateLong :: (Storable y) => StrictTime -> y -> SigSt.T y
+replicateLong t y =
+   SigStV.replicate (chunkSizesFromStrictTime t) y
+
+{-# INLINE toSignal #-}
+toSignal :: (Storable y) => EventListBT.T StrictTime y -> SigSt.T y
+toSignal = PC.toSignal replicateLong
+
+{-# INLINE toSignalInit #-}
+toSignalInit :: (Storable y) => y -> EventList.T StrictTime y -> SigSt.T y
+toSignalInit = PC.toSignalInit replicateLong
+
+{-# INLINE toSignalInitWith #-}
+toSignalInitWith ::
+   (Storable c) =>
+   (y -> c) -> c -> EventList.T StrictTime [y] -> SigSt.T c
+toSignalInitWith = PC.toSignalInitWith replicateLong
diff --git a/src/Synthesizer/Plain/Filter/Recursive/FirstOrder.hs b/src/Synthesizer/Plain/Filter/Recursive/FirstOrder.hs
--- a/src/Synthesizer/Plain/Filter/Recursive/FirstOrder.hs
+++ b/src/Synthesizer/Plain/Filter/Recursive/FirstOrder.hs
@@ -30,6 +30,8 @@
 import qualified Foreign.Storable.Traversable as StoreTrav
 import Foreign.Storable (Storable(sizeOf, alignment, peek, poke))
 
+import qualified Test.QuickCheck as QC
+
 import qualified Algebra.Module                as Module
 import qualified Algebra.Transcendental        as Trans
 import qualified Algebra.Ring                  as Ring
@@ -41,7 +43,7 @@
 
 
 newtype Parameter a = Parameter {getParameter :: a}
-   deriving Show
+   deriving (Eq, Show)
 
 
 instance Functor Parameter where
@@ -74,7 +76,10 @@
    peek = Store.peek Parameter
    poke = Store.poke getParameter
 
+instance QC.Arbitrary a => QC.Arbitrary (Parameter a) where
+   arbitrary = fmap Parameter QC.arbitrary
 
+
 {-| Convert cut-off frequency to feedback factor. -}
 {-# INLINE parameter #-}
 parameter :: Trans.C a => a -> Parameter a
@@ -129,7 +134,7 @@
 highpassModifierInit :: (Ring.C a, Module.C a v) =>
    Modifier.Initialized v v (Parameter a) v v
 highpassModifierInit =
-   Modifier.Initialized negate highpassStep
+   Modifier.Initialized id highpassStep
 
 {-# INLINE highpassModifier #-}
 highpassModifier :: (Ring.C a, Module.C a v) =>
@@ -146,7 +151,7 @@
 highpassInitAlt :: (Ring.C a, Module.C a v) =>
    v -> Sig.T (Parameter a) -> Sig.T v -> Sig.T v
 highpassInitAlt y0 control x =
-   x - lowpassInit (-y0) control x
+   zipWith (-) x $ lowpassInit y0 control x
 
 {-# INLINE highpass #-}
 highpass :: (Ring.C a, Module.C a v) =>
@@ -156,6 +161,7 @@
 
 
 data Result a = Result {highpass_, lowpass_ :: !a}
+   deriving (Eq)
 
 instance Functor Result where
    {-# INLINE fmap #-}
@@ -203,6 +209,9 @@
    alignment = StoreTrav.alignment
    peek      = StoreTrav.peekApplicative
    poke      = StoreTrav.poke
+
+instance QC.Arbitrary a => QC.Arbitrary (Result a) where
+   arbitrary = liftA2 Result QC.arbitrary QC.arbitrary
 
 
 {-# INLINE step #-}
diff --git a/src/Synthesizer/Plain/Instrument.hs b/src/Synthesizer/Plain/Instrument.hs
--- a/src/Synthesizer/Plain/Instrument.hs
+++ b/src/Synthesizer/Plain/Instrument.hs
@@ -254,7 +254,7 @@
 osciSharp sampleRate freq =
    let --control = iterate (+ (-1/sampleRate)) 4
        control = exponential2 (0.01*sampleRate) 10
-   in  Osci.shapeMod Wave.powerNormed 0 (freq/sampleRate) control
+   in  Osci.shapeMod Wave.powerNormed2 0 (freq/sampleRate) control
 
 {-| Build a saw sound from its harmonics and modulate it.
     Different to normal modulation
diff --git a/src/Synthesizer/State/Signal.hs b/src/Synthesizer/State/Signal.hs
--- a/src/Synthesizer/State/Signal.hs
+++ b/src/Synthesizer/State/Signal.hs
@@ -922,11 +922,21 @@
 {- |
 Counterpart to 'Data.Monoid.mconcat'.
 -}
+fold :: Monoid m => T m -> m
+fold = foldR mappend mempty
+
+{-# DEPRECATED monoidConcat "Use foldMap instead." #-}
 monoidConcat :: Monoid m => T m -> m
-monoidConcat = foldR mappend mempty
+monoidConcat = fold
 
+
+foldMap :: Monoid m => (a -> m) -> T a -> m
+foldMap f = monoidConcat . map f
+
+{-# DEPRECATED monoidConcatMap "Use foldMap instead." #-}
 monoidConcatMap :: Monoid m => (a -> m) -> T a -> m
-monoidConcatMap f = monoidConcat . map f
+monoidConcatMap = foldMap
+
 
 instance Monoid (T y) where
    mempty = empty
diff --git a/src/Synthesizer/Storable/Filter/NonRecursive.hs b/src/Synthesizer/Storable/Filter/NonRecursive.hs
--- a/src/Synthesizer/Storable/Filter/NonRecursive.hs
+++ b/src/Synthesizer/Storable/Filter/NonRecursive.hs
@@ -9,6 +9,11 @@
 Portability :  requires multi-parameter type classes
 -}
 module Synthesizer.Storable.Filter.NonRecursive (
+   delay,
+   delayPad,
+   delayPos,
+   delayNeg,
+
    downsample2,
    sumsDownsample2,
    convolveDownsample2,
@@ -57,6 +62,31 @@
 import NumericPrelude.Base as NP
 
 
+
+{-# INLINE delay #-}
+delay :: (Additive.C y, Storable y) => Int -> SigSt.T y -> SigSt.T y
+delay = delayPad zero
+
+{-# INLINE delayPad #-}
+delayPad :: (Storable y) => y -> Int -> SigSt.T y -> SigSt.T y
+delayPad z n =
+   if n<0
+     then delayNeg (Additive.negate n)
+     else delayPosPad z n
+
+{-# INLINE delayPos #-}
+delayPos :: (Additive.C y, Storable y) => Int -> SigSt.T y -> SigSt.T y
+delayPos = delayPosPad zero
+
+{-# INLINE delayPosPad #-}
+delayPosPad :: (Storable v) => v -> Int -> SigSt.T v -> SigSt.T v
+delayPosPad z n = SigSt.append (SigSt.replicate SigSt.defaultChunkSize n z)
+
+{-# INLINE delayNeg #-}
+delayNeg :: (Storable y) => Int -> SigSt.T y -> SigSt.T y
+delayNeg = SigSt.drop
+
+
 {- |
 The Maybe type carries an unpaired value from one block to the next one.
 -}
@@ -215,7 +245,7 @@
    (Additive.C v, Storable v) =>
    Int -> SigSt.T (Int,Int) -> SigSt.T v -> SigSt.T v
 sumsPosModulatedPyramid height ctrl xs =
-   FiltG.accumulatePosModulatedFromPyramid
+   accumulatePosModulatedPyramid
       FiltG.sumRangeFromPyramid
       (addSizes $ pyramid (+) height xs)
       ctrl
@@ -225,7 +255,7 @@
    (v -> v -> v) ->
    Int -> SigSt.T (Int,Int) -> SigSt.T v -> SigSt.T v
 accumulateBinPosModulatedPyramid acc height ctrl xs =
-   FiltG.accumulatePosModulatedFromPyramid
+   accumulatePosModulatedPyramid
       (\pyr ->
          fromMaybe (error "accumulateBinPosModulatedPyramid: empty window") .
          FiltG.maybeAccumulateRangeFromPyramid acc pyr)
@@ -245,11 +275,12 @@
 movingAverageModulatedPyramid ::
    (Field.C a, Module.C a v, Storable Int, Storable v) =>
    a -> Int -> Int -> SigSt.T Int -> SigSt.T v -> SigSt.T v
-movingAverageModulatedPyramid amp height maxC ctrl xs =
-   SigSt.zipWith (\c x -> (amp / fromIntegral (2*c+1)) *> x) ctrl $
-   sumsPosModulatedPyramid height
-      (SigSt.map (\c -> (maxC - c, maxC + c + 1)) ctrl)
-      (FiltG.delay maxC xs)
+movingAverageModulatedPyramid amp height maxC ctrl0 =
+   withPaddedInput zero
+      (\ctrl xs ->
+         SigSt.zipWith (\c x -> (amp / fromIntegral (2*c+1)) *> x) ctrl0 $
+         sumsPosModulatedPyramid height ctrl xs)
+      maxC ctrl0
 
 
 movingAccumulateModulatedPyramid ::
@@ -257,10 +288,20 @@
    (v -> v -> v) ->
    v -> Int -> Int -> SigSt.T Int -> SigSt.T v -> SigSt.T v
 movingAccumulateModulatedPyramid acc pad height =
-   FiltG.withPaddedInput pad $
+   withPaddedInput pad $
    accumulateBinPosModulatedPyramid acc height
 
 
+withPaddedInput ::
+   (Storable y) =>
+   y -> (SigSt.T (Int, Int) -> SigSt.T y -> v) ->
+   Int -> SigSt.T Int -> SigSt.T y -> v
+withPaddedInput pad proc maxC ctrl xs =
+   proc
+      (SigSt.map (\c -> (maxC - c, maxC + c + 1)) ctrl)
+      (delayPad pad maxC xs)
+
+
 {- |
 The function is like that of
 'Synthesizer.State.Filter.NonRecursive.inverseFrequencyModulationFloor',
@@ -273,7 +314,8 @@
 (Since control and input signal are aligned in time,
 we might as well use the control chunk structure.
 Currently I do not know what is better.
-For the above example it doesn't matter.)
+For the above example it doesn't matter.
+We might implement a variant in Causal.Filter.NonRecursive.)
 
 This function cannot be written using generic functions,
 since we have to inspect the chunks individually.
diff --git a/src/Synthesizer/Storable/Signal.hs b/src/Synthesizer/Storable/Signal.hs
--- a/src/Synthesizer/Storable/Signal.hs
+++ b/src/Synthesizer/Storable/Signal.hs
@@ -89,186 +89,14 @@
 import Prelude ()
 
 
-{-
-import NumericPrelude.Numeric
-   (sum, (+), (-), divMod, fromIntegral, fromInteger, toInteger, isZero, zero, )
-
-import Prelude hiding
-   (length, (++), iterate, foldl, map, repeat, replicate, null,
-    zip, zipWith, zipWith3, drop, take, splitAt, takeWhile, reverse)
--}
-
-{-
-import qualified Prelude as P
-import Prelude
-   (IO, ($), (.), fst, snd, id,
-    Int, Double, Float,
-    Char, Num, Show, showsPrec, FilePath,
-    Bool(True,False), not,
-    flip, curry, uncurry,
-    Ord, (<), (>), (<=), {- (>=), (==), -} min, max,
-    mapM_, fmap, (=<<), return,
-    Enum, succ, pred, )
--}
-
-
 -- this form is needed for Storable signal embed in amplitude signal
 type T = Vector.Vector
--- type T a = Vector.Vector a
 
 
 defaultChunkSize :: ChunkSize
 defaultChunkSize = ChunkSize 1024
 
 
-{-
-{- * Helper functions for StorableVector -}
-
-cancelNullVector :: (Vector a, b) -> Maybe (Vector a, b)
-cancelNullVector y =
-   toMaybe (not (Vector.null (fst y))) y
-
-viewLVector :: Storable a =>
-   Vector a -> Maybe (a, Vector a)
-viewLVector = Vector.viewL
-{-
-   toMaybe
-      (not (Vector.null x))
-      (Vector.head x, Vector.tail x)
--}
-
-crochetLVector :: (Storable x, Storable y) =>
-      (x -> acc -> Maybe (y, acc))
-   -> acc
-   -> Vector x
-   -> (Vector y, Maybe acc)
-crochetLVector f acc0 x0 =
-   mapSnd (fmap fst) $
-   Vector.unfoldrN
-      (Vector.length x0)
-      (\(acc,xt) ->
-         do (x,xs) <- viewLVector xt
-            (y,acc') <- f x acc
-            return (y, (acc',xs)))
-      (acc0, x0)
--}
-
-{-
-reduceLVector :: Storable x =>
-   (x -> acc -> Maybe acc) -> acc -> Vector x -> (acc, Bool)
-reduceLVector f acc0 x =
-   let recourse i acc =
-          if i < Vector.length x
-            then (acc, True)
-            else
-               maybe
-                  (acc, False)
-                  (recourse (succ i))
-                  (f (Vector.index x i) acc)
-   in  recourse 0 acc0
-
-
-
-
-{- * Fundamental functions -}
-
-{- |
-Sophisticated implementation where chunks always have size bigger than 0.
--}
-{-# INLINE [0] unfoldr #-}
-unfoldr :: (Storable b) =>
-      ChunkSize
-   -> (a -> Maybe (b,a))
-   -> a
-   -> T b
-unfoldr (ChunkSize size) f =
-   Cons .
-   List.unfoldr
-      (cancelNullVector . Vector.unfoldrN size f =<<) .
-   Just
-
-{- |
-Simple implementation where chunks can have size 0 in the first run.
-Then they are filtered out.
-This separation might reduce laziness.
--}
-unfoldr0 :: (Storable b) =>
-      ChunkSize
-   -> (a -> Maybe (b,a))
-   -> a
-   -> T b
-unfoldr0 (ChunkSize size) f =
-   Cons .
-   List.filter (not . Vector.null) .
-   List.unfoldr (fmap (Vector.unfoldrN size f)) .
-   Just
-
-
-unfoldr1 :: (Storable b) =>
-      ChunkSize
-   -> (a -> (b, Maybe a))
-   -> Maybe a
-   -> T b
-unfoldr1 size f = unfoldr size (liftM f)
-
-{-# INLINE [0] crochetL #-}
-crochetL :: (Storable x, Storable y) =>
-      (x -> acc -> Maybe (y, acc))
-   -> acc
-   -> T x
-   -> T y
-crochetL f acc0 =
-   Cons . List.unfoldr (\(xt,acc) ->
-       do (x,xs) <- ListHT.viewL xt
-          acc' <- acc
-          return $ mapSnd ((,) xs) $ crochetLVector f acc' x) .
-   flip (,) (Just acc0) .
-   decons
-
-{-
-Usage of 'unfoldr' seems to be clumsy but that covers all cases,
-like different block sizes in source and destination list.
--}
-crochetLSize :: (Storable x, Storable y) =>
-      ChunkSize
-   -> (x -> acc -> Maybe (y, acc))
-   -> acc
-   -> T x
-   -> T y
-crochetLSize size f =
-   curry (unfoldr size (\(acc,xt) ->
-      do (x,xs) <- viewL xt
-         (y,acc') <- f x acc
-         return (y, (acc',xs))))
-
-viewL :: Storable a => T a -> Maybe (a, T a)
-viewL (Cons xs0) =
-   -- dropWhile would be unnecessary if we require that all chunks are non-empty
-   do (x,xs) <- ListHT.viewL (List.dropWhile Vector.null xs0)
-      (y,ys) <- viewLVector x
-      return (y, append (fromChunk ys) (Cons xs))
-
-viewR :: Storable a => T a -> Maybe (T a, a)
-viewR (Cons xs0) =
-   -- dropWhile would be unnecessary if we require that all chunks are non-empty
-   do (xs,x) <- ListHT.viewR (dropWhileRev Vector.null xs0)
-      (ys,y) <- Vector.viewR x
-      return (append (Cons xs) (fromChunk ys), y)
-
-crochetListL :: (Storable y) =>
-      ChunkSize
-   -> (x -> acc -> Maybe (y, acc))
-   -> acc
-   -> [x]
-   -> T y
-crochetListL size f =
-   curry (unfoldr size (\(acc,xt) ->
-      do (x,xs) <- ListHT.viewL xt
-         (y,acc') <- f x acc
-         return (y, (acc',xs))))
--}
-
-
 {-# INLINE fromList #-}
 fromList :: (Storable a) => ChunkSize -> [a] -> T a
 fromList = Vector.pack
@@ -278,334 +106,12 @@
 toList = Vector.unpack
 
 
-{-
--- should start fusion
-fromListCrochetL :: (Storable a) => ChunkSize -> [a] -> T a
-fromListCrochetL size =
-   crochetListL size (\x _ -> Just (x, ())) ()
-
-fromListUnfoldr :: (Storable a) => ChunkSize -> [a] -> T a
-fromListUnfoldr size = unfoldr size ListHT.viewL
-
-fromListPack :: (Storable a) => ChunkSize -> [a] -> T a
-fromListPack (ChunkSize size) =
-   Cons .
-   List.map Vector.pack .
-   sliceVert size
-
-toList :: (Storable a) => T a -> [a]
-toList = List.concatMap Vector.unpack . decons
-
--- if the chunk has length zero, an empty sequence is generated
-fromChunk :: (Storable a) => Vector a -> T a
-fromChunk x =
-   if Vector.null x
-     then empty
-     else Cons [x]
-
-
-{-# INLINE [0] reduceL #-}
-reduceL :: Storable x =>
-   (x -> acc -> Maybe acc) -> acc -> T x -> acc
-reduceL f acc0 =
-   let recourse acc xt =
-          case xt of
-             [] -> acc
-             (x:xs) ->
-                 let (acc',continue) = reduceLVector f acc x
-                 in  if continue
-                       then recourse acc' xs
-                       else acc'
-   in  recourse acc0 . decons
-
-
-
-{- * Basic functions -}
-
-empty :: Storable a => T a
-empty = Cons []
-
-null :: Storable a => T a -> Bool
-null = List.null . decons
-
-
-{-# NOINLINE [0] cons #-}
-cons :: Storable a => a -> T a -> T a
-cons x = Cons . (Vector.singleton x :) . decons
-
-
-length :: T a -> Int
-length = sum . List.map Vector.length . decons
-
-
-reverse :: Storable a => T a -> T a
-reverse =
-   Cons . List.reverse . List.map Vector.reverse . decons
-
-
-{-# INLINE [0] foldl #-}
-foldl :: Storable b => (a -> b -> a) -> a -> T b -> a
-foldl f x0 = List.foldl (Vector.foldl f) x0 . decons
-
-
-{-# INLINE [0] map #-}
-map :: (Storable x, Storable y) =>
-      (x -> y)
-   -> T x
-   -> T y
-map f = mapInline f -- Cons . List.map (Vector.map f) . decons
-
-{-# INLINE mapInline #-}
-mapInline :: (Storable x, Storable y) =>
-      (x -> y)
-   -> T x
-   -> T y
-mapInline f =
-   let mapVec = Vector.map f
-   in  Cons . List.map mapVec . decons
-
-
-
-{-# NOINLINE [0] drop #-}
-drop :: (Storable a) => Int -> T a -> T a
-drop _ (Cons []) = empty
-drop n (Cons (x:xs)) =
-   let m = Vector.length x
-   in  if m<=n
-         then drop (n-m) (Cons xs)
-         else Cons (Vector.drop n x : xs)
-
-{-# NOINLINE [0] take #-}
-take :: (Storable a) => Int -> T a -> T a
-take _ (Cons []) = empty
-take 0 _ = empty
-take n (Cons (x:xs)) =
-   let m = Vector.length x
-   in  if m<=n
-         then Cons $ (x:) $ decons $ take (n-m) $ Cons xs
-         else fromChunk (Vector.take n x)
-
-
-
-{-# NOINLINE [0] splitAt #-}
-splitAt :: (Storable a) => Int -> T a -> (T a, T a)
-splitAt n0 =
-   let recourse _ [] = ([], [])
-       recourse 0 xs = ([], xs)
-       recourse n (x:xs) =
-          let m = Vector.length x
-          in  if m<=n
-                then mapFst (x:) $ recourse (n-m) xs
-                else mapPair ((:[]), (:xs)) $ Vector.splitAt n x
-   in  mapPair (Cons, Cons) . recourse n0 . decons
-
-
-dropMarginRem :: (Storable a) => Int -> Int -> T a -> (Int, T a)
-dropMarginRem n m xs =
-   List.foldl'
-      (\(mi,xsi) k -> (mi-k, drop k xsi))
-      (m,xs)
-      (List.map Vector.length $ decons $ take m $ drop n xs)
-
-{-
-This implementation does only walk once through the dropped prefix.
-It is maximally lazy and minimally space consuming.
--}
-dropMargin :: (Storable a) => Int -> Int -> T a -> T a
-dropMargin n m xs =
-   List.foldl' (flip drop) xs
-      (List.map Vector.length $ decons $ take m $ drop n xs)
-
-
-{-# NOINLINE [0] dropWhile #-}
-dropWhile :: (Storable a) => (a -> Bool) -> T a -> T a
-dropWhile _ (Cons []) = empty
-dropWhile p (Cons (x:xs)) =
-   let y = Vector.dropWhile p x
-   in  if Vector.null y
-         then dropWhile p (Cons xs)
-         else Cons (y:xs)
-
-{-# NOINLINE [0] takeWhile #-}
-takeWhile :: (Storable a) => (a -> Bool) -> T a -> T a
-takeWhile _ (Cons []) = empty
-takeWhile p (Cons (x:xs)) =
-   let y = Vector.takeWhile p x
-   in  if Vector.length y < Vector.length x
-         then fromChunk y
-         else Cons (x : decons (takeWhile p (Cons xs)))
-
-
-{-# NOINLINE [0] span #-}
-span :: (Storable a) => (a -> Bool) -> T a -> (T a, T a)
-span p =
-   let recourse [] = ([],[])
-       recourse (x:xs) =
-          let (y,z) = Vector.span p x
-          in  if Vector.null z
-                then mapFst (x:) (recourse xs)
-                else (decons $ fromChunk y, (z:xs))
-   in  mapPair (Cons, Cons) . recourse . decons
-{-
-span _ (Cons []) = (empty, empty)
-span p (Cons (x:xs)) =
-   let (y,z) = Vector.span p x
-   in  if Vector.length y == 0
-         then mapFst (Cons . (x:) . decons) (span p (Cons xs))
-         else (Cons [y], Cons (z:xs))
--}
-
-concat :: (Storable a) => [T a] -> T a
-concat = Cons . List.concat . List.map decons
-
-
-{- |
-Ensure a minimal length of the list by appending pad values.
--}
-{-# NOINLINE [0] pad #-}
-pad :: (Storable a) => ChunkSize -> a -> Int -> T a -> T a
-pad size y n0 =
-   let recourse n xt =
-          if n<=0
-            then xt
-            else
-              case xt of
-                 [] -> decons $ replicate size n y
-                 x:xs -> x : recourse (n - Vector.length x) xs
-   in  Cons . recourse n0 . decons
-
-padAlt :: (Storable a) => ChunkSize -> a -> Int -> T a -> T a
-padAlt size x n xs =
-   append xs
-      (let m = length xs
-       in  if n>m
-             then replicate size (n-m) x
-             else empty)
-
-
-infixr 5 `append`
-
-{-# NOINLINE [0] append #-}
-append :: T a -> T a -> T a
-append (Cons xs) (Cons ys)  =  Cons (xs List.++ ys)
-
-{-# INLINE iterate #-}
-iterate :: Storable a => ChunkSize -> (a -> a) -> a -> T a
-iterate size f = unfoldr size (\x -> Just (x, f x))
-
-repeat :: Storable a => ChunkSize -> a -> T a
-repeat (ChunkSize size) =
-   Cons . List.repeat . Vector.replicate size
-
-cycle :: Storable a => T a -> T a
-cycle =
-   Cons . List.cycle . decons
-
-replicate :: Storable a => ChunkSize -> Int -> a -> T a
-replicate (ChunkSize size) n x =
-   let (numChunks, rest) = divMod n size
-   in  append
-          (Cons (List.replicate numChunks (Vector.replicate size x)))
-          (fromChunk (Vector.replicate rest x))
--}
-
 {-# INLINE scanL #-}
 scanL :: (Storable a, Storable b) =>
    (a -> b -> a) -> a -> T b -> T a
 scanL = Vector.scanl
 
 
-{-
-{-# INLINE [0] mapAccumL #-}
-mapAccumL :: (Storable a, Storable b) =>
-   (acc -> a -> (acc, b)) -> acc -> T a -> (acc, T b)
-mapAccumL f start =
-   mapSnd Cons .
-   List.mapAccumL (Vector.mapAccumL f) start .
-   decons
-
-{-# INLINE [0] mapAccumR #-}
-mapAccumR :: (Storable a, Storable b) =>
-   (acc -> a -> (acc, b)) -> acc -> T a -> (acc, T b)
-mapAccumR f start =
-   mapSnd Cons .
-   List.mapAccumR (Vector.mapAccumR f) start .
-   decons
-
-{- disabled RULES
-  "Storable.append/repeat/repeat" forall size x.
-      append (repeat size x) (repeat size x) = repeat size x ;
-
-  "Storable.append/repeat/replicate" forall size n x.
-      append (repeat size x) (replicate size n x) = repeat size x ;
-
-  "Storable.append/replicate/repeat" forall size n x.
-      append (replicate size n x) (repeat size x) = repeat size x ;
-
-  "Storable.append/replicate/replicate" forall size n m x.
-      append (replicate size n x) (replicate size m x) =
-         replicate size (n+m) x ;
-
-  "Storable.mix/repeat/repeat" forall size x y.
-      mix (repeat size x) (repeat size y) = repeat size (x+y) ;
-
-  -}
-
-{- disabled RULES
-  "Storable.length/cons" forall x xs.
-      length (cons x xs) = 1 + length xs ;
-
-  "Storable.length/map" forall f xs.
-      length (map f xs) = length xs ;
-
-  "Storable.map/cons" forall f x xs.
-      map f (cons x xs) = cons (f x) (map f xs) ;
-
-  "Storable.map/repeat" forall size f x.
-      map f (repeat size x) = repeat size (f x) ;
-
-  "Storable.map/replicate" forall size f x n.
-      map f (replicate size n x) = replicate size n (f x) ;
-
-  "Storable.map/repeat" forall size f x.
-      map f (repeat size x) = repeat size (f x) ;
-
-  {-
-  This can make things worse, if 'map' is applied to replicate,
-  since this can use of sharing.
-  It can also destroy the more important map/unfoldr fusion in
-    take n . map f . unfoldr g
-
-  "Storable.take/map" forall n f x.
-      take n (map f x) = map f (take n x) ;
-  -}
-
-  "Storable.take/repeat" forall size n x.
-      take n (repeat size x) = replicate size n x ;
-
-  "Storable.take/take" forall n m xs.
-      take n (take m xs) = take (min n m) xs ;
-
-  "Storable.drop/drop" forall n m xs.
-      drop n (drop m xs) = drop (n+m) xs ;
-
-  "Storable.drop/take" forall n m xs.
-      drop n (take m xs) = take (max 0 (m-n)) (drop n xs) ;
-
-  "Storable.map/mapAccumL/snd" forall g f acc0 xs.
-      map g (snd (mapAccumL f acc0 xs)) =
-         snd (mapAccumL (\acc a -> mapSnd g (f acc a)) acc0 xs) ;
-
-  -}
-
-{- GHC says this is an orphaned rule
-  "Storable.map/mapAccumL/mapSnd" forall g f acc0 xs.
-      mapSnd (map g) (mapAccumL f acc0 xs) =
-         mapAccumL (\acc a -> mapSnd g (f acc a)) acc0 xs ;
--}
--}
-
-
 {- |
 This implementation generates laziness breaks
 whereever one of the original sequences has laziness breaks.
@@ -809,367 +315,6 @@
 
 
 
-{-
-{-# INLINE zip #-}
-zip :: (Storable a, Storable b) =>
-   ChunkSize -> (T a -> T b -> T (a,b))
-zip size  =  zipWith size (,)
-
-{-# INLINE zipWith3 #-}
-zipWith3 :: (Storable a, Storable b, Storable c, Storable d) =>
-   ChunkSize -> (a -> b -> c -> d) -> (T a -> T b -> T c -> T d)
-zipWith3 size f s0 s1 =
-   zipWith size (uncurry f) (zip size s0 s1)
-
-{-# INLINE zipWith4 #-}
-zipWith4 :: (Storable a, Storable b, Storable c, Storable d, Storable e) =>
-   ChunkSize -> (a -> b -> c -> d -> e) -> (T a -> T b -> T c -> T d -> T e)
-zipWith4 size f s0 s1 =
-   zipWith3 size (uncurry f) (zip size s0 s1)
-
-
-{- * Fusable functions -}
-
-{-# INLINE [0] zipWith #-}
-zipWith :: (Storable x, Storable y, Storable z) =>
-      ChunkSize
-   -> (x -> y -> z)
-   -> T x
-   -> T y
-   -> T z
-zipWith size f =
-   curry (unfoldr size (\(xt,yt) ->
-      liftM2
-         (\(x,xs) (y,ys) -> (f x y, (xs,ys)))
-         (viewL xt)
-         (viewL yt)))
-
-
-
-scanLCrochet :: (Storable a, Storable b) =>
-   (a -> b -> a) -> a -> T b -> T a
-scanLCrochet f start =
-   cons start .
-   crochetL (\x acc -> let y = f acc x in Just (y, y)) start
-
-{-# INLINE mapCrochet #-}
-mapCrochet :: (Storable a, Storable b) => (a -> b) -> (T a -> T b)
-mapCrochet f = crochetL (\x _ -> Just (f x, ())) ()
--}
-
 {-# INLINE takeCrochet #-}
 takeCrochet :: Storable a => Int -> T a -> T a
 takeCrochet = Vector.crochetL (\x n -> toMaybe (n>0) (x, pred n))
-
-{-
-{-# INLINE repeatUnfoldr #-}
-repeatUnfoldr :: Storable a => ChunkSize -> a -> T a
-repeatUnfoldr size = iterate size id
-
-{-# INLINE replicateCrochet #-}
-replicateCrochet :: Storable a => ChunkSize -> Int -> a -> T a
-replicateCrochet size n = takeCrochet n . repeat size
-
-
-{-
-The "fromList/drop" rule is not quite accurate
-because the chunk borders are moved.
-Maybe 'ChunkSize' better is a list of chunks sizes.
--}
-
-{- disabled RULES
-  "fromList/zipWith"
-    forall size f (as :: Storable a => [a]) (bs :: Storable a => [a]).
-     fromList size (List.zipWith f as bs) =
-        zipWith size f (fromList size as) (fromList size bs) ;
-
-  "fromList/drop" forall as n size.
-     fromList size (List.drop n as) =
-        drop n (fromList size as) ;
-  -}
-
-
-
-{- * Fused functions -}
-
-type Unfoldr s a = (s -> Maybe (a,s), s)
-
-{-# INLINE zipWithUnfoldr2 #-}
-zipWithUnfoldr2 :: Storable z =>
-      ChunkSize
-   -> (x -> y -> z)
-   -> Unfoldr a x
-   -> Unfoldr b y
-   -> T z
-zipWithUnfoldr2 size h (f,a) (g,b) =
-   unfoldr size
-      (\(a0,b0) -> liftM2 (\(x,a1) (y,b1) -> (h x y, (a1,b1))) (f a0) (g b0))
---      (uncurry (liftM2 (\(x,a1) (y,b1) -> (h x y, (a1,b1)))) . (f *** g))
-      (a,b)
-
-{- done by takeCrochet
-{-# INLINE mapUnfoldr #-}
-mapUnfoldr :: (Storable x, Storable y) =>
-      ChunkSize
-   -> (x -> y)
-   -> Unfoldr a x
-   -> T y
-mapUnfoldr size g (f,a) =
-   unfoldr size (fmap (mapFst g) . f) a
--}
-
-{-# INLINE dropUnfoldr #-}
-dropUnfoldr :: Storable x =>
-      ChunkSize
-   -> Int
-   -> Unfoldr a x
-   -> T x
-dropUnfoldr size n (f,a0) =
-   maybe
-      empty
-      (unfoldr size f)
-      (nest n (\a -> fmap snd . f =<< a) (Just a0))
-
-
-{- done by takeCrochet
-{-# INLINE takeUnfoldr #-}
-takeUnfoldr :: Storable x =>
-      ChunkSize
-   -> Int
-   -> Unfoldr a x
-   -> T x
-takeUnfoldr size n0 (f,a0) =
-   unfoldr size
-      (\(a,n) ->
-         do guard (n>0)
-            (x,a') <- f a
-            return (x, (a', pred n)))
-      (a0,n0)
--}
-
-
-lengthUnfoldr :: Storable x =>
-      Unfoldr a x
-   -> Int
-lengthUnfoldr (f,a0) =
-   let recourse n a =
-          maybe n (recourse (succ n) . snd) (f a)
-   in  recourse 0 a0
-
-
-{-# INLINE zipWithUnfoldr #-}
-zipWithUnfoldr ::
-   (Storable b, Storable c) =>
-      (acc -> Maybe (a, acc))
-   -> (a -> b -> c)
-   -> acc
-   -> T b -> T c
-zipWithUnfoldr f h a y =
-   crochetL (\y0 a0 ->
-       do (x0,a1) <- f a0
-          Just (h x0 y0, a1)) a y
-
-{-# INLINE zipWithCrochetL #-}
-zipWithCrochetL ::
-   (Storable x, Storable b, Storable c) =>
-      ChunkSize
-   -> (x -> acc -> Maybe (a, acc))
-   -> (a -> b -> c)
-   -> acc
-   -> T x -> T b -> T c
-zipWithCrochetL size f h a x y =
-   crochetL (\(x0,y0) a0 ->
-       do (z0,a1) <- f x0 a0
-          Just (h z0 y0, a1))
-      a (zip size x y)
-
-
-{-# INLINE crochetLCons #-}
-crochetLCons ::
-   (Storable a, Storable b) =>
-      (a -> acc -> Maybe (b, acc))
-   -> acc
-   -> a -> T a -> T b
-crochetLCons f a0 x xs =
-   maybe
-      empty
-      (\(y,a1) -> cons y (crochetL f a1 xs))
-      (f x a0)
-
-{-# INLINE reduceLCons #-}
-reduceLCons ::
-   (Storable a) =>
-      (a -> acc -> Maybe acc)
-   -> acc
-   -> a -> T a -> acc
-reduceLCons f a0 x xs =
-   maybe a0 (flip (reduceL f) xs) (f x a0)
-
-
-
-
-
-{-# RULES
-  "Storable.zipWith/share" forall size (h :: a->a->b) (x :: T a).
-     zipWith size h x x = map (\xi -> h xi xi) x ;
-
---  "Storable.map/zipWith" forall size (f::c->d) (g::a->b->c) (x::T a) (y::T b).
-  "Storable.map/zipWith" forall size f g x y.
-     map f (zipWith size g x y) =
-        zipWith size (\xi yi -> f (g xi yi)) x y ;
-
-  -- this rule lets map run on a different block structure
-  "Storable.zipWith/map,*" forall size f g x y.
-     zipWith size g (map f x) y =
-        zipWith size (\xi yi -> g (f xi) yi) x y ;
-
-  "Storable.zipWith/*,map" forall size f g x y.
-     zipWith size g x (map f y) =
-        zipWith size (\xi yi -> g xi (f yi)) x y ;
-
-
-  "Storable.drop/unfoldr" forall size f a n.
-     drop n (unfoldr size f a) =
-        dropUnfoldr size n (f,a) ;
-
-  "Storable.take/unfoldr" forall size f a n.
-     take n (unfoldr size f a) =
---        takeUnfoldr size n (f,a) ;
-        takeCrochet n (unfoldr size f a) ;
-
-  "Storable.length/unfoldr" forall size f a.
-     length (unfoldr size f a) = lengthUnfoldr (f,a) ;
-
-  "Storable.map/unfoldr" forall size g f a.
-     map g (unfoldr size f a) =
---        mapUnfoldr size g (f,a) ;
-        mapCrochet g (unfoldr size f a) ;
-
-  "Storable.map/iterate" forall size g f a.
-     map g (iterate size f a) =
-        mapCrochet g (iterate size f a) ;
-
-{-
-  "Storable.zipWith/unfoldr,unfoldr" forall sizeA sizeB f g h a b n.
-     zipWith n h (unfoldr sizeA f a) (unfoldr sizeB g b) =
-        zipWithUnfoldr2 n h (f,a) (g,b) ;
--}
-
-  -- block boundaries are changed here, so it changes lazy behaviour
-  "Storable.zipWith/unfoldr,*" forall sizeA sizeB f h a y.
-     zipWith sizeA h (unfoldr sizeB f a) y =
-        zipWithUnfoldr f h a y ;
-
-  -- block boundaries are changed here, so it changes lazy behaviour
-  "Storable.zipWith/*,unfoldr" forall sizeA sizeB f h a y.
-     zipWith sizeA h y (unfoldr sizeB f a) =
-        zipWithUnfoldr f (flip h) a y ;
-
-  "Storable.crochetL/unfoldr" forall size f g a b.
-     crochetL g b (unfoldr size f a) =
-        unfoldr size (\(a0,b0) ->
-            do (y0,a1) <- f a0
-               (z0,b1) <- g y0 b0
-               Just (z0, (a1,b1))) (a,b) ;
-
-  "Storable.reduceL/unfoldr" forall size f g a b.
-     reduceL g b (unfoldr size f a) =
-        snd
-          (untilNothing (\(a0,b0) ->
-              do (y,a1) <- f a0
-                 b1 <- g y b0
-                 Just (a1, b1)) (a,b)) ;
-
-  "Storable.crochetL/cons" forall g b x xs.
-     crochetL g b (cons x xs) =
-        crochetLCons g b x xs ;
-
-  "Storable.reduceL/cons" forall g b x xs.
-     reduceL g b (cons x xs) =
-        reduceLCons g b x xs ;
-
-
-
-
-  "Storable.take/crochetL" forall f a x n.
-     take n (crochetL f a x) =
-        takeCrochet n (crochetL f a x) ;
-
-  "Storable.length/crochetL" forall f a x.
-     length (crochetL f a x) = length x ;
-
-  "Storable.map/crochetL" forall g f a x.
-     map g (crochetL f a x) =
-        mapCrochet g (crochetL f a x) ;
-
-  "Storable.zipWith/crochetL,*" forall size f h a x y.
-     zipWith size h (crochetL f a x) y =
-        zipWithCrochetL size f h a x y ;
-
-  "Storable.zipWith/*,crochetL" forall size f h a x y.
-     zipWith size h y (crochetL f a x) =
-        zipWithCrochetL size f (flip h) a x y ;
-
-  "Storable.crochetL/crochetL" forall f g a b x.
-     crochetL g b (crochetL f a x) =
-        crochetL (\x0 (a0,b0) ->
-            do (y0,a1) <- f x0 a0
-               (z0,b1) <- g y0 b0
-               Just (z0, (a1,b1))) (a,b) x ;
-
-  "Storable.reduceL/crochetL" forall f g a b x.
-     reduceL g b (crochetL f a x) =
-        snd
-          (reduceL (\x0 (a0,b0) ->
-              do (y,a1) <- f x0 a0
-                 b1 <- g y b0
-                 Just (a1, b1)) (a,b) x) ;
-  #-}
-
-
--- maybe candidate for Utility, cf. FusionList.Signal.recourse
-
-{-# INLINE untilNothing #-}
-untilNothing :: (acc -> Maybe acc) -> acc -> acc
-untilNothing f =
-   let aux x = maybe x aux (f x)
-   in  aux
-
-
-{- * Fusion tests -}
-
-
-fromMapList :: (Storable y) => ChunkSize -> (x -> y) -> [x] -> T y
-fromMapList size f =
-   unfoldr size (fmap (mapFst f) . ListHT.viewL)
-
-{-# RULES
-  "Storable.fromList/map" forall size f xs.
-     fromList size (List.map f xs) = fromMapList size f xs ;
-  #-}
-
-
-testLength :: (Storable a, Enum a) => a -> Int
-testLength x = length (map succ (fromList (ChunkSize 100) [x,x,x]))
-
-testMapZip :: (Storable a, Enum a, Num a) =>
-   ChunkSize -> T a -> T a -> T a
--- testMapZip size x y = map snd (zipWith size (,) x y)
-testMapZip size x y = map succ (zipWith size (P.+) x y)
-
-testMapCons :: (Storable a, Enum a) =>
-   a -> T a -> T a
-testMapCons x xs = map succ (cons x xs)
-
-{-# INLINE testMapIterate #-}
-{-# SPECIALISE testMapIterate ::
-   ChunkSize -> Char -> T Char #-}
-testMapIterate :: (Storable a, Enum a) =>
-   ChunkSize -> a -> T a
-testMapIterate size y = map pred $ iterate size succ y
-
-testMapIterateInt ::
-   ChunkSize -> Int -> T Int
-testMapIterateInt = testMapIterate
-
--}
diff --git a/synthesizer-core.cabal b/synthesizer-core.cabal
--- a/synthesizer-core.cabal
+++ b/synthesizer-core.cabal
@@ -1,5 +1,5 @@
 Name:           synthesizer-core
-Version:        0.8.0.2
+Version:        0.8.1
 License:        GPL
 License-File:   LICENSE
 Author:         Henning Thielemann <haskell@henning-thielemann.de>
@@ -29,6 +29,7 @@
 Build-Type:     Simple
 
 Extra-Source-Files:
+  Changes.md
   Makefile
 
 Flag optimizeAdvanced
@@ -37,7 +38,7 @@
 
 
 Source-Repository this
-  Tag:         0.8.0.2
+  Tag:         0.8.1
   Type:        darcs
   Location:    http://code.haskell.org/synthesizer/core/
 
@@ -205,6 +206,8 @@
     Synthesizer.Generic.Signal
     Synthesizer.Generic.Wave
     Synthesizer.PiecewiseConstant.Signal
+    Synthesizer.PiecewiseConstant.Generic
+    Synthesizer.PiecewiseConstant.Storable
 
     -- that's only exposed for Haddock
     Synthesizer.Plain.Tutorial
@@ -219,6 +222,7 @@
     Synthesizer.Basic.NumberTheory
     Synthesizer.Generic.Permutation
     Synthesizer.Generic.LengthSignal
+    Synthesizer.PiecewiseConstant.Private
 
 
 Test-Suite test
@@ -252,6 +256,7 @@
     Test.Sound.Synthesizer.Plain.Filter
     Test.Sound.Synthesizer.Plain.Filter.Allpass
     Test.Sound.Synthesizer.Plain.Filter.Hilbert
+    Test.Sound.Synthesizer.Plain.Filter.FirstOrder
     Test.Sound.Synthesizer.Plain.Interpolation
     Test.Sound.Synthesizer.Plain.NonEmpty
     Test.Sound.Synthesizer.Plain.Oscillator
@@ -298,7 +303,7 @@
     synthesizer-core,
     numeric-prelude,
     old-time >= 1.0 && < 1.2,
-    directory >= 1.0 && < 1.3,
+    directory >= 1.0 && < 1.4,
     binary,
     bytestring,
     utility-ht,
diff --git a/test/Test/Main.hs b/test/Test/Main.hs
--- a/test/Test/Main.hs
+++ b/test/Test/Main.hs
@@ -3,6 +3,7 @@
 import qualified Test.Sound.Synthesizer.Plain.Analysis       as Analysis
 import qualified Test.Sound.Synthesizer.Plain.Control        as Control
 import qualified Test.Sound.Synthesizer.Plain.Filter         as Filter
+import qualified Test.Sound.Synthesizer.Plain.Filter.FirstOrder as Filt1
 import qualified Test.Sound.Synthesizer.Plain.Interpolation  as Interpolation
 import qualified Test.Sound.Synthesizer.Plain.Oscillator     as Oscillator
 import qualified Test.Sound.Synthesizer.Plain.Wave           as Wave
@@ -31,6 +32,7 @@
    concat $
       prefix "Plain.Analysis"       Analysis.tests :
       prefix "Plain.Control"        Control.tests :
+      prefix "Plain.Filter.FirstOrder" Filt1.tests :
       prefix "Plain.Filter"         Filter.tests :
       prefix "Plain.Interpolation"  Interpolation.tests :
       prefix "Plain.Oscillator"     Oscillator.tests :
diff --git a/test/Test/Sound/Synthesizer/Basic/NumberTheory.hs b/test/Test/Sound/Synthesizer/Basic/NumberTheory.hs
--- a/test/Test/Sound/Synthesizer/Basic/NumberTheory.hs
+++ b/test/Test/Sound/Synthesizer/Basic/NumberTheory.hs
@@ -46,7 +46,7 @@
 
 instance Arbitrary Big where
    arbitrary = do
-      digits <- arbitrary
+      digits <- QC.listOf arbitrary
       -- negative digits yield numbers close to the maximum
       let maxi = 10^50
       return $ Big $
@@ -152,6 +152,10 @@
              (NT.ordersOfPrimitiveRootsOfUnityInteger !! (n-1)))
          ==
          NT.ordersOfRootsOfUnityInteger !! (n-1) !! (k-1)) :
+   ("divideByMaximumPower",
+      QC.quickCheck $
+         QC.forAll (QC.choose (2,10::Integer)) $ \b (Positive n) ->
+         NT.divideByMaximumPower b n == NT.divideByMaximumPowerRecursive b n) :
    ("numbers3Smooth",
       QC.quickCheckWith singleArgs $ equalList $ map (take 10000) $
          [NT.numbers3SmoothCorec, NT.numbers3SmoothFoldr, NT.numbers3SmoothSet]) :
diff --git a/test/Test/Sound/Synthesizer/Plain/Filter/FirstOrder.hs b/test/Test/Sound/Synthesizer/Plain/Filter/FirstOrder.hs
new file mode 100644
--- /dev/null
+++ b/test/Test/Sound/Synthesizer/Plain/Filter/FirstOrder.hs
@@ -0,0 +1,73 @@
+module Test.Sound.Synthesizer.Plain.Filter.FirstOrder (tests) where
+
+import qualified Synthesizer.Plain.Filter.Recursive.FirstOrder as Filt1
+import qualified Synthesizer.Plain.Signal as Sig
+import qualified Synthesizer.Causal.Process as Causal
+
+import Test.QuickCheck (quickCheck, )
+
+import qualified Number.GaloisField2p32m5 as GF
+
+import Control.Applicative ((<$), )
+
+import NumericPrelude.Numeric
+import NumericPrelude.Base
+import Prelude ()
+
+
+
+addLowHighpass :: Sig.T (Filt1.Parameter GF.T, GF.T) -> Bool
+addLowHighpass pxs =
+   let (ps, xs) = unzip pxs
+   in  Filt1.lowpass ps xs + Filt1.highpass ps xs == xs
+
+combineLowHighpass :: Sig.T (Filt1.Parameter GF.T) -> Sig.T GF.T -> Bool
+combineLowHighpass ps xs =
+   zipWith Filt1.Result (Filt1.highpass ps xs) (Filt1.lowpass ps xs)
+   ==
+   Causal.apply Filt1.causal (zip ps xs)
+
+
+lowpassId :: Sig.T GF.T -> Bool
+lowpassId xs =
+   Filt1.lowpass (repeat $ Filt1.Parameter (zero::GF.T)) xs == xs
+
+lowpassZero :: Sig.T GF.T -> Bool
+lowpassZero xs =
+   Filt1.lowpass (repeat $ Filt1.Parameter (one::GF.T)) xs == (zero <$ xs)
+--   isZero $ Filt1.lowpass (repeat $ Filt1.Parameter (one::GF.T)) xs
+
+highpassId :: Sig.T GF.T -> Bool
+highpassId xs =
+   Filt1.highpass (repeat $ Filt1.Parameter (one::GF.T)) xs == xs
+
+highpassZero :: Sig.T GF.T -> Bool
+highpassZero xs =
+   Filt1.highpass (repeat $ Filt1.Parameter (zero::GF.T)) xs == (zero <$ xs)
+
+
+lowpassConst :: Sig.T GF.T -> GF.T -> Bool
+lowpassConst ks x =
+   Filt1.lowpassInit x (map Filt1.Parameter ks) (repeat x) == (x <$ ks)
+
+highpassConst :: Sig.T GF.T -> GF.T -> Bool
+highpassConst ks x =
+   Filt1.highpassInit x (map Filt1.Parameter ks) (repeat x) == (zero <$ ks)
+
+highpassInitAlt :: GF.T -> Sig.T (Filt1.Parameter GF.T) -> Sig.T GF.T -> Bool
+highpassInitAlt x0 ps xs =
+   Filt1.highpassInit x0 ps xs == Filt1.highpassInitAlt x0 ps xs
+
+
+tests :: [(String, IO ())]
+tests =
+   ("addLowHighpass", quickCheck addLowHighpass) :
+   ("combineLowHighpass", quickCheck combineLowHighpass) :
+   ("lowpassId", quickCheck lowpassId) :
+   ("lowpassZero", quickCheck lowpassZero) :
+   ("highpassId", quickCheck highpassId) :
+   ("highpassZero", quickCheck highpassZero) :
+   ("lowpassConst", quickCheck lowpassConst) :
+   ("highpassConst", quickCheck highpassConst) :
+   ("highpassInitAlt", quickCheck highpassInitAlt) :
+   []