{-# LANGUAGE Rank2Types #-}
module Main where

import qualified Synthesizer.LLVM.Filter.ComplexFirstOrderPacked as BandPass
import qualified Synthesizer.LLVM.Filter.Allpass as Allpass
import qualified Synthesizer.LLVM.Filter.Butterworth as Butterworth
import qualified Synthesizer.LLVM.Filter.Chebyshev as Chebyshev
import qualified Synthesizer.LLVM.Filter.FirstOrder as Filt1
import qualified Synthesizer.LLVM.Filter.SecondOrder as Filt2
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.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.Process as CausalP
import qualified Synthesizer.LLVM.CausalParameterized.Functional as Func
import qualified Synthesizer.LLVM.Causal.Process as Causal
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.Parameter as Param

import qualified LLVM.Extra.ScalarOrVector as SoV
import qualified LLVM.Extra.Memory as Memory
import qualified LLVM.Extra.Arithmetic as A
import LLVM.Core (Value, value, valueOf, Vector, constVector, constOf, )
import LLVM.Util.Arithmetic () -- Floating instance for TValue
import qualified LLVM.Core as LLVM
import Data.TypeLevel.Num (D4, D8, D16, )
import qualified Data.TypeLevel.Num as TypeNum

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 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.Category ((<<<), (.), id, )
import Control.Applicative (pure, liftA2, )

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.BodyTime  as EventListBT
import qualified Data.EventList.Relative.MixedTime as EventListMT
import qualified Data.EventList.Relative.TimeMixed as EventListTM
import qualified Numeric.NonNegative.Wrapper as NonNeg

import qualified Sound.Sox.Option.Format as SoxOption
import qualified Sound.Sox.Play as SoxPlay
-- import qualified Synthesizer.Storable.ALSA.Play as Play

import qualified Synthesizer.LLVM.Frame.Stereo as Stereo

import Data.Word (Word32, )
-- import qualified Data.Function.HT as F
import Data.List (genericLength, )
import System.Random (randomRs, mkStdGen, )

import qualified System.IO as IO
-- import System.Exit (ExitCode, )

import Prelude hiding (fst, snd, id, (.), )
import qualified Prelude as P


asMono :: vector Float -> vector Float
asMono = id

asStereo :: vector (Stereo.T Float) -> vector (Stereo.T Float)
asStereo = id

asMonoPacked :: vector (LLVM.Vector D4 Float) -> vector (LLVM.Vector D4 Float)
asMonoPacked = id

asMonoPacked16 :: vector (LLVM.Vector D16 Float) -> vector (LLVM.Vector D16 Float)
asMonoPacked16 = id

asWord32 :: vector Word32 -> vector Word32
asWord32 = id

asWord32Packed :: vector (LLVM.Vector D4 Word32) -> vector (LLVM.Vector D4 Word32)
asWord32Packed = id


{- |
> playStereo (Sig.amplifyStereo 0.3 $ stereoOsciSaw 0.01)

Unfortunately: If you call :reload,
then the next attempt to play something will be answered by:

ghci: JITEmitter.cpp:110: <unnamed>::JITResolver::JITResolver(llvm::JIT&): Assertion `TheJITResolver == 0 && "Multiple JIT resolvers?"' failed.
-}
playStereo :: Sig.T (Stereo.T (Value Float)) -> IO ()
playStereo =
   playStereoVector .
   Sig.renderChunky (SVL.chunkSize 100000)

playStereoVector :: SVL.Vector (Stereo.T Float) -> IO ()
playStereoVector =
   fmap (const ()) .
   SoxPlay.simple SVL.hPut SoxOption.none 44100

playMono :: Sig.T (Value Float) -> IO ()
playMono =
   playMonoVector .
   Sig.renderChunky (SVL.chunkSize 100000)

playMonoVector :: SVL.Vector Float -> IO ()
playMonoVector =
   fmap (const ()) .
   SoxPlay.simple SVL.hPut SoxOption.none 44100


playFileMono :: FilePath -> IO ()
playFileMono fileName = do
   IO.withFile fileName IO.ReadMode $ \h ->
      playStereo .
      Sig.fromStorableVectorLazy .
      asStereo . snd
       =<< SVL.hGetContentsAsync (SVL.chunkSize 4321) h
   return ()


saw :: IO ()
saw =
   SV.writeFile "speedtest.f32" $
   asMono $
   Sig.render 10000000 $
   Sig.osciSaw 0 0.01

exponential :: IO ()
exponential =
   SV.writeFile "speedtest.f32" $
   asMono $
   Sig.render 10000000 $
   Sig.exponential2 50000 1

triangle :: IO ()
triangle =
   SV.writeFile "speedtest.f32" $
   asMono $
   Sig.render 10000000 $
   Sig.osci Wave.triangle 0.25 0.01

trianglePack :: IO ()
trianglePack =
   SV.writeFile "speedtest.f32" $
   asMonoPacked $
   (\xs -> SigP.render xs (div 10000000 4) ()) $
   SigP.mapSimple Wave.triangle $
   SigPS.packSmall $
   (SigP.osciCore $# (0.25::Float)) 4.015803e-4

trianglePacked :: IO ()
trianglePacked =
   SV.writeFile "speedtest.f32" $
   asMonoPacked $
   (\xs -> SigP.render xs (div 10000000 4) ()) $
   (CausalPS.osciSimple Wave.triangle
     $< SigPS.constant 0.25
     $* SigPS.constant 0.01)

triangleReplicate :: IO ()
triangleReplicate =
   SV.writeFile "speedtest.f32" $
   asMonoPacked $
   (\xs -> SigP.render xs (div 10000000 4) ()) $
   (CausalPS.shapeModOsci
       (\k p -> do
           x <- Wave.triangle =<< Wave.replicate k p
           y <- Wave.approxSine4 =<< Wave.halfEnvelope p
           A.mul x y)
     $< SigPS.rampInf 1000000
     $< SigPS.constant 0
     $* SigPS.constant 0.01)

rationalSine :: IO ()
rationalSine =
   SV.writeFile "speedtest.f32" $
   asMonoPacked $
   (\xs -> SigP.render xs (div 10000000 4) ()) $
   (CausalPS.shapeModOsci Wave.rationalApproxSine1
     $< SigP.mapSimple (A.add (valueOf 0.001)) (SigPS.rampInf 10000000)
     $< SigPS.constant 0
     $* SigPS.constant 0.01)


pingSig :: Float -> Sig.T (Value Float)
pingSig freq =
   Sig.envelope
      (Sig.exponential2 50000 1)
      (Sig.osciSaw 0.5 freq)

pingSigP :: SigP.T Float (Value Float)
pingSigP =
   let freq = id
   in  SigP.envelope
          (SigP.exponential2 50000 1)
          (SigP.osciSaw 0.5 freq)

ping :: IO ()
ping =
   SV.writeFile "speedtest.f32" $
   asMono $
   Sig.render 10000000 $
   pingSig 0.01

pingSigPacked :: SigP.T Float (Value (Vector D4 Float))
pingSigPacked =
   let freq = id
   in  SigP.envelope
          (SigPS.exponential2 50000 1)
          (SigPS.osciSimple Wave.saw 0 freq)

pingPacked :: IO ()
pingPacked =
   SV.writeFile "speedtest.f32" $
   asMonoPacked $
   (\xs -> SigP.render xs (div 10000000 4) 0.01) $
   pingSigPacked

pingUnpack :: IO ()
pingUnpack =
   SV.writeFile "speedtest.f32" $
   asMono $
   (\xs -> SigP.render xs 10000000 0.01) $
   SigPS.unpack $
   pingSigPacked

pingSmooth :: IO ()
pingSmooth =
   SV.writeFile "speedtest-scalar.f32" $
   asMono $
   (\xs -> SigP.render xs 10000000 ()) $
   (Filt1.lowpassCausalP
     $< (fmap Filt1Core.Parameter $
         SigP.mapSimple (A.sub (valueOf 1))
            (SigP.exponential2 50000 $# (1::Float)))
     $* SigP.osciSimple Wave.triangle 0 0.01)

pingSmoothPacked :: IO ()
pingSmoothPacked =
   SV.writeFile "speedtest-vector.f32" $
   asMonoPacked $
   (\xs -> SigP.render xs (div 10000000 4) ()) $
   (Filt1.lowpassCausalPackedP
     $< (fmap Filt1Core.Parameter $
         SigP.mapSimple (A.sub (valueOf 1))
            (SigP.exponential2 (50000/4) $# (1::Float)))
     $* SigPS.osciSimple Wave.triangle 0 0.01)

stereoOsciSaw :: Float -> Sig.T (Stereo.T (Value Float))
stereoOsciSaw freq =
   liftA2 Stereo.cons
      (Sig.osciSaw 0.0 (freq*1.001) `Sig.mix`
       Sig.osciSaw 0.2 (freq*1.003) `Sig.mix`
       Sig.osciSaw 0.1 (freq*0.995))
      (Sig.osciSaw 0.1 (freq*1.005) `Sig.mix`
       Sig.osciSaw 0.7 (freq*0.997) `Sig.mix`
       Sig.osciSaw 0.5 (freq*0.999))

stereoOsciSawPacked :: Float -> Sig.T (Stereo.T (Value Float))
stereoOsciSawPacked freq =
   let mix4 =
          Frame.mixVector .
          flip asTypeOf (undefined :: Value (Vector D4 Float))
   in  liftA2 Stereo.cons
          (Sig.map mix4 $
           Sig.osciPlain Wave.saw
              (value $ constVector $ map constOf [0.0, 0.2, 0.1, 0.4])
              (value $ constVector $
               map (constOf . (freq*)) [1.001, 1.003, 0.995, 0.996]))
          (Sig.map mix4 $
           Sig.osciPlain Wave.saw
              (value $ constVector $ map constOf [0.1, 0.7, 0.5, 0.7])
              (value $ constVector $
               map (constOf . (freq*)) [1.005, 0.997, 0.999, 1.001]))

stereoOsciSawPacked2 :: Float -> Sig.T (Stereo.T (Value Float))
stereoOsciSawPacked2 freq =
   Sig.map (Frame.mixVectorToStereo .
            flip asTypeOf (undefined :: Value (Vector D8 Float))) $
   Sig.osciPlain (Wave.trapezoidSkew (SoV.replicateOf 0.2))
      (valueOf $
       LLVM.toVector (0.0, 0.2, 0.1, 0.4, 0.1, 0.7, 0.5, 0.7))
      (value $ constVector $
       map (constOf . (freq*)) $
       [1.001, 1.003, 0.995, 0.996, 1.005, 0.997, 0.999, 1.001])

stereo :: IO ()
stereo =
   SV.writeFile "speedtest.f32" $
   asStereo $
   Sig.render 10000000 $
   Sig.amplifyStereo 0.25 $
   stereoOsciSawPacked2 0.01

lazy :: IO ()
lazy =
   SVL.writeFile "speedtest.f32" $
   SVL.take 10000000 $
   asMono $
   Sig.renderChunky (SVL.chunkSize 100000)
      {- SVL.defaultChunkSize - too slow -} $
   Sig.envelope
      (Sig.exponential2 50000 1)
      (Sig.osci Wave.sine 0.5 0.01 :: Sig.T (Value Float))

lazyStereo :: IO ()
lazyStereo =
   SVL.writeFile "speedtest.f32" $
   SVL.take 10000000 $
   asStereo $
   Sig.renderChunky (SVL.chunkSize 100000) $
   Sig.amplifyStereo 0.25 $
   stereoOsciSawPacked 0.01

packTake :: IO ()
packTake =
   SVL.writeFile "speedtest.f32" $
   asMonoPacked $
   flip (SigP.renderChunky (SVL.chunkSize 1000)) () $
   SigPS.packRotate $
   (CausalP.take 5 $*
    SigP.osciSimple Wave.saw 0 0.01)

chord :: Float -> Sig.T (Stereo.T (Value Float))
chord base =
   {-
   This exceeds available vector registers
   and thus needs more stack accesses.
   Thus it needs twice as much time as the simple mixing.
   However doing all 32 oscillators in parallel
   and mix them in one go might be still faster.

   foldl1 (Sig.zipWith Frame.mixStereoV) $
   -}
   foldl1 Sig.mix $
   map (\f -> stereoOsciSawPacked2 (base*f)) $
   0.25 : 1.00 : 1.25 : 1.50 : []

lazyChord :: IO ()
lazyChord =
   SVL.writeFile "speedtest.f32" $
   SVL.take 10000000 $
   asStereo $
   Sig.renderChunky (SVL.chunkSize 100000) $
   Sig.amplifyStereo 0.1 $
   chord 0.005

filterSweepComplex :: IO ()
filterSweepComplex =
   SVL.writeFile "speedtest.f32" $
   SVL.take 10000000 $
   asStereo $
   Sig.renderChunky (SVL.chunkSize 100000) $
   Sig.amplifyStereo 0.3 $
   Causal.apply BandPass.causal $
   Sig.zip
      (Sig.map (BandPass.parameter (valueOf 100)) $
       Sig.map (\x -> 0.01 * exp (2 * return x)) $
       Sig.osci Wave.sine 0 (0.1/44100)) $
   chord 0.005

lfoSine ::
   (Memory.C a ap, LLVM.IsSized ap asize) =>
   (forall r. Value Float -> LLVM.CodeGenFunction r a) ->
   Param.T p Float ->
   SigP.T p a
lfoSine f reduct =
   SigP.mapSimple f $
   SigP.mapSimple (\x -> 0.01 * exp (2 * return x)) $
   SigP.osciSimple Wave.sine 0 (reduct * 0.1/44100)

filterSweep :: IO ()
filterSweep =
   SVL.writeFile "speedtest.f32" $
   SVL.take 10000000 $
   asMono $
   flip (SigP.renderChunky (SVL.chunkSize 10000)) () $
   (CausalP.amplify 0.2 .
      CtrlP.processCtrlRate 128
         (lfoSine (Filt2.bandpassParameter (valueOf 100)))
      $* SigP.osciSimple Wave.saw 0 0.01)

filterSweepPacked :: IO ()
filterSweepPacked =
   SVL.writeFile "speedtest.f32" $
   SVL.take (div 10000000 4) $
   asMonoPacked $
   flip (SigP.renderChunky (SVL.chunkSize 10000)) () $
   (CausalP.amplify 0.2 .
    CtrlPS.processCtrlRate 128
       (lfoSine (Filt2.bandpassParameter (valueOf 100)))
      $* SigPS.osciSimple Wave.saw 0 0.01)

exponentialFilter2Packed :: IO ()
exponentialFilter2Packed =
   SVL.writeFile "speedtest.f32" $
   SVL.take (div 10000000 16) $
   asMonoPacked16 $
   flip (SigP.renderChunky (SVL.chunkSize 10000)) () $
   (Filt2.causalPackedP
      $< (SigP.constant $#
             Filt2Core.Parameter (1::Float) 0 0   0 0.99)
      $* (
--          (CausalP.delay1 $# LLVM.vector [0.1,0.01,0.001,0.0001::Float])
--          (CausalP.delay1 $# LLVM.vector [1::Float])
          (CausalP.delay1 $# LLVM.vector ((1::Float):repeat 0))
           $* (SigP.constant $# LLVM.vector [0::Float])))

filterSweepPacked2 :: IO ()
filterSweepPacked2 =
   SVL.writeFile "speedtest.f32" $
   SVL.take 10000000 $
   asMono $
   flip (SigP.renderChunky (SVL.chunkSize 10000)) () $
   (CausalP.amplify 0.2 .
    CtrlP.processCtrlRate 128
       (lfoSine (Filt2P.bandpassParameter (valueOf 100)))
      $* SigP.osciSimple Wave.saw 0 0.01)

butterworthNoisePacked :: IO ()
butterworthNoisePacked =
   SVL.writeFile "speedtest.f32" $
   SVL.take (div 10000000 4) $
   asMonoPacked $
   flip (SigP.renderChunky (SVL.chunkSize 10000)) () $
   (CausalPS.amplify 0.2 .
    CtrlPS.processCtrlRate 128
       (lfoSine (Butterworth.parameter TypeNum.d3 FiltR.Lowpass (valueOf 0.5)))
      $* SigPS.noise 0 0.3)

chebyshevNoisePacked :: IO ()
chebyshevNoisePacked =
   SVL.writeFile "speedtest.f32" $
   SVL.take (div 10000000 4) $
   asMonoPacked $
   flip (SigP.renderChunky (SVL.chunkSize 10000)) () $
   (CausalPS.amplify 0.2 .
    CtrlPS.processCtrlRate 128
       (lfoSine (Chebyshev.parameterA TypeNum.d5 FiltR.Lowpass (valueOf 0.5)))
      $* SigPS.noise 0 0.3)

{-
Provoke non-aligned vector accesses by calling alloca for a record of 5 floats
in LLVM-2.6.
However, the vector accesses are those of noise.
Using scalar Noise there is no problem.
-}
noiseAllocaBug :: IO ()
noiseAllocaBug =
   SVL.writeFile "speedtest.f32" $
   SVL.take (div 10000000 4) $
   asMonoPacked $
   flip (SigP.renderChunky (SVL.chunkSize 10000)) () $
   (CausalPS.amplify 0.2 . Filt2.causalPackedP
      $< (SigP.mapSimple (const $ Memory.load =<< LLVM.alloca) $
            (SigP.constant $# (0::Float)))
      $* SigPS.noise 0 0.3)

noiseAllocaScalar :: IO ()
noiseAllocaScalar =
   SVL.writeFile "speedtest.f32" $
   SVL.take 10000000 $
   asMono $
   flip (SigP.renderChunky (SVL.chunkSize 10000)) () $
   (CausalP.amplify 0.2 . Filt2.causalP
      $< (SigP.mapSimple (const $
             (Memory.load =<< LLVM.alloca ::
                 LLVM.CodeGenFunction r (Filt2.Parameter (Value Float)))) $
           (SigP.constant $# (0::Float)))
      $* SigP.noise 0 0.3)


upsample :: IO ()
upsample =
   SVL.writeFile "speedtest.f32" $
   SVL.take 10000000 $
   asMono $
   Sig.renderChunky (SVL.chunkSize 100000) $
      (let reduct = 128 :: Float
       in  Sig.interpolateConstant reduct $
           Sig.osci Wave.sine 0 (reduct*0.1/44100))


filterSweepControlRateCausal ::
   Causal.T
      (Stereo.T (Value Float))
      (Stereo.T (Value Float))
filterSweepControlRateCausal =
   Causal.amplifyStereo 0.3 <<<
   BandPass.causal <<<
   Causal.feedFst
      (let reduct = 128
       in  Sig.interpolateConstant reduct $
           Sig.map (BandPass.parameter (valueOf 100)) $
           Sig.map (\x -> 0.01 * exp (2 * return x)) $
           Sig.osci Wave.sine 0 (reduct*0.1/44100))

filterSweepControlRateProc ::
   Sig.T (Stereo.T (Value Float)) ->
   Sig.T (Stereo.T (Value Float))
filterSweepControlRateProc =
   Causal.apply filterSweepControlRateCausal

{- |
Trigonometric functions are very slow in LLVM
because they are translated to calls to C's math library.
Thus it is advantageous to compute filter parameters
at a lower rate and interpolate constantly.
-}
filterSweepControlRate :: IO ()
filterSweepControlRate =
   SVL.writeFile "speedtest.f32" $
   asStereo $
   SVL.take 10000000 $
   Sig.renderChunky (SVL.chunkSize 100000) $
   filterSweepControlRateProc $
   chord 0.005


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))


playFilterSweepMusicLazy :: IO ()
playFilterSweepMusicLazy = do
   IO.withFile "lichter.f32" IO.ReadMode $ \h ->
      playStereo .
--      Sig.amplifyStereo 1.125 .
      Sig.amplifyStereo 20 .
      filterSweepControlRateProc .
      Sig.fromStorableVectorLazy .
      asStereo . snd
       =<< SVL.hGetContentsAsync (SVL.chunkSize 4321) h
   return ()

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 ()

playFilterSweepMusicCausalLazy :: IO ()
playFilterSweepMusicCausalLazy = do
   IO.withFile "lichter.f32" IO.ReadMode $ \h ->
      playStereoVector .
      Causal.applyStorableChunky
         (Causal.amplifyStereo 20 <<< filterSweepControlRateCausal) .
      asStereo . snd
       =<< SVL.hGetContentsAsync (SVL.chunkSize 43210) h
   return ()

arrangeLazy :: IO ()
arrangeLazy = do
   IO.hSetBuffering IO.stdout IO.NoBuffering
   print $
      SigStL.arrange (SVL.chunkSize 2) $
      EventList.fromPairList $
         (0, SVL.pack (SVL.chunkSize 2) [1,2::Double]) :
         (0, SVL.pack (SVL.chunkSize 2) [3,4,5,6]) :
         (2, SVL.pack (SVL.chunkSize 2) [7,8,9,10]) :
 --        repeat (2, SVL.empty)
--         (2, SVL.empty) :
--         (2, SVL.empty) :
--         (2::NonNeg.Int, error "undefined sound") :
         error "end of list"
 --        []


{- |
This is inefficient because pingSig is compiled by LLVM
for every occurence of the sound!

randomTones :: IO ()
randomTones = do
   playMonoVector $
      SigStL.arrange (SVL.chunkSize 12345) $
      EventList.fromPairList $ zip
         (cycle $ map (flip div 16 . (44100*)) [1,2,3])
         (cycle $ map (SVL.take 44100 . Sig.renderChunky (SVL.chunkSize 54321) .
                       pingSig . (0.01*))
          [1,1.25,1.5,2])
   return ()
-}

{- |
So far we have not managed to compile signals
that depend on parameters.
Thus in order to avoid much recompilation,
we compile and render a few sounds in advance.
-}
pingTones :: [SVL.Vector Float]
pingTones =
   map (SVL.take 44100 . Sig.renderChunky (SVL.chunkSize 4321) .
        pingSig . (0.01*))
   [1,1.25,1.5,2]

pingTonesIO :: IO [SVL.Vector Float]
pingTonesIO =
   fmap
      (\pingVec ->
         map
            (SVL.take 44100 .
             pingVec (SVL.chunkSize 4321) .
             (0.01*))
            [1,1.25,1.5,2])
      (SigP.runChunky pingSigP)

{-
Arrange itself does not seem to have a space leak with temporary data.
However it may leak sound data.
This is not very likely because this would result in a large memory leak.

Generate random tones in order to see whether generated sounds leak.
How does 'arrange' compare with 'concat'?
-}

cycleTones :: IO ()
cycleTones = do
--   playMono $
   pings <- pingTonesIO
   SVL.writeFile "test.f32" $
--   Play.auto (0.01::Double) 44100 $
      asMono $
{-
after 13min runtime memory consumption increased from 2.5 to 3.9
and we get lot of buffer underruns with this implementation of amplification
(renderChunky . amplify . fromStorableVector)
-}
      Sig.renderChunky (SVL.chunkSize 432109) $
      Sig.amplify 0.1 $
      Sig.fromStorableVectorLazy $
{-
after 20min memory consumption increased from 2.5 to 3.4
and we get lot of buffer underruns with applyStorableChunky
-}
{-
applyStorableChunky applied to concatenated zero vectors
starts with memory consumption 1.0 and after an hour, it's still 1.1
without buffer underruns.
-}
{-
      CausalP.applyStorableChunky (CausalP.amplify $# (0.1::Float)) () $
      asMono $
-}
{-
with chunksize 12345678
after 50min runtime the memory consumption increased from 12.0 to 26.2

with chunksize 123
after 25min runtime the memory consumption is constant 7.4
however at start time there 5 buffer underruns, but no more
probably due to initial LLVM compilation

with chunksize 1234567 and SVL.replicate instead of pingTones
we get memory consumption from 1.3 to 3.2 in 15min,
while producing lots of buffer underruns.
After 45min in total, it is still 3.2 of memory consumption.
Is this a memory leak, or isn't it?

with chunksize 12345678 and SVL.replicate
we get from 5.6 to 10.2 in 3min
to 14.9 after total 13min.
-}
{-
      SigStL.arrange (SVL.chunkSize 12345678) $
      EventList.fromPairList $ zip
         (repeat (div 44100 8))
--         (cycle $ map (flip div 4 . (44100*)) [1,2,3])
-}
{-
With plain concatenation of those zero vectors
we stay constantly at 0.4 memory consumption and no buffer underruns over 30min.
-}
      SVL.concat
         (cycle pings)
--         (repeat $ SVL.replicate (SVL.chunkSize 44100) 44100 0)
   return ()


tonesChunkSize :: SVL.ChunkSize
numTones :: Int

{-
For one-time-compiled fill functions,
larger chunks have no relevant effect on the processing speed.
-}
(tonesChunkSize, numTones) =
   (SVL.chunkSize 441, 200)
--   (SVL.chunkSize 44100, 200)

fst :: Arrow arrow => arrow (a,b) a
fst = arr P.fst

snd :: Arrow arrow => arrow (a,b) b
snd = arr P.snd


{-# NOINLINE makePing #-}
makePing :: IO ((Float,Float) -> SVL.Vector Float)
makePing =
   let freq = snd
       halfLife = fst
   in  fmap ($tonesChunkSize) $
       SigP.runChunky
          (SigP.envelope
             (SigP.exponential2 halfLife 1)
             (SigP.osciSaw 0.5 freq))

tonesDown :: IO ()
tonesDown = do
   let dist = div 44100 10
   pingp <- makePing
   playMonoVector $
      CausalP.applyStorableChunky (CausalP.amplify id) 0.03 $
      SigStL.arrange tonesChunkSize $
      EventList.fromPairList $ zip
         (repeat (NonNeg.fromNumber dist))
         (map (SVL.take (numTones * dist) . curry pingp 50000) $
          iterate (0.999*) 0.01)
   return ()


vibes :: SigP.T (Float,Float) (Value Float)
vibes =
   let freq = snd
       modDepth = fst
       halfLife = 5000
       -- sine = Wave.sine
       sine = Wave.approxSine4
   in  CausalP.envelope
         $< SigP.exponential2 halfLife 1
         $* (((CausalP.osciSimple sine
                $< (CausalP.envelope
                       $< SigP.exponential2 halfLife modDepth
                       $* (CausalP.osciSimple sine
                              $* SigP.constant (return (0::Float) &&& (2*freq)))))
               <<<
               CausalP.mapLinear (0.01*freq) freq
               <<<
               CausalP.osciSimple sine)
             $* SigP.constant (return (0::Float, 0.0001::Float)))

makeVibes :: IO ((Float,Float) -> SVL.Vector Float)
makeVibes =
   fmap ($tonesChunkSize) $
   SigP.runChunky vibes

vibesCycleVector :: ((Float,Float) -> SVL.Vector Float) -> SVL.Vector Float
vibesCycleVector pingp =
   SigStL.arrange tonesChunkSize $
   EventList.fromPairList $ zip
      (repeat 5000)
      (map (SVL.take 50000 . pingp) $
       zip
          (map (\k -> 0.5 * (1 - cos k)) $ iterate (0.05+) 0)
          (cycle $ map (0.01*) [1, 1.25, 1.5, 2]))

vibesCycle :: IO ()
vibesCycle = do
   pingp <- makeVibes
   playMonoVector $
      CausalP.applyStorableChunky (CausalP.amplify id) 0.2 $
      vibesCycleVector pingp
   return ()

vibesEcho :: IO ()
vibesEcho = do
   pingp <- makeVibes
   playMonoVector $
      CausalP.applyStorableChunky
         (CausalP.amplify id <<<
          CausalP.comb 0.5 7000)
         0.2 $
      vibesCycleVector pingp
   return ()

vibesReverb :: IO ()
vibesReverb = do
   pingp <- makeVibes
   playMonoVector $
      CausalP.applyStorableChunky
         (CausalP.amplify id <<<
          CausalP.reverb (mkStdGen 142) 16 (0.9,0.97) (400,1000))
         0.3 $
      vibesCycleVector pingp
   return ()

vibesReverbStereo :: IO ()
vibesReverbStereo = do
   pingp <- makeVibes
   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)
         0.3 $
      vibesCycleVector pingp
   return ()



stair :: IO ()
stair =
   SVL.writeFile "speedtest.f32" $
   SVL.take 10000000 $
   asMono $
   flip (SigP.renderChunky tonesChunkSize) () $
   SigP.piecewiseConstant $
   return $
   EventListBT.fromPairList $
   zip
      (iterate (/2) (1::Float))
      (iterate (2*) (1::NonNeg.Int))


filterBass :: IO ()
filterBass = do
   playStereoVector $
      asStereo $
      flip (SigP.renderChunky tonesChunkSize) () $
      CausalP.apply
         (BandPass.causalP
          <<<
          CausalP.feedSnd
             (liftA2 Stereo.cons
                 (SigP.osciSimple Wave.saw 0 0.001499)
                 (SigP.osciSimple Wave.saw 0 0.001501))
          <<<
          CausalP.mapSimple (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 ()


{- |
This function is not very efficient,
since it compiles an LLVM mixing routine
for every pair of mixer inputs.
-}
mixVectorRecompile ::
   SVL.Vector Float -> SVL.Vector Float -> SVL.Vector Float
mixVectorRecompile xs ys =
   Sig.renderChunky tonesChunkSize $
   Sig.mix
      (Sig.fromStorableVectorLazy xs)
      (Sig.fromStorableVectorLazy ys)

mixVectorParamIO ::
   IO (SVL.Vector Float -> SVL.Vector Float -> SVL.Vector Float)
mixVectorParamIO =
   fmap curry $
   fmap ($tonesChunkSize) $
   SigP.runChunky
      (SigP.mix
         (SigP.fromStorableVectorLazy fst)
         (SigP.fromStorableVectorLazy snd))

mixVectorCausalIO ::
   IO (SVL.Vector Float -> SVL.Vector Float -> SVL.Vector Float)
mixVectorCausalIO =
   CausalP.runStorableChunky
      (CausalP.mix $<
       SigP.fromStorableVectorLazy id)

mixVectorCausal ::
   SVL.Vector Float -> SVL.Vector Float -> SVL.Vector Float
mixVectorCausal =
   CausalP.applyStorableChunky
      (CausalP.mix $<
       SigP.fromStorableVectorLazy id)

mixVectorStereo ::
   SVL.Vector (Stereo.T Float) ->
   SVL.Vector (Stereo.T Float) ->
   SVL.Vector (Stereo.T Float)
mixVectorStereo =
   CausalP.applyStorableChunky
      (CausalP.mix $<
       SigP.fromStorableVectorLazy id)

mixVectorStereoIO ::
   IO (SVL.Vector (Stereo.T Float) ->
       SVL.Vector (Stereo.T Float) ->
       SVL.Vector (Stereo.T Float))
mixVectorStereoIO =
   CausalP.runStorableChunky
      (CausalP.mix $<
       SigP.fromStorableVectorLazy id)

{-
slightly slower than mixVectorParam
-}
mixVectorHaskell ::
   SVL.Vector Float -> SVL.Vector Float -> SVL.Vector Float
mixVectorHaskell = SVL.zipWith (+)

toneMix :: IO ()
toneMix = do
   pingp <- makePing
   mix <- mixVectorCausalIO
   playMonoVector $
      Causal.applyStorableChunky (Causal.amplify 0.1) $
      foldl1 mix $
      map (curry pingp 1000000) $
      take numTones $
      iterate (*(2/3)) 0.01
   return ()

fadeEnvelope :: SigP.T (Int, Int) (Value Float)
fadeEnvelope =
   SigP.parabolaFadeIn (fmap fromIntegral fst)
   `SigP.append`
   (CausalP.take snd $* (SigP.constant $# (1::Float)))
   `SigP.append`
   SigP.parabolaFadeOut (fmap fromIntegral fst)

fadeEnvelopeWrite :: IO ()
fadeEnvelopeWrite =
   SVL.writeFile "speedtest.f32" $
   asMono $
   SigP.renderChunky (SVL.chunkSize 1234)
   fadeEnvelope (100000, 200000)


-- | normalize a list of numbers, such that they have a specific average
-- Cf. haskore-supercollider/src/Haskore/Interface/SuperCollider/Example.hs
normalizeLevel :: Fractional a => a -> [a] -> [a]
normalizeLevel newAvrg xs =
   let avrg = sum xs / genericLength xs
   in  map ((newAvrg-avrg)+) xs

stereoOsciSawP :: SigP.T Float (Stereo.T (Value Float))
stereoOsciSawP =
   let freq = id
       n = 5
       volume = pure $ recip $ sqrt $ fromIntegral n :: Param.T p 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)

stereoOsciSawVector :: Float -> SVL.Vector (Stereo.T Float)
stereoOsciSawVector =
   SigP.renderChunky tonesChunkSize stereoOsciSawP

stereoOsciSawChord :: [Float] -> SVL.Vector (Stereo.T Float)
stereoOsciSawChord =
   foldl1 mixVectorStereo . map stereoOsciSawVector

stereoOsciSawPad :: Int -> [Float] -> SVL.Vector (Stereo.T Float)
stereoOsciSawPad dur pitches =
   let attack = 20000
   in  CausalP.applyStorableChunky
          (CausalP.envelopeStereo $< fadeEnvelope)
          (attack, dur-attack)
          (stereoOsciSawChord pitches)

a0, as0, b0, c1, cs1, d1, ds1, e1, f1, fs1, g1, gs1,
 a1, as1, b1, c2, cs2, d2, ds2, e2, f2, fs2, g2, gs2,
 a2, as2, b2, c3, cs3, d3, ds3, e3, f3, fs3, g3, gs3,
 a3, as3, b3, c4, cs4, d4, ds4, e4, f4, fs4, g4, gs4 :: Float
a0 : as0 : b0 : c1 : cs1 : d1 : ds1 : e1 : f1 : fs1 : g1 : gs1 :
 a1 : as1 : b1 : c2 : cs2 : d2 : ds2 : e2 : f2 : fs2 : g2 : gs2 :
 a2 : as2 : b2 : c3 : cs3 : d3 : ds3 : e3 : f3 : fs3 : g3 : gs3 :
 a3 : as3 : b3 : c4 : cs4 : d4 : ds4 : e4 : f4 : fs4 : g4 : gs4 : _ =
  iterate ((2 ** recip 12) *) (55/44100)


chordSequence :: [(Int, [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, e3]) :
   (3, [c2,  e2,  g2, c3]) :
   []


withDur :: (Int -> a -> v) -> Int -> a -> (v, NonNeg.Int)
withDur f d ps =
   let dur = d*30000
   in  (f dur ps, NonNeg.fromNumber dur)


padMusic :: IO ()
padMusic = do
   playStereoVector $
      CausalP.applyStorableChunky (CausalP.amplifyStereo id) 0.1 $
      SigStL.arrange tonesChunkSize $
      EventListTM.switchTimeR const $
      EventListMT.consTime 0 $
      EventListBT.fromPairList $
      map (\(d,ps) -> withDur stereoOsciSawPad d ps)
      chordSequence
   return ()


lowpassSweepControlRateCausal ::
   CausalP.T p
      (Stereo.T (Value Float))
      (Stereo.T (Value Float))
lowpassSweepControlRateCausal =
--   CausalP.stereoFromVector $
   CausalP.stereoFromMono $
      UniFilter.lowpass ^<<
      CtrlP.processCtrlRate 128
         (lfoSine (UniFilter.parameter (valueOf (10::Float))))


moogSweepControlRateCausal ::
   CausalP.T p
      (Stereo.T (Value Float))
      (Stereo.T (Value Float))
moogSweepControlRateCausal =
--   CausalP.stereoFromVector $
   CausalP.stereoFromMono $
      CtrlP.processCtrlRate 128
         (lfoSine (Moog.parameter TypeNum.d8 (valueOf (10::Float))))


filterMusic :: IO ()
filterMusic = do
   playStereoVector $
      CausalP.applyStorableChunky
         (CausalP.amplifyStereo id <<<
          moogSweepControlRateCausal) 0.05 $
      SigStL.arrange tonesChunkSize $
      EventListTM.switchTimeR const $
      EventListMT.consTime 0 $
      EventListBT.fromPairList $
      map (\(d,ps) -> withDur stereoOsciSawPad d ps)
      chordSequence
   return ()



stereoOsciSawVectorIO :: IO (Float -> SVL.Vector (Stereo.T Float))
stereoOsciSawVectorIO =
   fmap ($tonesChunkSize) $
   SigP.runChunky $
   stereoOsciSawP

applyFadeEnvelopeIO ::
   IO (Int -> SVL.Vector (Stereo.T Float) -> SVL.Vector (Stereo.T Float))
applyFadeEnvelopeIO =
   fmap
      (\envelope dur sig ->
         let attack = 20000
         in  envelope (attack, dur-attack) sig)
      (CausalP.runStorableChunky
         (CausalP.envelopeStereo $< fadeEnvelope))

stereoOsciSawChordIO :: IO ([Float] -> SVL.Vector (Stereo.T Float))
stereoOsciSawChordIO = do
   sawv <- stereoOsciSawVectorIO
   mix <- mixVectorStereoIO
   return (foldl1 mix . map sawv)

stereoOsciSawPadIO :: IO (Int -> [Float] -> SVL.Vector (Stereo.T Float))
stereoOsciSawPadIO = do
   chrd <- stereoOsciSawChordIO
   envelope <- applyFadeEnvelopeIO
   return $
      \ dur pitches -> envelope dur (chrd pitches)

padMusicIO :: IO ()
padMusicIO = do
   pad <- stereoOsciSawPadIO
   playStereoVector $
      CausalP.applyStorableChunky (CausalP.amplifyStereo id) 0.08 $
      SigStL.arrange tonesChunkSize $
      EventListTM.switchTimeR const $
      EventListMT.consTime 0 $
      EventListBT.fromPairList $
      map (uncurry (withDur pad)) $
      chordSequence
   return ()

{-
Apply the envelope separately to each tone of the chord
and mix all tones by 'arrange'.
-}
padMusicSeparate :: IO ()
padMusicSeparate = do
   osci <- stereoOsciSawVectorIO
   env <- applyFadeEnvelopeIO
   playStereoVector $
      CausalP.applyStorableChunky (CausalP.amplifyStereo id) 0.08 $
      SigStL.arrange tonesChunkSize $
      EventList.flatten $
      EventListTM.switchTimeR const $
      EventListMT.consTime 0 $
      EventListBT.fromPairList $
      map (uncurry (withDur (\d ps -> map (\p -> env d (osci p)) ps))) $
      chordSequence
   return ()


delay :: IO ()
delay =
   SVL.writeFile "speedtest.f32" $
   asMono $
   flip (SigP.renderChunky tonesChunkSize) (0, 10000) $
   CausalP.apply
      ((CausalP.delay $# (0::Float)) fst
          <<< CausalP.take snd) $
   SigP.osciSaw 0 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 0.01



allpassControl ::
   (TypeNum.Nat n) =>
   n ->
   SigP.T Float (Allpass.CascadeParameter n (Value Float))
allpassControl order =
   let reduct = id
   in  SigP.interpolateConstant reduct $
       lfoSine (Allpass.flangerParameter order) reduct

allpassPhaserCausal, allpassPhaserPipeline ::
   SigP.T Float (Value Float) ->
   SigP.T Float (Value Float)
allpassPhaserCausal =
   let order = TypeNum.d16
   in  CausalP.apply $
       CausalP.amplify 0.5 <<<
       Allpass.phaserP <<<
       CausalP.feedFst (allpassControl order)

allpassPhaserPipeline =
   let order = TypeNum.d16
   in  -- (F.nest (TypeNum.toInt order) SigP.tail .) $
       (SigP.drop (return $ TypeNum.toInt order) .) $
       CausalP.apply $
       CausalP.amplify 0.5 <<<
       Allpass.phaserPipelineP <<<
       CausalP.feedFst (allpassControl order)

allpassPhaser :: IO ()
allpassPhaser =
   SVL.writeFile "speedtest.f32" $
   asMono $
   SVL.take 10000000 $
   flip (SigP.renderChunky (SVL.chunkSize 100000)) 128 $
   allpassPhaserPipeline $
   (SigP.osciSaw 0 0.01)

noise :: IO ()
noise =
   SVL.writeFile "speedtest.f32" $
   asMono $
   SVL.take 10000000 $
   flip (SigP.renderChunky (SVL.chunkSize 100000)) () $
   (SigP.noise 0 0.3)

noisePacked :: IO ()
noisePacked =
   SVL.writeFile "speedtest.f32" $
   asMonoPacked $
   SVL.take (div 10000000 4) $
   flip (SigP.renderChunky (SVL.chunkSize 100000)) () $
   (SigPS.noise 0 0.3)
--   (SigPS.pack (SigP.noise 0 0.3))
--   (SigPS.packSmall (SigP.noise 0 0.3))

frequencyModulationStorable :: IO ()
frequencyModulationStorable = do
   smp <- SigP.runChunky (SigP.osciSaw 0 0.01)
   SVL.writeFile "speedtest.f32" $
      asMono $
      flip (SigP.renderChunky (SVL.chunkSize 100000)) () $
      (CausalP.frequencyModulationLinear
          (SigP.fromStorableVectorLazy $#
           (SVL.take 1000000 $ asMono $
            smp (SVL.chunkSize 1000) ()))
       $*# (0.3::Float))

frequencyModulation :: IO ()
frequencyModulation =
   SVL.writeFile "speedtest.f32" $
   asMono $
   SVL.take 10000000 $
   flip (SigP.renderChunky (SVL.chunkSize 100000)) () $
   (CausalP.frequencyModulationLinear
       (SigP.osciSaw 0 0.01)
    $* SigP.exponential2 500000 1)

frequencyModulationStereo :: IO ()
frequencyModulationStereo = do
   smp <- SigP.runChunky (SigP.osciSaw 0 0.01)
   SVL.writeFile "speedtest.f32" $
      asStereo $
      flip (SigP.renderChunky (SVL.chunkSize 100000)) () $
      (CausalP.stereoFromMono
         (CausalP.frequencyModulationLinear
            (SigP.fromStorableVectorLazy $#
             (SVL.take 1000000 $ asMono $
              smp (SVL.chunkSize 1000) ())))
       $*# Stereo.cons (0.2999::Float) 0.3001)


quantize :: IO ()
quantize =
{-
   SV.writeFile "speedtest.f32" $
   asMono $
   (\xs -> SigP.render xs 10000000 ()) $
-}
   SVL.writeFile "speedtest.f32" $
   asMono $
   SVL.take 10000000 $
   flip (SigP.renderChunky (SVL.chunkSize 100000)) () $
   ((CausalP.quantizeLift $# (5.5::Float)) id $*
    SigP.osciSaw 0 0.01)

quantizedFilterControl :: IO ()
quantizedFilterControl =
   SVL.writeFile "speedtest.f32" $
   asMono $
   SVL.take 10000000 $
   flip (SigP.renderChunky (SVL.chunkSize 100000)) () $
   CausalP.apply (CausalP.amplify 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)))
         $* (SigP.osciSimple Wave.approxSine2 $# (0::Float)) (0.1/44100)) $
   (SigP.osciSaw $# (0::Float)) 0.01


arrowNonShared :: IO ()
arrowNonShared =
   SVL.writeFile "speedtest.f32" $
   asStereo $
   SVL.take 10000000 $
   flip (SigP.renderChunky (SVL.chunkSize 100000)) () $
   (let osci = CausalP.osciSimple Wave.approxSine2
    in  liftA2 Stereo.cons osci osci $*
        SigP.constant (return (0::Float, 0.01::Float)))

arrowShared :: IO ()
arrowShared =
   SVL.writeFile "speedtest.f32" $
   asStereo $
   SVL.take 10000000 $
   flip (SigP.renderChunky (SVL.chunkSize 100000)) () $
   (let osci = Func.lift (CausalP.osciSimple Wave.approxSine2)
    in  Func.compile (liftA2 Stereo.cons osci osci) $*
        SigP.constant (return (0::Float, 0.01::Float)))

arrowIndependent :: IO ()
arrowIndependent =
   SVL.writeFile "speedtest.f32" $
   asStereo $
   SVL.take 10000000 $
   flip (SigP.renderChunky (SVL.chunkSize 100000)) () $
   (let osci = CausalP.osciSimple Wave.approxSine2
    in  Func.compile
          (fmap (uncurry Stereo.cons)  $
           osci *** osci  Func.$&
           Func.lift id) $*
        SigP.constant (return ((0::Float, 0.01::Float), (0.25::Float, 0.01001::Float))))


main :: IO ()
main = do
   LLVM.initializeNativeTarget
   arrowIndependent