packages feed

synthesizer-llvm 0.8.3 → 0.9

raw patch · 103 files changed

+2128/−3034 lines, 103 filesdep +llvm-dsldep −storable-tupledep ~explicit-exceptiondep ~llvm-extradep ~llvm-tf

Dependencies added: llvm-dsl

Dependencies removed: storable-tuple

Dependency ranges changed: explicit-exception, llvm-extra, llvm-tf, optparse-applicative, storable-record, utility-ht

Files

Changes.md view
@@ -1,5 +1,13 @@ # Change log for the `synthesizer-llvm` package +## 0.9++* Clean separation between Haskell's `Storable` memory format+  as used in `StorableVector`+  and LLVM's memory format, used for parameters.++* Use of new `llvm-dsl` package.+ ## 0.8.3  * `Noise`: caused a crash with LLVM-9
alsa/Synthesizer/LLVM/Server/ALSA.hs view
@@ -27,13 +27,11 @@  import qualified Algebra.Additive  as Additive -import Control.Functor.HT (void, )+import Control.Functor.HT (void)  import qualified System.IO as IO --- import NumericPrelude.Numeric (zero, round, )--import Prelude hiding (Real, round, )+import Prelude hiding (Real, round)   getOptParams :: Option.T -> h -> ((PCM.Size, PCM.SampleFreq), h)
alsa/Synthesizer/LLVM/Server/CausalPacked/Run.hs view
@@ -2,13 +2,13 @@  import qualified Synthesizer.LLVM.Server.CausalPacked.Arrange as Arrange import Synthesizer.LLVM.Server.CausalPacked.Arrange-          (StereoVector, controllerExponentialDim, (&+&), )+          (StereoVector, controllerExponentialDim, (&+&))  import qualified Sound.MIDI.Controller as Ctrl  import qualified Synthesizer.LLVM.Server.CausalPacked.Speech as Speech import qualified Synthesizer.LLVM.Server.Option as Option-import Synthesizer.LLVM.Server.ALSA (playChunk, startMessage, )+import Synthesizer.LLVM.Server.ALSA (playChunk, startMessage) import Synthesizer.LLVM.Server.Common  import qualified Sound.ALSA.Sequencer.Event as Event@@ -34,20 +34,14 @@ import qualified Sound.MIDI.Message.Channel.Voice as VoiceMsg import qualified Sound.MIDI.Message.Channel as ChannelMsg -import Control.Arrow ((<<<), (^<<), arr, )-import Control.Category (id, )+import Control.Arrow ((<<<), (^<<), arr)+import Control.Category (id)  import qualified Number.DimensionTerm as DN  import qualified Algebra.Additive as Additive -{--import qualified Numeric.NonNegative.Class   as NonNeg-import qualified Numeric.NonNegative.Wrapper as NonNegW-import qualified Numeric.NonNegative.Chunky  as NonNegChunky--}--import Prelude hiding (Real, id, )+import Prelude hiding (Real, id)
alsa/Synthesizer/LLVM/Server/CausalPacked/Test.hs view
@@ -7,11 +7,11 @@ import qualified Synthesizer.LLVM.Server.Option as Option import qualified Synthesizer.LLVM.Server.Default as Default import Synthesizer.LLVM.Server.CausalPacked.Arrange-          ((&+&), shortTime, controllerExponentialDim, )+          ((&+&), shortTime, controllerExponentialDim) import Synthesizer.LLVM.Server.CommonPacked-          (Vector, )+          (Vector) import Synthesizer.LLVM.Server.Common hiding-          (Instrument, )+          (Instrument)  import qualified Sound.ALSA.Sequencer.Event as Event -- import qualified Sound.ALSA.Sequencer.Connect as Connect@@ -30,7 +30,7 @@  import qualified Synthesizer.ALSA.Storable.Play as Play import qualified Synthesizer.ALSA.CausalIO.Process as PAlsa-import Synthesizer.MIDI.Storable (Instrument, )+import Synthesizer.MIDI.Storable (Instrument)  import qualified Synthesizer.MIDI.PiecewiseConstant.ControllerSet as PCS import qualified Synthesizer.MIDI.CausalIO.ControllerSet as MCS@@ -46,7 +46,7 @@ import qualified Synthesizer.LLVM.Storable.Signal as SigStL import qualified Synthesizer.LLVM.MIDI.BendModulation as BM import qualified Synthesizer.LLVM.Wave as Wave-import Synthesizer.LLVM.CausalParameterized.Process (($*), ($<), )+import Synthesizer.LLVM.CausalParameterized.Process (($*), ($<))  import qualified Synthesizer.Generic.Cut          as CutG import qualified Synthesizer.Storable.Cut         as CutSt@@ -58,31 +58,28 @@ import qualified Data.EventList.Relative.TimeMixed as EventListTM import qualified Data.EventList.Relative.BodyTime  as EventListBT -import System.Path ((</>), )+import System.Path ((</>)) -import Control.Arrow ((<<<), (<<^), (^<<), arr, first, )-import Control.Category (id, )-import Control.Applicative (pure, liftA2, )-import Control.Monad (when, )-import Control.Monad.Trans.State (evalState, )+import Control.Arrow ((<<<), (<<^), (^<<), arr, first)+import Control.Category (id)+import Control.Applicative (pure, liftA2)+import Control.Monad (when)+import Control.Monad.Trans.State (evalState)  import qualified Data.Map as Map --- import qualified Numeric.NonNegative.Class   as NonNeg import qualified Numeric.NonNegative.Wrapper as NonNegW--- import qualified Numeric.NonNegative.Chunky  as NonNegChunky  import qualified Number.DimensionTerm as DN -import Data.Word (Word8, Word32, )-import Data.Int (Int32, )+import Data.Word (Word8, Word32)+import Data.Int (Int32) -import Foreign.Storable (Storable, )+import Foreign.Storable (Storable) import qualified System.IO as IO-import Control.Exception (bracket, )+import Control.Exception (bracket) --- import NumericPrelude.Numeric (zero, round, (^?), )-import Prelude hiding (Real, id, )+import Prelude hiding (Real, id)   sampleRate :: SampleRate Real
alsa/Synthesizer/LLVM/Server/Option.hs view
@@ -5,7 +5,7 @@    ) where  import qualified Synthesizer.LLVM.Server.OptionCommon as Option-import Synthesizer.LLVM.Server.Common (SampleRate(..), )+import Synthesizer.LLVM.Server.Common (SampleRate(..))  import qualified Synthesizer.ALSA.Storable.Play as Play import qualified Data.StorableVector.Lazy       as SVL@@ -15,10 +15,10 @@  import qualified System.Path as Path import qualified Options.Applicative as OP-import Control.Applicative (pure, (<$>), (<*>), )-import Data.Monoid ((<>), )+import Control.Applicative (pure, (<$>), (<*>))+import Data.Monoid ((<>)) -import Prelude hiding (Real, )+import Prelude hiding (Real)   data T =
alsa/Synthesizer/LLVM/Server/Packed/Run.hs view
@@ -3,9 +3,9 @@ import qualified Synthesizer.LLVM.Server.Packed.Instrument as Instr import qualified Synthesizer.LLVM.Server.SampledSound as Sample import qualified Synthesizer.LLVM.Server.Option as Option-import Synthesizer.LLVM.Server.ALSA (Output, play, startMessage, )+import Synthesizer.LLVM.Server.ALSA (Output, play, startMessage) import Synthesizer.LLVM.Server.CommonPacked-          (Vector, VectorSize, vectorSize, stair, )+          (Vector, VectorSize, vectorSize, stair) import Synthesizer.LLVM.Server.Common  import qualified Synthesizer.ALSA.EventList as Ev@@ -25,8 +25,8 @@ import qualified Synthesizer.LLVM.Parameterized.Signal as SigP import qualified Synthesizer.LLVM.Storable.Signal as SigStL import qualified Synthesizer.LLVM.Wave as WaveL-import Synthesizer.LLVM.CausalParameterized.Process (($<), ($*), )-import Synthesizer.LLVM.Parameter (($#), )+import Synthesizer.LLVM.CausalParameterized.Process (($<), ($*))+import Synthesizer.LLVM.Parameter (($#))  import qualified Synthesizer.Storable.Signal as SigSt import qualified Data.StorableVector.Lazy as SVL@@ -45,23 +45,16 @@ import qualified System.Path as Path  import qualified Control.Applicative.HT as App-import Control.Arrow ((<<<), (^<<), arr, )-import Control.Applicative (pure, liftA2, liftA3, (<*>), )-import Control.Monad.Trans.State (evalState, )--import Control.Exception (bracket, )+import Control.Arrow ((<<<), (^<<), arr)+import Control.Applicative (pure, liftA2, liftA3, (<*>))+import Control.Monad.Trans.State (evalState) -{--import Data.Tuple.HT (mapPair, fst3, snd3, thd3, )+import Control.Exception (bracket) -import qualified Numeric.NonNegative.Class   as NonNeg-import qualified Numeric.NonNegative.Wrapper as NonNegW-import qualified Numeric.NonNegative.Chunky as NonNegChunky--}-import Algebra.IntegralDomain (divUp, )+import Algebra.IntegralDomain (divUp) -import NumericPrelude.Numeric (zero, (^?), (+), )-import Prelude hiding (Real, break, (+), )+import NumericPrelude.Numeric (zero, (^?), (+))+import Prelude hiding (Real, break, (+))
alsa/Synthesizer/LLVM/Server/Packed/Test.hs view
@@ -3,11 +3,11 @@ import qualified Synthesizer.LLVM.Server.Packed.Instrument as Instr import qualified Synthesizer.LLVM.Server.Default as Default import qualified Synthesizer.LLVM.Server.SampledSound as Sample-import Synthesizer.LLVM.Server.ALSA (makeNote, )+import Synthesizer.LLVM.Server.ALSA (makeNote) import Synthesizer.LLVM.Server.CommonPacked-          (Vector, vectorSize, )+          (Vector, vectorSize) import Synthesizer.LLVM.Server.Common hiding-          (Instrument, )+          (Instrument)  import qualified Sound.ALSA.Sequencer.Event as Event import qualified Synthesizer.MIDI.PiecewiseConstant as PC@@ -17,7 +17,7 @@ import qualified Synthesizer.LLVM.Frame.SerialVector as Serial  import qualified Synthesizer.ALSA.Storable.Play as Play-import Synthesizer.MIDI.Storable (Instrument, chunkSizesFromLazyTime, )+import Synthesizer.MIDI.Storable (Instrument, chunkSizesFromLazyTime)  import qualified Synthesizer.LLVM.MIDI.BendModulation as BM import qualified Synthesizer.LLVM.CausalParameterized.ProcessPacked as CausalPS@@ -25,37 +25,28 @@ import qualified Synthesizer.LLVM.CausalParameterized.Process as CausalP import qualified Synthesizer.LLVM.Parameterized.Signal as SigP import qualified Synthesizer.LLVM.Storable.Signal as SigStL-import Synthesizer.LLVM.CausalParameterized.Process (($*), )+import Synthesizer.LLVM.CausalParameterized.Process (($*))  import qualified Synthesizer.Storable.Cut         as CutSt import qualified Synthesizer.Storable.Signal      as SigSt import qualified Data.StorableVector.Lazy.Pattern as SVP 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 Control.Arrow ((<<<), arr, )-import Control.Applicative (pure, liftA, liftA2, )-import Control.Monad.Trans.State (evalState, )+import Control.Arrow ((<<<), arr)+import Control.Applicative (pure, liftA, liftA2)+import Control.Monad.Trans.State (evalState) -{--import qualified Numeric.NonNegative.Class   as NonNeg--} import qualified Numeric.NonNegative.Wrapper as NonNegW import qualified Numeric.NonNegative.Chunky as NonNegChunky -import Algebra.IntegralDomain (divUp, )-{--import qualified Algebra.RealRing as RealRing-import qualified Algebra.Additive  as Additive--}+import Algebra.IntegralDomain (divUp)  import qualified Number.DimensionTerm as DN --- import NumericPrelude.Numeric (zero, round, (^?), )-import Prelude hiding (Real, round, break, )+import Prelude hiding (Real, round, break)   chunkSize :: SVL.ChunkSize
alsa/Synthesizer/LLVM/Server/Scalar/Run.hs view
@@ -2,7 +2,7 @@  import qualified Synthesizer.LLVM.Server.Scalar.Instrument as Instr import qualified Synthesizer.LLVM.Server.Option as Option-import Synthesizer.LLVM.Server.ALSA (Output, play, startMessage, )+import Synthesizer.LLVM.Server.ALSA (Output, play, startMessage) import Synthesizer.LLVM.Server.Common  import qualified Sound.ALSA.Sequencer.Event as Event@@ -14,7 +14,7 @@ import qualified Synthesizer.LLVM.Parameterized.Signal as SigP import qualified Synthesizer.LLVM.Storable.Signal as SigStL import qualified Synthesizer.LLVM.Wave as WaveL-import Synthesizer.LLVM.Causal.Process (($<#), ($*), )+import Synthesizer.LLVM.Causal.Process (($<#), ($*))  import qualified Synthesizer.Storable.Signal      as SigSt @@ -25,12 +25,12 @@  import qualified Sound.MIDI.Message.Channel.Voice as VoiceMsg -import Control.Arrow ((<<<), arr, )-import Control.Monad.Trans.State (evalState, )+import Control.Arrow ((<<<), arr)+import Control.Monad.Trans.State (evalState) -import Control.Exception (bracket, )+import Control.Exception (bracket) -import NumericPrelude.Numeric (fromIntegral, zero, (*), (*>), (/), )+import NumericPrelude.Numeric (fromIntegral, zero, (*), (*>), (/)) import NumericPrelude.Base import Prelude (Double)
alsa/Synthesizer/LLVM/Server/Scalar/Test.hs view
@@ -3,8 +3,8 @@ import qualified Synthesizer.LLVM.Server.Scalar.Instrument as Instr import qualified Synthesizer.LLVM.Server.Option as Option import qualified Synthesizer.LLVM.Server.Default as Default-import Synthesizer.LLVM.Server.Scalar.Run (withMIDIEvents, )-import Synthesizer.LLVM.Server.ALSA (record, put, makeNote, )+import Synthesizer.LLVM.Server.Scalar.Run (withMIDIEvents)+import Synthesizer.LLVM.Server.ALSA (record, put, makeNote) import Synthesizer.LLVM.Server.Common  import qualified Synthesizer.ALSA.Storable.Play as Play@@ -16,7 +16,7 @@ import qualified Synthesizer.LLVM.CausalParameterized.Process as CausalP import qualified Synthesizer.LLVM.Parameterized.Signal as SigP import qualified Synthesizer.LLVM.Wave as WaveL-import Synthesizer.LLVM.Causal.Process (($<#), ($*), )+import Synthesizer.LLVM.Causal.Process (($<#), ($*))  import qualified Synthesizer.Storable.Cut         as CutSt import qualified Synthesizer.Storable.Signal      as SigSt@@ -24,11 +24,11 @@  import qualified Data.EventList.Relative.TimeBody  as EventList -import Control.Arrow (arr, )-import Control.Monad.Trans.State (evalState, )+import Control.Arrow (arr)+import Control.Monad.Trans.State (evalState) -import NumericPrelude.Numeric (zero, )-import Prelude hiding (Real, )+import NumericPrelude.Numeric (zero)+import Prelude hiding (Real)   chunkSize :: SVL.ChunkSize
example/Synthesizer/LLVM/LAC2011.hs view
@@ -28,30 +28,30 @@ import qualified LLVM.Extra.ScalarOrVector as SoV import qualified LLVM.Extra.Memory as Memory import qualified LLVM.Extra.Arithmetic as A-import qualified LLVM.Extra.Class as C-import LLVM.Core (Value, value, valueOf, Vector, constVector, constOf, )+import qualified LLVM.Extra.Tuple as Tuple+import LLVM.Core (Value, value, valueOf, Vector, constVector, constOf) import LLVM.Util.Arithmetic () -- Floating instance for TValue import qualified LLVM.Core as LLVM-import Type.Data.Num.Decimal (D4, D8, D16, d0, d1, d2, d3, d4, d5, d6, d7, d8, )+import Type.Data.Num.Decimal (D4, D8, D16, d0, d1, d2, d3, d4, d5, d6, d7, d8) import qualified Type.Data.Num.Decimal as TypeNum  import qualified Synthesizer.LLVM.Parameterized.SignalPacked as GenPS import qualified Synthesizer.LLVM.Parameterized.Signal as GenP-import Synthesizer.LLVM.Causal.Process (($<), ($*), ($*#), )-import Synthesizer.LLVM.Parameter (($#), )+import Synthesizer.LLVM.Causal.Process (($<), ($*), ($*#))+import Synthesizer.LLVM.Parameter (($#))  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.Monad ((<=<), )-import Control.Applicative (liftA2, pure, )-import Control.Functor.HT (void, )-import Data.Traversable (traverse, )+import Control.Arrow (Arrow, arr, (&&&), (^<<))+import Control.Category ((<<<), (.), id)+import Control.Monad ((<=<))+import Control.Applicative (liftA2, pure)+import Control.Functor.HT (void)+import Data.Traversable (traverse) -import Foreign.Storable (Storable, )+import Foreign.Storable (Storable) import qualified Data.StorableVector.Lazy as SVL import qualified Data.StorableVector as SV @@ -70,20 +70,18 @@ -- import qualified Sound.ALSA.PCM as ALSA -- import qualified Synthesizer.ALSA.Storable.Play as Play -import Data.Word (Word32, )--- import qualified Data.Function.HT as F-import Data.List (genericLength, )-import System.Random (randomRs, mkStdGen, )+import Data.Word (Word32)+import Data.List (genericLength)+import System.Random (randomRs, mkStdGen)  import qualified System.IO as IO--- import System.Exit (ExitCode, )  import qualified Algebra.Field as Field import qualified Algebra.Ring as Ring import qualified Algebra.Additive as Additive  import NumericPrelude.Numeric-import NumericPrelude.Base hiding (fst, snd, id, (.), )+import NumericPrelude.Base hiding (fst, snd, id, (.)) import qualified NumericPrelude.Base as P  @@ -140,7 +138,7 @@  {- play ::-   (C.MakeValueTuple y, ValueTuple y ~ a, Memory.C a struct) =>+   (C.MakeValueTuple y, Tuple.ValueOf y ~ a, Memory.C a struct) =>    Gen.T a -> IO () play =    playStreamSox .
example/Synthesizer/LLVM/LNdW2011.hs view
@@ -44,18 +44,18 @@ import qualified LLVM.Extra.ScalarOrVector as SoV import qualified LLVM.Extra.Memory as Memory import qualified LLVM.Extra.Arithmetic as A-import qualified LLVM.Extra.Class as C-import LLVM.Core (Value, value, valueOf, constVector, constOf, )+import qualified LLVM.Extra.Tuple as Tuple+import LLVM.Core (Value, value, valueOf, constVector, constOf) import LLVM.Util.Arithmetic () -- Floating instance for TValue import qualified LLVM.Core as LLVM  import qualified Type.Data.Num.Decimal as TypeNum-import Type.Data.Num.Decimal (D4, D8, D16, d0, d1, d2, d3, d4, d5, d6, d7, d8, )+import Type.Data.Num.Decimal (D4, D8, D16, d0, d1, d2, d3, d4, d5, d6, d7, d8)  import qualified Synthesizer.LLVM.Parameterized.SignalPacked as GenPS import qualified Synthesizer.LLVM.Parameterized.Signal as GenP-import Synthesizer.LLVM.Causal.Process (($<), ($*), ($*#), ($<#), )-import Synthesizer.LLVM.Parameter (($#), )+import Synthesizer.LLVM.Causal.Process (($<), ($*), ($*#), ($<#))+import Synthesizer.LLVM.Parameter (($#))  import qualified Synthesizer.Plain.Filter.Recursive as FiltR import qualified Synthesizer.Plain.Filter.Recursive.FirstOrder as Filt1Core@@ -65,15 +65,15 @@  import qualified Control.Monad.Trans.State as State import qualified Control.Arrow as Arr-import Control.Arrow (Arrow, arr, (&&&), (^<<), (^>>), )-import Control.Category ((<<<), (.), id, (>>>), )-import Control.Monad (liftM2, (<=<), )-import Control.Applicative (liftA2, pure, )-import Control.Functor.HT (void, )-import Data.Tuple.HT (mapPair, )-import Data.Traversable (traverse, )+import Control.Arrow (Arrow, arr, (&&&), (^<<), (^>>))+import Control.Category ((<<<), (.), id, (>>>))+import Control.Monad (liftM2, (<=<))+import Control.Applicative (liftA2, pure)+import Control.Functor.HT (void)+import Data.Tuple.HT (mapPair)+import Data.Traversable (traverse) -import Foreign.Storable (Storable, )+import Foreign.Storable (Storable) import qualified Data.StorableVector.Lazy as SVL import qualified Data.StorableVector as SV @@ -95,13 +95,11 @@ import qualified Sound.ALSA.PCM as ALSA import qualified Synthesizer.ALSA.Storable.Play as Play -import Data.Word (Word32, )--- import qualified Data.Function.HT as F-import Data.List (genericLength, )-import System.Random (randomRs, mkStdGen, )+import Data.Word (Word32)+import Data.List (genericLength)+import System.Random (randomRs, mkStdGen)  import qualified System.IO as IO--- import System.Exit (ExitCode, )  import qualified Algebra.NormedSpace.Euclidean as NormedEuc import qualified Algebra.Field as Field@@ -110,7 +108,7 @@ import qualified Algebra.IntegralDomain as Integral  import NumericPrelude.Numeric-import NumericPrelude.Base hiding (fst, snd, id, (.), )+import NumericPrelude.Base hiding (fst, snd, id, (.)) import qualified NumericPrelude.Base as P
example/Synthesizer/LLVM/Test.hs view
@@ -34,10 +34,10 @@ import qualified Synthesizer.LLVM.Parameter as Param import qualified Synthesizer.LLVM.Parameterized.SignalPacked as SigPS import qualified Synthesizer.LLVM.Parameterized.Signal as SigP-import Synthesizer.LLVM.CausalParameterized.Functional (($&), (&|&), )-import Synthesizer.LLVM.Causal.Process (($<), ($>), ($*), ($*#), )-import Synthesizer.LLVM.Simple.Value ((%>), (%&&), )-import Synthesizer.LLVM.Parameter (($#), )+import Synthesizer.LLVM.CausalParameterized.Functional (($&), (&|&))+import Synthesizer.LLVM.Causal.Process (($<), ($>), ($*), ($*#))+import Synthesizer.LLVM.Simple.Value ((%>), (%&&))+import Synthesizer.LLVM.Parameter (($#))  import qualified Synthesizer.LLVM.Frame.StereoInterleaved as StereoInt import qualified Synthesizer.LLVM.Frame.Stereo as Stereo@@ -49,12 +49,12 @@ import qualified LLVM.Extra.Maybe as Maybe  import qualified LLVM.Core as LLVM-import LLVM.Core (Value, valueOf, Vector, )+import LLVM.Core (Value, valueOf, Vector) import LLVM.Util.Arithmetic () -- Floating instance for TValue  import qualified Type.Data.Num.Decimal as TypeNum-import Type.Data.Num.Decimal (D4, D8, D16, )-import Type.Base.Proxy (Proxy, )+import Type.Data.Num.Decimal (D4, D8, D16)+import Type.Base.Proxy (Proxy)  import qualified Synthesizer.CausalIO.Process as PIO import qualified Synthesizer.Causal.Class as CausalClass@@ -66,15 +66,15 @@ 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 Control.Functor.HT (void, )-import Control.Monad (when, )+import Control.Arrow (Arrow, arr, (&&&), (^<<), (<<^), (***))+import Control.Category ((<<<), (.), id)+import Control.Applicative (pure, liftA2)+import Control.Functor.HT (void)+import Control.Monad (when)  import qualified Data.StorableVector.Lazy as SVL import qualified Data.StorableVector as SV-import Foreign.Storable (Storable, )+import Foreign.Storable (Storable)  import qualified Data.EventList.Relative.TimeBody  as EventList import qualified Data.EventList.Relative.BodyTime  as EventListBT@@ -88,20 +88,17 @@  import qualified Data.NonEmpty.Class as NonEmptyC import qualified Data.NonEmpty as NonEmpty-import qualified Data.Empty as Empty-import Data.NonEmpty ((!:), )-import Data.Traversable (sequenceA, )-import Data.Word (Word32, )--- import qualified Data.Function.HT as F-import Data.List (genericLength, )-import System.Path ((</>), )-import System.Random (randomRs, mkStdGen, )+import Data.NonEmpty ((!:))+import Data.Traversable (sequenceA)+import Data.Word (Word32)+import Data.List (genericLength)+import System.Path ((</>))+import System.Random (randomRs, mkStdGen)  import qualified System.IO as IO-import Control.Exception (bracket, )--- import System.Exit (ExitCode, )+import Control.Exception (bracket) -import Prelude hiding (fst, snd, id, (.), )+import Prelude hiding (fst, snd, id, (.)) import qualified NumericPrelude.Numeric as NP import qualified Prelude as P @@ -341,24 +338,23 @@    in  liftA2 Stereo.cons           (Sig.map mix4 $            Sig.osciPlain Wave.saw-              (valueOf $ LLVM.vector $ 0.0 !: 0.2 !: 0.1 !: 0.4 !: Empty.Cons)-              (valueOf $ LLVM.vector $ fmap (freq*) $-               1.001 !: 1.003 !: 0.995 !: 0.996 !: Empty.Cons))+              (valueOf $ LLVM.consVector 0.0 0.2 0.1 0.4)+              (valueOf $ fmap (freq*) $+               LLVM.consVector 1.001 1.003 0.995 0.996))           (Sig.map mix4 $            Sig.osciPlain Wave.saw-              (valueOf $ LLVM.vector $ 0.1 !: 0.7 !: 0.5 !: 0.7 !: Empty.Cons)-              (valueOf $ LLVM.vector $ fmap (freq*) $-               1.005 !: 0.997 !: 0.999 !: 1.001 !: Empty.Cons))+              (valueOf $ LLVM.consVector 0.1 0.7 0.5 0.7)+              (valueOf $ fmap (freq*) $+               LLVM.consVector 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 (A.fromRational' 0.2))-      (valueOf $-       LLVM.toVector (0.0, 0.2, 0.1, 0.4, 0.1, 0.7, 0.5, 0.7))-      (valueOf $ LLVM.vector $ fmap (freq*) $-       1.001 !: 1.003 !: 0.995 !: 0.996 !: 1.005 !: 0.997 !: 0.999 !: 1.001 !: Empty.Cons)+      (valueOf $ LLVM.consVector 0.0 0.2 0.1 0.4 0.1 0.7 0.5 0.7)+      (valueOf $ fmap (freq*) $+       LLVM.consVector 1.001 1.003 0.995 0.996 1.005 0.997 0.999 1.001)  stereo :: IO () stereo =
jack/Synthesizer/LLVM/Server/JACK.hs view
@@ -5,7 +5,7 @@  import qualified Synthesizer.LLVM.Server.CausalPacked.Arrange as Arrange -import Synthesizer.LLVM.Server.CommonPacked (Vector, VectorSize, vectorSize, )+import Synthesizer.LLVM.Server.CommonPacked (Vector, VectorSize, vectorSize)  import qualified Synthesizer.LLVM.Server.Option as Option import Synthesizer.LLVM.Server.Common@@ -22,7 +22,7 @@  import qualified Data.StorableVector as SV import qualified Data.StorableVector.Base as SVB-import Foreign.Marshal.Array (copyArray, )+import Foreign.Marshal.Array (copyArray)  import qualified Data.EventList.Relative.TimeTime  as EventListTT import qualified Data.EventList.Absolute.TimeTime  as EventListAbsTT@@ -35,7 +35,7 @@ import qualified Sound.JACK.Exception as JackExc import qualified Sound.JACK as JACK -import Data.IORef (newIORef, readIORef, writeIORef, )+import Data.IORef (newIORef, readIORef, writeIORef)  import qualified Sound.MIDI.Message.Channel.Voice as VoiceMsg import qualified Sound.MIDI.Message.Channel as ChannelMsg@@ -47,18 +47,14 @@ import qualified System.Path.PartClass as PathClass import qualified System.Path as Path -import Control.Arrow ((<<<), (^<<), arr, )-import Control.Category (id, )-import Control.Applicative (pure, )+import Control.Arrow ((<<<), (^<<), arr)+import Control.Category (id)+import Control.Applicative (pure)  import qualified System.Random as Random-{--import qualified Numeric.NonNegative.Class   as NonNeg-import qualified Numeric.NonNegative.Chunky  as NonNegChunky--} import qualified Numeric.NonNegative.Wrapper as NonNegW -import Prelude hiding (Real, id, )+import Prelude hiding (Real, id)   type StereoVector = StereoInt.T VectorSize Real
jack/Synthesizer/LLVM/Server/Option.hs view
@@ -9,9 +9,9 @@  import qualified System.Path as Path import qualified Options.Applicative as OP-import Control.Applicative (pure, (<*>), )+import Control.Applicative (pure, (<*>)) -import Prelude hiding (Real, )+import Prelude hiding (Real)   data T =
render/Synthesizer/LLVM/Server/Option.hs view
@@ -5,7 +5,7 @@  import qualified Synthesizer.LLVM.Server.OptionCommon as Option import qualified Synthesizer.LLVM.Server.Default as Default-import Synthesizer.LLVM.Server.Common (SampleRate, )+import Synthesizer.LLVM.Server.Common (SampleRate) import qualified Data.StorableVector.Lazy as SVL  import qualified Sound.MIDI.Message.Channel as ChannelMsg@@ -13,11 +13,11 @@ import qualified System.Path as Path  import qualified Options.Applicative as OP-import Control.Applicative (pure, (<$>), (<*>), )-import Data.Maybe (fromMaybe, )-import Data.Monoid ((<>), )+import Control.Applicative (pure, (<$>), (<*>))+import Data.Maybe (fromMaybe)+import Data.Monoid ((<>)) -import Prelude hiding (Real, )+import Prelude hiding (Real)   data T =
render/Synthesizer/LLVM/Server/Render.hs view
@@ -3,7 +3,7 @@  import qualified Synthesizer.LLVM.Server.CausalPacked.Arrange as Arrange import Synthesizer.LLVM.Server.CommonPacked-          (vectorSize, vectorRate, )+          (vectorSize, vectorRate)  import qualified Synthesizer.LLVM.Server.Option as Option import qualified Synthesizer.LLVM.Frame.Stereo as Stereo@@ -26,19 +26,15 @@ import qualified Sound.Sox.Write as SoxWrite import qualified Sound.Sox.Play  as SoxPlay -import Control.Applicative ((<*>), )+import Control.Applicative ((<*>)) -import Data.Monoid (mempty, )+import Data.Monoid (mempty) -{--import qualified Numeric.NonNegative.Chunky  as NonNegChunky-import qualified Numeric.NonNegative.Class   as NonNeg--} import qualified Numeric.NonNegative.Wrapper as NonNegW  import qualified System.Exit as Exit -import Prelude hiding (Real, id, )+import Prelude hiding (Real, id)
server/Synthesizer/LLVM/Server/CausalPacked/Arrange.hs view
@@ -1,6 +1,6 @@ module Synthesizer.LLVM.Server.CausalPacked.Arrange where -import Synthesizer.LLVM.Server.CommonPacked (VectorSize, Vector, VectorValue, stair, )+import Synthesizer.LLVM.Server.CommonPacked (VectorSize, Vector, VectorValue, stair)  import qualified Sound.MIDI.Controller as Ctrl @@ -42,12 +42,12 @@ import qualified System.Path.PartClass as PathClass import qualified System.Path as Path -import Control.Arrow (Arrow, arr, first, (<<<), (^<<), )-import Control.Category (id, )-import Control.Applicative ((<*>), )+import Control.Arrow (Arrow, arr, first, (<<<), (^<<))+import Control.Category (id)+import Control.Applicative ((<*>))  import qualified Data.List.HT as ListHT-import Data.Maybe.HT (toMaybe, )+import Data.Maybe.HT (toMaybe)  import qualified Data.Map as Map @@ -56,13 +56,9 @@  import qualified Algebra.Transcendental as Trans -{--import qualified Numeric.NonNegative.Chunky  as NonNegChunky-import qualified Numeric.NonNegative.Class   as NonNeg--} import qualified Numeric.NonNegative.Wrapper as NonNegW -import Prelude hiding (Real, id, )+import Prelude hiding (Real, id)
server/Synthesizer/LLVM/Server/Default.hs view
@@ -1,6 +1,6 @@ module Synthesizer.LLVM.Server.Default where -import Synthesizer.LLVM.Server.Common (SampleRate(SampleRate), )+import Synthesizer.LLVM.Server.Common (SampleRate(SampleRate))  import qualified Sound.MIDI.Message.Channel as ChannelMsg
server/Synthesizer/LLVM/Server/OptionCommon.hs view
@@ -8,8 +8,8 @@    ) where  import qualified Synthesizer.LLVM.Server.Default as Default-import Synthesizer.LLVM.Server.Default (ClientName(ClientName), )-import Synthesizer.LLVM.Server.Common (SampleRate(SampleRate), )+import Synthesizer.LLVM.Server.Default (ClientName(ClientName))+import Synthesizer.LLVM.Server.Common (SampleRate(SampleRate))  import qualified Sound.MIDI.Message.Channel as ChannelMsg import qualified Data.StorableVector.Lazy as SVL@@ -19,10 +19,10 @@  import qualified Shell.Utility.ParseArgument as ParseArg import qualified Options.Applicative as OP-import Control.Applicative ((<$>), (<*>), )-import Data.Monoid ((<>), )+import Control.Applicative ((<$>), (<*>))+import Data.Monoid ((<>)) -import Prelude hiding (Real, )+import Prelude hiding (Real)   clientName :: String -> OP.Parser ClientName
− src/Synthesizer/LLVM/Alloc.hs 
@@ -1,99 +0,0 @@-{- |-Provide allocation functions with correct alignment.-GHC's functions are wrong until at least GHC-6.12.3.--}-module Synthesizer.LLVM.Alloc (-   malloc, free,-   mallocArray, freeArray,-   F.alloca, F.with,-   ) where-{- reexport alloca and with, since they work correctly in GHC-6.12.3 -}--import qualified Foreign as F-import Foreign.Storable.FixedArray (sizeOfArray, roundUp, )-import Foreign.Storable (Storable, sizeOf, alignment, )-import Foreign.Ptr (Ptr, minusPtr, plusPtr, nullPtr, )--import qualified Synthesizer.LLVM.Debug.Storable as Debug---{--diffClip :: Int -> Int -> Int--- this implementation also works for unsigned types-diffClip x y = x - min x y--- diffClip x y = max 0 (x-y)--}--defaultMallocAlign :: Int-defaultMallocAlign = 8---seekPointer :: Int -> Ptr a -> Ptr b-seekPointer size ptr =-   alignPointer (alignment nullPtr) (plusPtr ptr size)--alignPointer :: Int -> Ptr a -> Ptr b-alignPointer align ptr =-   plusPtr nullPtr $-   roundUp align $-   minusPtr ptr nullPtr--{- |-> mallocAligned align size--}-mallocAligned :: Int -> Int -> IO (Ptr a)-mallocAligned align size =-   if mod defaultMallocAlign align == 0-     then F.mallocBytes size-     else do-        let {- pessimistic but safe -}-            ptrOffset = size + alignment nullPtr-            {- This should be optimal and I think it is also correct,-               but better safe than sorry.-            common = gcd align (alignment nullPtr)-            ptrOffset = roundUp common size + alignment nullPtr - common-            -}-            padSize = align - gcd defaultMallocAlign align-        allocPtr <- F.mallocBytes (padSize + ptrOffset + sizeOf nullPtr)-        let alignedPtr = alignPointer align allocPtr-        F.poke (seekPointer size alignedPtr) allocPtr-        return alignedPtr--{- |-> mallocBytes align size--}-mallocBytes :: Storable a => a -> Int -> IO (Ptr a)-mallocBytes a size =-   Debug.traceMalloc a size =<< mallocAligned (alignment a) size--peekMock :: Ptr a -> a-peekMock _ = error "auxiliary object for free functions"--freeAligned :: Int -> Int -> Ptr a -> IO ()-freeAligned align size ptr =-   F.free =<<-   if mod defaultMallocAlign align == 0-     then return ptr-     else F.peek $ seekPointer size ptr--freeBytes :: Storable a => a -> Int -> Ptr a -> IO ()-freeBytes a size ptr = freeAligned (alignment a) size ptr--malloc :: (Storable a) => IO (Ptr a)-malloc =-   case error "auxiliary object for LLVM.Alloc.malloc" of-      mock -> mallocBytes mock (sizeOf mock)--free :: (Storable a) => Ptr a -> IO ()-free ptr =-   freeBytes (peekMock ptr) (sizeOf (peekMock ptr)) ptr---mallocArray :: (Storable a) => Int -> IO (Ptr a)-mallocArray n =-   case error "auxiliary object for LLVM.Alloc.mallocArray" of-      mock -> mallocBytes mock (sizeOfArray n mock)--freeArray :: (Storable a) => Int -> Ptr a -> IO ()-freeArray n ptr =-   freeBytes (peekMock ptr) (sizeOfArray n (peekMock ptr)) ptr
src/Synthesizer/LLVM/Causal/Controlled.hs view
@@ -31,10 +31,10 @@ import qualified LLVM.Extra.Arithmetic as A  import qualified LLVM.Core as LLVM-import LLVM.Core (Value, IsConst, IsSized, )+import LLVM.Core (Value, IsConst)  import qualified Type.Data.Num.Decimal as TypeNum-import Type.Data.Num.Decimal.Number ((:*:), )+import Type.Data.Num.Decimal.Number ((:*:))   {- |@@ -79,9 +79,8 @@    process = Filt2P.causal  instance-   (a ~ SoV.Scalar v, SoV.PseudoModule v, SoV.IntegerConstant a,-    Memory.FirstClass a, IsSized a, IsSized (Memory.Stored a),-    Memory.FirstClass v, IsSized v, IsSized (Memory.Stored v),+   (LLVM.IsSized v, SoV.PseudoModule v, SoV.Scalar v ~ a,+    LLVM.IsSized a, SoV.IntegerConstant a,     TypeNum.Natural n,     TypeNum.Positive (n :*: LLVM.UnknownSize)) =>       C (Cascade.ParameterValue n a) (Value v) (Value v) where
src/Synthesizer/LLVM/Causal/ControlledPacked.hs view
@@ -22,17 +22,16 @@  import qualified LLVM.Extra.Memory as Memory import qualified LLVM.Extra.ScalarOrVector as SoV-import qualified LLVM.Extra.Class as Class+import qualified LLVM.Extra.Tuple as Tuple import qualified LLVM.Extra.Arithmetic as A  import qualified LLVM.Core as LLVM-import LLVM.Util.Loop (Phi, )-import LLVM.Core (IsSized, )+import LLVM.Core (IsSized)  import qualified Type.Data.Num.Decimal as TypeNum-import Type.Data.Num.Decimal.Number ((:*:), )+import Type.Data.Num.Decimal.Number ((:*:)) -import Control.Arrow ((<<<), arr, first, )+import Control.Arrow ((<<<), arr, first)   {- |@@ -74,9 +73,7 @@     Serial.C v, Serial.Element v ~ LLVM.Value a,     SoV.IntegerConstant a,     A.PseudoRing v, A.IntegerConstant v, Memory.C v,-    Memory.FirstClass a, Memory.Stored a ~ am, IsSized a, IsSized am,-    LLVM.IsPrimitive a,-    LLVM.IsPrimitive am,+    LLVM.IsPrimitive a, IsSized a,     TypeNum.Positive (n :*: LLVM.UnknownSize),     TypeNum.Natural n) =>       C (Cascade.ParameterValue n a) v v where@@ -106,7 +103,7 @@   instance-   (Serial.C v, Serial.Element v ~ b, Phi a, Class.Undefined a,+   (Serial.C v, Serial.Element v ~ b, Tuple.Phi a, Tuple.Undefined a,     a ~ A.Scalar b, A.PseudoModule b, A.IntegerConstant a, Memory.C b,     TypeNum.Natural n) =>       C (Moog.Parameter n a) v v where@@ -118,7 +115,7 @@   instance-   (Serial.C v, Serial.Element v ~ b, Phi a, Class.Undefined a,+   (Serial.C v, Serial.Element v ~ b, Tuple.Phi a, Tuple.Undefined a,     a ~ A.Scalar b, A.PseudoModule b, A.IntegerConstant a, Memory.C b) =>       C (UniFilter.Parameter a) v (UniFilter.Result v) where    type Input  (UniFilter.Parameter a) (UniFilter.Result v) = v
src/Synthesizer/LLVM/Causal/Process.hs view
@@ -66,7 +66,6 @@ import qualified Synthesizer.LLVM.Fold as Fold import qualified Synthesizer.LLVM.Frame.Stereo as Stereo import qualified Synthesizer.LLVM.Frame as Frame-import qualified Synthesizer.LLVM.Execution as Exec import qualified Synthesizer.LLVM.ForeignPtr as ForeignPtr  import qualified Synthesizer.Plain.Modifier as Modifier@@ -76,45 +75,44 @@ import qualified Data.StorableVector as SV import qualified Data.StorableVector.Base as SVB +import qualified LLVM.DSL.Execution as Exec+ import qualified LLVM.Extra.Multi.Vector as MultiVector import qualified LLVM.Extra.Multi.Value as MultiValue import qualified LLVM.Extra.Control as C-import qualified LLVM.Extra.Class as Class+import qualified LLVM.Extra.Tuple as Tuple import qualified LLVM.Extra.Arithmetic as A import qualified LLVM.Extra.ScalarOrVector as SoV import qualified LLVM.Extra.MaybeContinuation as MaybeCont import qualified LLVM.Extra.Maybe as Maybe+import qualified LLVM.Extra.Storable as Storable+import qualified LLVM.Extra.Marshal as Marshal import qualified LLVM.Extra.Memory as Memory-import LLVM.Extra.Class (Undefined, MakeValueTuple, ValueTuple, )  import qualified LLVM.Core as LLVM-import LLVM.Util.Loop (Phi, ) import LLVM.Core           (CodeGenFunction, ret, Value, valueOf,            IsConst, IsFirstClass, IsArithmetic, IsPrimitive)  import qualified Type.Data.Num.Decimal as TypeNum-import Type.Base.Proxy (Proxy, )-import Type.Data.Num.Decimal (D2, (:<:), )+import Type.Base.Proxy (Proxy)+import Type.Data.Num.Decimal (D2, (:<:))  import qualified Control.Arrow    as Arr-import Control.Monad.Trans.State (runState, )-import Control.Arrow (arr, (<<<), (>>>), (&&&), )-import Control.Monad (liftM2, )-import Control.Applicative (liftA3, (<$>), )+import Control.Monad.Trans.State (runState)+import Control.Arrow (arr, (<<<), (>>>), (&&&))+import Control.Monad (liftM2)+import Control.Applicative (liftA3, (<$>))  import qualified Data.List as List-import Data.Tuple.HT (swap, )-import Data.Word (Word32, )+import Data.Tuple.HT (swap)+import Data.Word (Word) -import qualified Foreign.Marshal.Utils as AllocUtil-import Foreign.Storable (Storable, )-import Foreign.ForeignPtr (ForeignPtr, withForeignPtr, )-import Foreign.Ptr (Ptr, )-import Control.Exception (bracket, )+import Foreign.Ptr (Ptr)+import Control.Exception (bracket) import qualified System.Unsafe as Unsafe -import Prelude hiding (and, map, zip, zipWith, init, takeWhile, )+import Prelude hiding (and, map, zip, zipWith, init, takeWhile)   @@ -145,11 +143,11 @@ feedSnd :: Sig.T a -> T b (b,a) feedSnd = CausalClass.feedSnd -feedConstFst :: (MakeValueTuple a, ValueTuple a ~ al) => a -> T b (al,b)-feedConstFst = CausalClass.feedConstFst . Class.valueTupleOf+feedConstFst :: (Tuple.Value a, Tuple.ValueOf a ~ al) => a -> T b (al,b)+feedConstFst = CausalClass.feedConstFst . Tuple.valueOf -feedConstSnd :: (MakeValueTuple a, ValueTuple a ~ al) => a -> T b (b,al)-feedConstSnd = CausalClass.feedConstSnd . Class.valueTupleOf+feedConstSnd :: (Tuple.Value a, Tuple.ValueOf a ~ al) => a -> T b (b,al)+feedConstSnd = CausalClass.feedConstSnd . Tuple.valueOf   applyFst :: T (a,b) c -> Sig.T a -> T b c@@ -159,22 +157,22 @@ applySnd = CausalClass.applySnd  applyConst ::-   (MakeValueTuple a, ValueTuple a ~ al) =>+   (Tuple.Value a, Tuple.ValueOf a ~ al) =>    T al b -> a -> Sig.T b applyConst proc =-   CausalClass.applyConst proc . Class.valueTupleOf+   CausalClass.applyConst proc . Tuple.valueOf  applyConstFst ::-   (MakeValueTuple a, ValueTuple a ~ al) =>+   (Tuple.Value a, Tuple.ValueOf a ~ al) =>    T (al,b) c -> a -> T b c applyConstFst proc =-   CausalClass.applyConstFst proc . Class.valueTupleOf+   CausalClass.applyConstFst proc . Tuple.valueOf  applyConstSnd ::-   (MakeValueTuple b, ValueTuple b ~ bl) =>+   (Tuple.Value b, Tuple.ValueOf b ~ bl) =>    T (a,bl) c -> b -> T a c applyConstSnd proc =-   CausalClass.applyConstSnd proc . Class.valueTupleOf+   CausalClass.applyConstSnd proc . Tuple.valueOf   infixl 0 $<#, $>#, $*#@@ -184,19 +182,19 @@ -} ($*#) ::    (C process, CausalClass.SignalOf process ~ signal,-    MakeValueTuple ah, ValueTuple ah ~ a) =>+    Tuple.Value ah, Tuple.ValueOf ah ~ a) =>    process a b -> ah -> signal b-proc $*# x = CausalClass.applyConst proc $ Class.valueTupleOf x+proc $*# x = CausalClass.applyConst proc $ Tuple.valueOf x  ($<#) ::-   (C process, MakeValueTuple ah, ValueTuple ah ~ a) =>+   (C process, Tuple.Value ah, Tuple.ValueOf ah ~ a) =>    process (a,b) c -> ah -> process b c-proc $<# x = CausalClass.applyConstFst proc $ Class.valueTupleOf x+proc $<# x = CausalClass.applyConstFst proc $ Tuple.valueOf x  ($>#) ::-   (C process, MakeValueTuple bh, ValueTuple bh ~ b) =>+   (C process, Tuple.Value bh, Tuple.ValueOf bh ~ b) =>    process (a,b) c -> bh -> process a c-proc $># x = CausalClass.applyConstSnd proc $ Class.valueTupleOf x+proc $># x = CausalClass.applyConstSnd proc $ Tuple.valueOf x   @@ -294,7 +292,7 @@     TypeNum.Positive n, MultiVector.C x,     v ~ MultiVector.T n x,     a ~ MultiValue.T x,-    Class.Zero v, Memory.C v) =>+    Tuple.Zero v, Memory.C v) =>    process v v -> process a a pipeline vectorProcess =    loopConst MultiVector.zero $@@ -340,7 +338,7 @@    withSize $ \n ->       foldl          (\acc i -> replaceChannel i proc acc)-         (arr (const $ Class.undefTuple)) $+         (arr (const $ Tuple.undef)) $       List.take (TypeNum.integralFromSingleton n) [0 ..]  withSize ::@@ -450,8 +448,8 @@ -} skip ::    (C process, CausalClass.SignalOf process ~ signal,-    Undefined a, Phi a, Memory.C a) =>-   signal a -> process (Value Word32) a+    Tuple.Undefined a, Tuple.Phi a, Memory.C a) =>+   signal a -> process (Value Word) a skip =    alterSignal       (\(Sig.Core next start stop) -> Core@@ -461,7 +459,7 @@                MaybeCont.fixedLengthLoop n0 yState0 $                next context . snd             return (y, (yState1,n1)))-         (fmap (\s -> ((Class.undefTuple, s), A.one)) . start)+         (fmap (\s -> ((Tuple.undef, s), A.one)) . start)          (\((_y,state),_k) -> stop state))  {- |@@ -472,8 +470,8 @@ A trailing incomplete chunk will be ignored. -} foldChunks ::-   (C process, CausalClass.SignalOf process ~ signal, Undefined b, Phi b) =>-   Fold.T a b -> signal a -> process (Value Word32) b+   (C process, CausalClass.SignalOf process ~ signal, Tuple.Undefined b, Tuple.Phi b) =>+   Fold.T a b -> signal a -> process (Value Word) b foldChunks (Fold.Cons accum initial) =    alterSignal       (\(Sig.Core next start stop) -> Core@@ -492,8 +490,8 @@ -} foldChunksPartial ::    (C process, CausalClass.SignalOf process ~ signal,-    Undefined a, Phi a, Undefined b, Phi b) =>-   Fold.T a b -> signal a -> process (Value Word32) b+    Tuple.Undefined a, Tuple.Phi a, Tuple.Undefined b, Tuple.Phi b) =>+   Fold.T a b -> signal a -> process (Value Word) b foldChunksPartial (Fold.Cons accum initial) =    alterSignal       (\(Sig.Core next start stop) -> Core@@ -522,9 +520,8 @@ frequencyModulation ::    (C process, CausalClass.SignalOf process ~ signal,     SoV.IntegerConstant a, LLVM.IsFloating a,-    LLVM.CmpRet a, LLVM.CmpResult a ~ Bool,-    Memory.FirstClass a, Memory.Stored a ~ am, LLVM.IsSized am,-    Undefined nodes, Phi nodes, Memory.C nodes) =>+    LLVM.CmpRet a, LLVM.CmpResult a ~ Bool, LLVM.IsSized a,+    Tuple.Undefined nodes, Tuple.Phi nodes, Memory.C nodes) =>    (forall r. Value a -> nodes -> CodeGenFunction r v) ->    signal nodes -> process (Value a) v frequencyModulation ip =@@ -545,7 +542,7 @@             y <- ip ss2 nodes2             ss3 <- A.add ss2 k             return (y, ((nodes2, state2), ss3)))-      (fmap (\sa -> ((Class.undefTuple, sa), A.one)) . start)+      (fmap (\sa -> ((Tuple.undef, sa), A.one)) . start)       (\((_y01,state),_ss) -> stop state))  @@ -554,9 +551,7 @@ -} interpolateConstant ::    (C process, CausalClass.SignalOf process ~ signal,-    Memory.C a,-    Memory.FirstClass b, Memory.Stored b ~ bm, LLVM.IsSized bm,-    SoV.IntegerConstant b,+    Memory.C a, LLVM.IsSized b, SoV.IntegerConstant b,     LLVM.IsFloating b, LLVM.CmpRet b, LLVM.CmpResult b ~ Bool) =>    signal a -> process (Value b) a interpolateConstant xs =@@ -566,8 +561,7 @@ quantizeLift ::    (C process, Memory.C b,     SoV.IntegerConstant c, LLVM.IsFloating c,-    LLVM.CmpRet c, LLVM.CmpResult c ~ Bool,-    Memory.FirstClass c, Memory.Stored c ~ cm, LLVM.IsSized cm) =>+    LLVM.CmpRet c, LLVM.CmpResult c ~ Bool, LLVM.IsSized c) =>    process a b ->    process (Value c, a) b quantizeLift = alter (\(Core next start stop) -> Core@@ -592,101 +586,100 @@ -}    (\p -> do       s <- start p-      return ((Class.undefTuple, s), A.zero))+      return ((Tuple.undef, s), A.zero))    (\((_, s), _) -> stop s))    foreign import ccall safe "dynamic" derefFillPtr ::    Exec.Importer-      (Ptr paramStruct -> Word32 -> Ptr aStruct -> Ptr bStruct -> IO Word32)+      (LLVM.Ptr paramStruct -> Word -> Ptr a -> Ptr b -> IO Word)   compile ::-   (Memory.C aValue, Memory.Struct aValue ~ aStruct,-    Memory.C bValue, Memory.Struct bValue ~ bStruct,+   (Storable.C a, Tuple.ValueOf a ~ aValue,+    Storable.C b, Tuple.ValueOf b ~ bValue,     Memory.C param, Memory.Struct param ~ paramStruct,-    Phi state, Undefined state) =>-   (forall r z. (Phi z) =>+    Tuple.Phi state, Tuple.Undefined state) =>+   (forall r z. (Tuple.Phi z) =>     param -> local -> aValue -> state -> MaybeCont.T r z (bValue, state)) ->    (forall r. CodeGenFunction r local) ->    (forall r. param -> CodeGenFunction r state) ->-   IO (Ptr paramStruct -> Word32 -> Ptr aStruct -> Ptr bStruct -> IO Word32)+   IO (LLVM.Ptr paramStruct -> Word -> Ptr a -> Ptr b -> IO Word) compile next alloca start =-   Exec.compileModule $+   Exec.compile "causal" $       Exec.createFunction derefFillPtr "fillprocessblock" $          \ paramPtr size alPtr blPtr -> do             param <- Memory.load paramPtr             s <- start param             local <- alloca-            (pos,_) <- MaybeCont.arrayLoop2 size alPtr blPtr s $+            (pos,_) <-+               Storable.arrayLoopMaybeCont2 size alPtr blPtr s $                   \ aPtri bPtri s0 -> do-               a <- MaybeCont.lift $ Memory.load aPtri+               a <- MaybeCont.lift $ Storable.load aPtri                (b,s1) <- next param local a s0-               MaybeCont.lift $ Memory.store b bPtri+               MaybeCont.lift $ Storable.store b bPtri                return s1             ret pos   applyStorable ::-   (Storable a, MakeValueTuple a, ValueTuple a ~ valueA, Memory.C valueA,-    Storable b, MakeValueTuple b, ValueTuple b ~ valueB, Memory.C valueB) =>+   (Storable.C a, Tuple.ValueOf a ~ valueA,+    Storable.C b, Tuple.ValueOf b ~ valueB) =>    T valueA valueB -> SV.Vector a -> SV.Vector b applyStorable proc = Unsafe.performIO $ runStorable proc  runStorable ::-   (Storable a, MakeValueTuple a, ValueTuple a ~ valueA, Memory.C valueA,-    Storable b, MakeValueTuple b, ValueTuple b ~ valueB, Memory.C valueB) =>+   (Storable.C a, Tuple.ValueOf a ~ valueA,+    Storable.C b, Tuple.ValueOf b ~ valueB) =>    T valueA valueB -> IO (SV.Vector a -> SV.Vector b) runStorable proc = (Unsafe.performIO .) <$> runStorableIO proc  runStorableIO ::-   (Storable a, MakeValueTuple a, ValueTuple a ~ valueA, Memory.C valueA,-    Storable b, MakeValueTuple b, ValueTuple b ~ valueB, Memory.C valueB) =>+   (Storable.C a, Tuple.ValueOf a ~ valueA,+    Storable.C b, Tuple.ValueOf b ~ valueB) =>    T valueA valueB -> IO (SV.Vector a -> IO (SV.Vector b))-runStorableIO (Cons next alloca start createIOContext deleteIOContext) = do+runStorableIO+      (Cons next alloca start createIOContext deleteIOContext) = do+    fill <- compile next alloca start    return $ \as ->       bracket createIOContext (deleteIOContext . fst) $ \ (_ioContext, params) ->          SVB.withStartPtr as $ \ aPtr len ->          SVB.createAndTrim len $ \ bPtr ->-         AllocUtil.with params $ \paramPtr ->-            fmap (fromIntegral :: Word32 -> Int) $-            fill-               (Memory.castTuplePtr paramPtr)-               (fromIntegral len)-               (Memory.castTuplePtr aPtr)-               (Memory.castTuplePtr bPtr)+         Marshal.with params $ \paramPtr ->+            fmap (fromIntegral :: Word -> Int) $+            fill paramPtr (fromIntegral len) aPtr bPtr   foreign import ccall safe "dynamic" derefStartPtr ::-   Exec.Importer (Ptr b -> IO (Ptr a))+   Exec.Importer (LLVM.Ptr b -> IO (LLVM.Ptr a))  foreign import ccall safe "dynamic" derefStopPtr ::-   Exec.Importer (Ptr a -> IO ())+   Exec.Importer (LLVM.Ptr a -> IO ())  foreign import ccall safe "dynamic" derefChunkPtr ::    Exec.Importer-      (Ptr paramStruct -> Ptr stateStruct -> Word32 ->-       Ptr aStruct -> Ptr bStruct -> IO Word32)+      (LLVM.Ptr paramStruct -> LLVM.Ptr stateStruct -> Word ->+       Ptr a -> Ptr b -> IO Word)   compileChunky ::-   (Memory.C aValue, Memory.Struct aValue ~ aStruct,-    Memory.C bValue, Memory.Struct bValue ~ bStruct,+   (Storable.C a, Tuple.ValueOf a ~ aValue,+    Storable.C b, Tuple.ValueOf b ~ bValue,     Memory.C param, Memory.Struct param ~ paramStruct,     Memory.C state, Memory.Struct state ~ stateStruct) =>-   (forall r z. (Phi z) =>+   (forall r z. (Tuple.Phi z) =>     param -> local -> aValue -> state -> MaybeCont.T r z (bValue, state)) ->    (forall r. CodeGenFunction r local) ->    (forall r.     param -> CodeGenFunction r state) ->-   IO (Ptr paramStruct -> IO (Ptr stateStruct),+   IO (LLVM.Ptr paramStruct -> IO (LLVM.Ptr stateStruct),        Exec.Finalizer stateStruct,-       Ptr paramStruct -> Ptr stateStruct ->-       Word32 -> Ptr aStruct -> Ptr bStruct -> IO Word32)+       LLVM.Ptr paramStruct -> LLVM.Ptr stateStruct ->+       Word -> Ptr a -> Ptr b -> IO Word) compileChunky next alloca start =-   Exec.compileModule $+   Exec.compile "causal-chunky" $       liftA3 (,,)          (Exec.createFunction derefStartPtr "startprocess" $           \paramPtr -> do@@ -701,28 +694,23 @@              sInit <- Memory.load sptr              param <- Memory.load paramPtr              local <- alloca-             (pos,sExit) <- MaybeCont.arrayLoop2 loopLen aPtr bPtr sInit $+             (pos,sExit) <-+                Storable.arrayLoopMaybeCont2 loopLen aPtr bPtr sInit $                    \ aPtri bPtri s0 -> do-                a <- MaybeCont.lift $ Memory.load aPtri+                a <- MaybeCont.lift $ Storable.load aPtri                 (b,s1) <- next param local a s0-                MaybeCont.lift $ Memory.store b bPtri+                MaybeCont.lift $ Storable.store b bPtri                 return s1              Memory.store (Maybe.fromJust sExit) sptr              ret pos)   traverseChunks ::-   (ValueTuple a ~ aValue, Memory.C aValue, Memory.Struct aValue ~ aStruct,-    ValueTuple b ~ bValue, Memory.C bValue, Memory.Struct bValue ~ bStruct,-    ValueTuple parameters ~ paramValue,-    Memory.C paramValue, Memory.Struct paramValue ~ paramStruct,-    Storable a, MakeValueTuple a,-    Storable b, MakeValueTuple b,-    Storable parameters, MakeValueTuple parameters) =>-   (Ptr paramStruct -> Ptr stateStruct ->-    Word32 -> Ptr aStruct -> Ptr bStruct -> IO Word32) ->-   ForeignPtr parameters ->-   ForeignPtr stateStruct ->+   (Storable.C a, Storable.C b) =>+   (LLVM.Ptr paramStruct -> LLVM.Ptr stateStruct ->+    Word -> Ptr a -> Ptr b -> IO Word) ->+   ForeignPtr.MemoryPtr paramStruct ->+   ForeignPtr.MemoryPtr stateStruct ->    SVL.Vector a -> IO [SVB.Vector b] traverseChunks fill paramFPtr statePtr =    let go xt =@@ -732,12 +720,10 @@              x:xs -> SVB.withStartPtr x $ \aPtr size -> do                 v <-                    ForeignPtr.with paramFPtr $ \paramPtr ->-                   withForeignPtr statePtr $ \sptr ->+                   ForeignPtr.with statePtr $ \sptr ->                    SVB.createAndTrim size $-                      fmap (fromIntegral :: Word32 -> Int) .-                      fill paramPtr sptr (fromIntegral size)-                         (Memory.castTuplePtr aPtr) .-                      Memory.castTuplePtr+                      fmap (fromIntegral :: Word -> Int) .+                      fill paramPtr sptr (fromIntegral size) aPtr                 (if SV.length v > 0                    then fmap (v:)                    else id) $@@ -748,21 +734,23 @@   runStorableChunky ::-   (Storable a, MakeValueTuple a, ValueTuple a ~ valueA, Memory.C valueA,-    Storable b, MakeValueTuple b, ValueTuple b ~ valueB, Memory.C valueB) =>+   (Storable.C a, Tuple.ValueOf a ~ valueA,+    Storable.C b, Tuple.ValueOf b ~ valueB) =>    T valueA valueB -> IO (SVL.Vector a -> SVL.Vector b)-runStorableChunky (Cons next alloca start createIOContext deleteIOContext) = do+runStorableChunky+      (Cons next alloca start createIOContext deleteIOContext) = do+    (startFunc, stopFunc, fill) <- compileChunky next alloca start    return $ \sig -> SVL.fromChunks $ Unsafe.performIO $ do       (ioContext, params) <- createIOContext       paramPtr <- ForeignPtr.new (deleteIOContext ioContext) params       statePtr <--         ForeignPtr.newInit stopFunc (ForeignPtr.with paramPtr startFunc)+         ForeignPtr.newInit stopFunc $ ForeignPtr.with paramPtr startFunc       traverseChunks fill paramPtr statePtr sig   applyStorableChunky ::-   (Storable a, MakeValueTuple a, ValueTuple a ~ valueA, Memory.C valueA,-    Storable b, MakeValueTuple b, ValueTuple b ~ valueB, Memory.C valueB) =>+   (Storable.C a, Tuple.ValueOf a ~ valueA,+    Storable.C b, Tuple.ValueOf b ~ valueB) =>    T valueA valueB -> SVL.Vector a -> SVL.Vector b applyStorableChunky = Unsafe.performIO . runStorableChunky
src/Synthesizer/LLVM/Causal/ProcessPacked.hs view
@@ -5,7 +5,7 @@ module Synthesizer.LLVM.Causal.ProcessPacked where  import qualified Synthesizer.LLVM.Causal.Process as Causal-import Synthesizer.LLVM.Causal.ProcessPrivate (Core(Core), alter, )+import Synthesizer.LLVM.Causal.ProcessPrivate (Core(Core), alter)  import qualified Synthesizer.LLVM.Frame.SerialVector as Serial @@ -13,25 +13,25 @@ import qualified LLVM.Extra.Vector as Vector import qualified LLVM.Extra.MaybeContinuation as Maybe import qualified LLVM.Extra.Memory as Memory-import qualified LLVM.Extra.Class as Class+import qualified LLVM.Extra.Tuple as Tuple import qualified LLVM.Extra.Arithmetic as A import qualified LLVM.Extra.Control as C  import qualified LLVM.Core as LLVM import LLVM.Core           (CodeGenFunction, Value, valueOf,-           IsSized, IsFirstClass, )+           IsSized, IsFirstClass)  import qualified Type.Data.Num.Decimal as TypeNum-import Type.Data.Num.Decimal ((:<:), )-import Type.Base.Proxy (Proxy, )+import Type.Data.Num.Decimal ((:<:))+import Type.Base.Proxy (Proxy)  import qualified Control.Monad.Trans.Class as MT import qualified Control.Monad.Trans.State as MS import qualified Control.Arrow as Arr-import Control.Arrow ((<<<), )+import Control.Arrow ((<<<)) -import Data.Word (Word32, )+import Data.Word (Word)  import NumericPrelude.Numeric import NumericPrelude.Base@@ -54,9 +54,9 @@          Maybe.fromBool $          C.whileLoop             (valueOf True,-             let w = Class.undefTuple+             let w = Tuple.undef              in  ((r,w),-                  (valueOf (fromIntegral $ Serial.sizeOfIterator w :: Word32), s)))+                  (valueOf (fromIntegral $ Serial.sizeOfIterator w :: Word), s)))             (\(cont,(_rw0,(i0,_s0))) ->                A.and cont =<<                   A.cmp LLVM.CmpGT i0 A.zero)@@ -129,14 +129,13 @@    (\s -> do       s1 <- start s       w <- Serial.writeZero-      return ((w, Class.undefTuple), (valueOf (0::Word32), s1)))+      return ((w, Tuple.undef), (valueOf (0::Word), s1)))    (\(_wr,(_i,state)) -> stop state))   osciCore ::    (Causal.C process,-    Memory.FirstClass t, Memory.Stored t ~ tm, IsSized tm,-    Vector.Real t, SoV.Fraction t, LLVM.IsFloating t,+    IsSized t, Vector.Real t, SoV.Fraction t, LLVM.IsFloating t,     TypeNum.Positive n) =>    process (Serial.Value n t, Serial.Value n t) (Serial.Value n t) osciCore =@@ -151,8 +150,7 @@  osci ::    (Causal.C process,-    Memory.FirstClass t, Memory.Stored t ~ tm, IsSized tm,-    Vector.Real t, SoV.Fraction t, LLVM.IsFloating t,+    IsSized t, Vector.Real t, SoV.Fraction t, LLVM.IsFloating t,     TypeNum.Positive n) =>    (forall r. Serial.Value n t -> CodeGenFunction r y) ->    process (Serial.Value n t, Serial.Value n t) y@@ -161,8 +159,7 @@  shapeModOsci ::    (Causal.C process,-    Memory.FirstClass t, Memory.Stored t ~ tm, IsSized tm,-    Vector.Real t, SoV.Fraction t, LLVM.IsFloating t,+    IsSized t, Vector.Real t, SoV.Fraction t, LLVM.IsFloating t,     TypeNum.Positive n) =>    (forall r. c -> Serial.Value n t -> CodeGenFunction r y) ->    process (c, (Serial.Value n t, Serial.Value n t)) y
src/Synthesizer/LLVM/Causal/ProcessPrivate.hs view
@@ -8,24 +8,22 @@ import qualified Synthesizer.Causal.Class as CausalClass import qualified Synthesizer.Causal.Utility as ArrowUtil +import qualified LLVM.Extra.Tuple as Tuple import qualified LLVM.Extra.Arithmetic as A import qualified LLVM.Extra.MaybeContinuation as MaybeCont+import qualified LLVM.Extra.Marshal as Marshal import qualified LLVM.Extra.Memory as Memory-import LLVM.Extra.Class (Undefined, MakeValueTuple, ValueTuple, ) -import LLVM.Util.Loop (Phi, )-import LLVM.Core (CodeGenFunction, Value, )--import Foreign.Storable (Storable, )+import LLVM.Core (CodeGenFunction, Value) -import System.Random (Random, RandomGen, randomR, )+import System.Random (Random, RandomGen, randomR)  import qualified Control.Arrow    as Arr import qualified Control.Category as Cat import qualified Control.Monad.Trans.State as MS-import Control.Arrow (Arrow, arr, (<<<), (>>>), (&&&), )-import Control.Monad (liftM2, replicateM, )-import Control.Applicative (Applicative, pure, (<*>), )+import Control.Arrow (Arrow, arr, (<<<), (>>>), (&&&))+import Control.Monad (liftM2, replicateM)+import Control.Applicative (Applicative, pure, (<*>))  import qualified Number.Ratio as Ratio import qualified Algebra.Field as Field@@ -33,7 +31,7 @@ import qualified Algebra.Additive as Additive  import NumericPrelude.Numeric-import NumericPrelude.Base hiding (and, map, zip, zipWith, init, )+import NumericPrelude.Base hiding (and, map, zip, zipWith, init)  import qualified Prelude as P @@ -42,7 +40,7 @@    forall state.       (Memory.C state) =>       Core (forall r c.-            (Phi c) =>+            (Tuple.Phi c) =>             context ->             a -> state -> MaybeCont.T r c (b, state))                -- compute next value@@ -60,7 +58,7 @@    simple ::       (Memory.C state) =>       (forall r c.-       (Phi c) =>+       (Tuple.Phi c) =>        a -> state -> MaybeCont.T r c (b, state)) ->       (forall r. CodeGenFunction r state) ->       process a b@@ -72,7 +70,7 @@       process a0 b0 -> process a1 b1     replicateControlled ::-      (Undefined x, Phi x) =>+      (Tuple.Undefined x, Tuple.Phi x) =>       Int -> process (c,x) x -> process (c,x) x  @@ -91,20 +89,17 @@  data T a b =    forall state local ioContext parameters.-      (Storable parameters,-       MakeValueTuple parameters,-       Memory.C (ValueTuple parameters),-       Memory.C state) =>+      (Marshal.C parameters, Memory.C state) =>       Cons (forall r c.-            (Phi c) =>-            ValueTuple parameters -> local ->+            (Tuple.Phi c) =>+            Tuple.ValueOf parameters -> local ->             a -> state -> MaybeCont.T r c (b, state))                -- compute next value            (forall r.             CodeGenFunction r local)                -- allocate temporary variables before a loop            (forall r.-            ValueTuple parameters ->+            Tuple.ValueOf parameters ->             CodeGenFunction r state)                -- initial state            (IO (ioContext, parameters))
src/Synthesizer/LLVM/Causal/ProcessValue.hs view
@@ -15,8 +15,6 @@ import qualified LLVM.Extra.Memory as Memory import qualified LLVM.Core as LLVM -import Foreign.Storable.Tuple ()- import Prelude (Bool)
src/Synthesizer/LLVM/CausalParameterized/Controlled.hs view
@@ -15,25 +15,24 @@ import qualified Synthesizer.LLVM.CausalParameterized.Process as CausalP import qualified Synthesizer.LLVM.Causal.Controlled as Ctrl import qualified Synthesizer.LLVM.Parameterized.Signal as SigP-import qualified Synthesizer.LLVM.Parameter as Param +import qualified LLVM.DSL.Parameter as Param++import qualified LLVM.Extra.Tuple as Tuple+import qualified LLVM.Extra.Marshal as Marshal import qualified LLVM.Extra.Memory as Memory import qualified LLVM.Extra.ScalarOrVector as SoV-import LLVM.Extra.Class (MakeValueTuple, ValueTuple, )  import qualified LLVM.Core as LLVM-import LLVM.Core (Value, IsFloating, IsSized, )--import Foreign.Storable (Storable, )+import LLVM.Core (Value, IsFloating)   processCtrlRate ::    (Ctrl.C parameter a b,     Memory.C parameter,-    Memory.FirstClass r, IsSized (Memory.Stored r),-    IsFloating r, Storable r, SoV.IntegerConstant r,-    MakeValueTuple r, ValueTuple r ~ (Value r),-    LLVM.CmpRet r, LLVM.CmpResult r ~ Bool) =>+    Marshal.C r, Tuple.ValueOf r ~ Value r,+    IsFloating r, SoV.IntegerConstant r,+    LLVM.CmpRet r, LLVM.IsPrimitive r) =>    Param.T p r ->    (Param.T p r -> SigP.T p parameter) ->    CausalP.T p a b
src/Synthesizer/LLVM/CausalParameterized/ControlledPacked.hs view
@@ -12,17 +12,17 @@ import qualified Synthesizer.LLVM.CausalParameterized.Process as CausalP import qualified Synthesizer.LLVM.Causal.ControlledPacked as CtrlS import qualified Synthesizer.LLVM.Parameterized.Signal as SigP-import qualified Synthesizer.LLVM.Parameter as Param import qualified Synthesizer.LLVM.Frame.SerialVector as Serial +import qualified LLVM.DSL.Parameter as Param++import qualified LLVM.Extra.Tuple as Tuple+import qualified LLVM.Extra.Marshal as Marshal import qualified LLVM.Extra.Memory as Memory import qualified LLVM.Extra.ScalarOrVector as SoV-import LLVM.Extra.Class (MakeValueTuple, ValueTuple, )  import qualified LLVM.Core as LLVM-import LLVM.Core (Value, IsFloating, IsSized, )--import Foreign.Storable (Storable, )+import LLVM.Core (Value, IsFloating)  import qualified Algebra.Field as Field @@ -36,10 +36,8 @@     Serial.Read av, n ~ Serial.Size av,     Serial.C    bv, n ~ Serial.Size bv,     Memory.C parameter,-    Field.C r, Storable r, IsFloating r, SoV.IntegerConstant r,-    Memory.FirstClass r, Memory.Stored r ~ rm, IsSized r, IsSized rm,-    MakeValueTuple r, ValueTuple r ~ (Value r),-    LLVM.CmpRet r, LLVM.CmpResult r ~ Bool) =>+    Marshal.C r, Field.C r, IsFloating r, SoV.IntegerConstant r,+    Tuple.ValueOf r ~ Value r, LLVM.CmpRet r, LLVM.IsPrimitive r) =>    Param.T p r ->    (Param.T p r -> SigP.T p parameter) ->    CausalP.T p av bv
src/Synthesizer/LLVM/CausalParameterized/Functional.hs view
@@ -31,13 +31,13 @@ import qualified Synthesizer.LLVM.Frame.SerialVector as Serial import qualified Synthesizer.LLVM.Frame.Stereo as Stereo +import qualified LLVM.Extra.Tuple as Tuple import qualified LLVM.Extra.MaybeContinuation as Maybe+import qualified LLVM.Extra.Marshal as Marshal import qualified LLVM.Extra.Memory as Memory import qualified LLVM.Extra.Arithmetic as A -import LLVM.Extra.Class (MakeValueTuple, ValueTuple, )-import LLVM.Util.Loop (Phi, )-import LLVM.Core (CodeGenFunction, )+import LLVM.Core (CodeGenFunction) import qualified LLVM.Core as LLVM  import qualified Number.Ratio as Ratio@@ -49,22 +49,20 @@  import qualified Control.Monad.Trans.State as State import qualified Control.Monad.Trans.Class as Trans-import Control.Monad.Trans.State (StateT, )+import Control.Monad.Trans.State (StateT)  import qualified Data.Vault.Lazy as Vault-import Data.Vault.Lazy (Vault, )+import Data.Vault.Lazy (Vault) import qualified Control.Category as Cat-import Control.Arrow (Arrow, (>>^), (&&&), arr, first, )-import Control.Category (Category, (.), )-import Control.Applicative (Applicative, (<*>), pure, liftA2, )--import Foreign.Storable (Storable, )+import Control.Arrow (Arrow, (>>^), (&&&), arr, first)+import Control.Category (Category, (.))+import Control.Applicative (Applicative, (<*>), pure, liftA2) -import Data.Tuple.HT (fst3, snd3, thd3, )+import Data.Tuple.HT (fst3, snd3, thd3)  import qualified System.Unsafe as Unsafe -import Prelude hiding ((.), )+import Prelude hiding ((.))   newtype T p inp out = Cons (Code p inp out)@@ -73,14 +71,12 @@ -- | similar to @CausalP.T p a b@ data Code p a b =    forall context local state ioContext parameters.-      (Storable parameters,-       MakeValueTuple parameters,-       Memory.C (ValueTuple parameters),+      (Marshal.C parameters,        Memory.C context,        Memory.C state) =>    Code       (forall r c.-       (Phi c) =>+       (Tuple.Phi c) =>        context -> local -> a -> state ->        StateT Vault (Maybe.T r c) (b, state))           -- compute next value@@ -88,7 +84,7 @@        CodeGenFunction r local)           -- allocate temporary variables before a loop       (forall r.-       ValueTuple parameters ->+       Tuple.ValueOf parameters ->        CodeGenFunction r (context, state))           -- initial state       (forall r.@@ -366,7 +362,7 @@ withGroundArgs f = withId $ f . makeGroundArgs  -data Ground f a = Ground (f a)+newtype Ground f a = Ground (f a)   type family GroundArguments args
src/Synthesizer/LLVM/CausalParameterized/FunctionalPlug.hs view
@@ -25,7 +25,7 @@ import qualified Data.StorableVector as SV  import qualified LLVM.Extra.Arithmetic as A-import LLVM.Core (CodeGenFunction, )+import LLVM.Core (CodeGenFunction)  import qualified Number.Ratio as Ratio import qualified Algebra.Transcendental as Trans@@ -39,17 +39,17 @@  import qualified Data.Set as Set import qualified Data.Vault.Lazy as Vault-import Data.Vault.Lazy (Vault, )-import Data.Unique (Unique, newUnique, )-import Data.Maybe (fromMaybe, )+import Data.Vault.Lazy (Vault)+import Data.Unique (Unique, newUnique)+import Data.Maybe (fromMaybe) -import Control.Arrow ((^<<), (<<^), arr, first, second, )-import Control.Category (id, (.), )-import Control.Applicative (Applicative, (<*>), pure, liftA2, liftA3, )+import Control.Arrow ((^<<), (<<^), arr, first, second)+import Control.Category (id, (.))+import Control.Applicative (Applicative, (<*>), pure, liftA2, liftA3)  import qualified System.Unsafe as Unsafe -import Prelude hiding (id, (.), )+import Prelude hiding (id, (.))   {- |
src/Synthesizer/LLVM/CausalParameterized/Helix.hs view
@@ -30,43 +30,45 @@ import qualified Synthesizer.LLVM.Frame.SerialVector as Serial import qualified Synthesizer.LLVM.Simple.Value as Value import qualified Synthesizer.LLVM.Interpolation as Ip-import qualified Synthesizer.LLVM.Parameter as Param-import Synthesizer.LLVM.CausalParameterized.Functional (($&), (&|&), )-import Synthesizer.LLVM.CausalParameterized.Process (($*), ($<), )-import Synthesizer.LLVM.Simple.Value ((%>), (%>=), (?), (??), )+import Synthesizer.LLVM.CausalParameterized.Functional (($&), (&|&))+import Synthesizer.LLVM.CausalParameterized.Process (($*), ($<))+import Synthesizer.LLVM.Simple.Value ((%>), (%>=), (?), (??))  import qualified Synthesizer.LLVM.Storable.Vector as SVU import qualified Data.StorableVector as SV +import qualified LLVM.DSL.Parameter as Param+ import qualified LLVM.Extra.ScalarOrVector as SoV import qualified LLVM.Extra.Vector as Vector import qualified LLVM.Extra.Arithmetic as A+import qualified LLVM.Extra.Storable as Storable+import qualified LLVM.Extra.Marshal as Marshal import qualified LLVM.Extra.Memory as Memory+import qualified LLVM.Extra.Tuple as Tuple import qualified LLVM.Extra.MaybeContinuation as MaybeCont-import LLVM.Extra.Class (MakeValueTuple, ValueTuple, )  import qualified LLVM.Core as LLVM-import LLVM.Core (CodeGenFunction, Value, IsSized, IsFloating, )+import LLVM.Core (CodeGenFunction, Value, IsSized, IsFloating)  import qualified Type.Data.Num.Decimal as TypeNum -import Data.Word (Word32, )+import Data.Word (Word) -import Foreign.ForeignPtr (touchForeignPtr, )-import Foreign.Storable (Storable, )+import Foreign.ForeignPtr (touchForeignPtr) -import Control.Arrow (first, (<<<), (^<<), (<<^), )-import Control.Category (id, )-import Control.Applicative (liftA2, )-import Control.Functor.HT (unzip, )-import Data.Traversable (mapM, )-import Data.Tuple.HT (mapFst, )+import Control.Arrow (first, (<<<), (^<<), (<<^))+import Control.Category (id)+import Control.Applicative (liftA2)+import Control.Functor.HT (unzip)+import Data.Traversable (mapM)+import Data.Tuple.HT (mapFst)  import qualified Algebra.Field as Field import qualified Algebra.Ring as Ring -import NumericPrelude.Numeric hiding (splitFraction, )-import NumericPrelude.Base hiding (unzip, zip, mapM, id, )+import NumericPrelude.Numeric hiding (splitFraction)+import NumericPrelude.Base hiding (unzip, zip, mapM, id)  import Prelude () @@ -80,12 +82,10 @@ since the right boundary of the interval of admissible @shape@ values is open. -} static ::-   (Storable vh, MakeValueTuple vh, ValueTuple vh ~ v, Memory.C v,+   (Storable.C vh, Tuple.ValueOf vh ~ v,     Ip.C nodesStep, Ip.C nodesLeap,     SoV.RationalConstant a, SoV.Fraction a,-    Storable a, MakeValueTuple a, ValueTuple a ~ Value a,-    Memory.FirstClass a, Memory.Stored a ~ am, IsSized am,-    LLVM.ShapeOf a ~ LLVM.ScalarShape) =>+    Marshal.C a, Tuple.ValueOf a ~ Value a, LLVM.IsPrimitive a) =>    (forall r. Ip.T r nodesLeap (Value a) v) ->    (forall r. Ip.T r nodesStep (Value a) v) ->    Param.T p Int ->@@ -93,7 +93,7 @@    Param.T p (SV.Vector vh) ->    CausalP.T p (Value a, Value a) v static ipLeap ipStep periodInt period vec =-   let period32 = Param.word32 periodInt+   let period32 = Param.wordInt periodInt        cellMargin = combineMarginParams ipLeap ipStep periodInt    in  interpolateCell ipLeap ipStep        <<<@@ -103,12 +103,11 @@        <<<        first           (limitShape cellMargin period32-              (Param.word32 $ fmap SV.length vec))+              (Param.wordInt $ fmap SV.length vec))   staticPacked ::-   (Storable vh, MakeValueTuple vh, ValueTuple vh ~ ve,-    Serial.Element v ~ ve, Memory.C ve,+   (Storable.C vh, Tuple.ValueOf vh ~ ve, Serial.Element v ~ ve,     Ip.C nodesStep, Ip.C nodesLeap,     Serial.Size (nodesLeap (nodesStep v)) ~ n,     Serial.C (nodesLeap (nodesStep v)),@@ -116,9 +115,7 @@        nodesLeap (nodesStep (Serial.Element v)),     TypeNum.Positive n,     SoV.RationalConstant a, SoV.Fraction a, Vector.Real a,-    Storable a, MakeValueTuple a, ValueTuple a ~ Value a,-    Memory.FirstClass a, Memory.Stored a ~ am, IsSized am,-    LLVM.IsPrimitive a, LLVM.IsPrimitive am) =>+    Marshal.C a, Tuple.ValueOf a ~ Value a, LLVM.IsPrimitive a) =>    (forall r. Ip.T r nodesLeap (Serial.Value n a) v) ->    (forall r. Ip.T r nodesStep (Serial.Value n a) v) ->    Param.T p Int ->@@ -126,7 +123,7 @@    Param.T p (SV.Vector vh) ->    CausalP.T p (Serial.Value n a, Serial.Value n a) v staticPacked ipLeap ipStep periodInt period vec =-   let period32 = Param.word32 periodInt+   let period32 = Param.wordInt periodInt        cellMargin = combineMarginParams ipLeap ipStep periodInt    in  interpolateCell ipLeap ipStep        <<<@@ -137,7 +134,7 @@        <<<        first           (limitShapePacked cellMargin period32-              (Param.word32 $ fmap SV.length vec))+              (Param.wordInt $ fmap SV.length vec))   {- |@@ -148,10 +145,7 @@    (Ip.C nodesStep, Ip.C nodesLeap,     A.Additive v, Memory.C v,     SoV.RationalConstant a, SoV.Fraction a,-    LLVM.CmpRet a, LLVM.CmpResult a ~ Bool,-    Storable a, MakeValueTuple a, ValueTuple a ~ Value a,-    Memory.FirstClass a, Memory.Stored a ~ am, IsSized am,-    LLVM.ShapeOf a ~ LLVM.ScalarShape) =>+    Marshal.C a, Tuple.ValueOf a ~ Value a, LLVM.IsPrimitive a, LLVM.CmpRet a) =>    (forall r. Ip.T r nodesLeap (Value a) v) ->    (forall r. Ip.T r nodesStep (Value a) v) ->    Param.T p Int ->@@ -177,10 +171,7 @@    (Ip.C nodesStep, Ip.C nodesLeap,     A.Additive v, Memory.C v,     SoV.RationalConstant a, SoV.Fraction a,-    LLVM.CmpRet a, LLVM.CmpResult a ~ Bool,-    Storable a, MakeValueTuple a, ValueTuple a ~ Value a,-    Memory.FirstClass a, Memory.Stored a ~ am, IsSized am,-    LLVM.ShapeOf a ~ LLVM.ScalarShape) =>+    Marshal.C a, Tuple.ValueOf a ~ Value a, LLVM.IsPrimitive a, LLVM.CmpRet a) =>    (forall r. Ip.T r nodesLeap (Value a) v) ->    (forall r. Ip.T r nodesStep (Value a) v) ->    Param.T p Int ->@@ -211,15 +202,12 @@    (Ip.C nodesStep, Ip.C nodesLeap,     A.Additive v, Memory.C v,     SoV.RationalConstant a, SoV.Fraction a,-    LLVM.CmpRet a, LLVM.CmpResult a ~ Bool,-    Storable a, MakeValueTuple a, ValueTuple a ~ Value a,-    Memory.FirstClass a, Memory.Stored a ~ am, IsSized am,-    LLVM.ShapeOf a ~ LLVM.ScalarShape) =>+    Marshal.C a, Tuple.ValueOf a ~ Value a, LLVM.IsPrimitive a, LLVM.CmpRet a) =>    (Param.T p (Ip.Margin (nodesLeap (nodesStep v))) ->-    (Func.T p (Value a, Value a) (Value Word32),+    (Func.T p (Value a, Value a) (Value Word),      Func.T p (Value a, Value a) (Value a)) ->     (Func.T p (Value a, Value a) (RingBuffer.T v),-     Func.T p (Value a, Value a) (Value Word32),+     Func.T p (Value a, Value a) (Value Word),      Func.T p (Value a, Value a) (Value a))) ->    (forall r. Ip.T r nodesLeap (Value a) v) ->    (forall r. Ip.T r nodesStep (Value a) v) ->@@ -227,10 +215,10 @@    Param.T p a ->    CausalP.T p (Value a, Value a) v dynamicGen limitMaxShape ipLeap ipStep periodInt period =-   let period32 = Param.word32 periodInt+   let period32 = Param.wordInt periodInt        cellMargin = combineMarginParams ipLeap ipStep periodInt        minShape =-          Param.word32 $ fmap fst $+          Param.wordInt $ fmap fst $           liftA2 shapeMargin cellMargin periodInt     in  Func.withArgs $ \(shape, phase) ->@@ -258,17 +246,15 @@                  shapePhases  constantFromWord32 ::-   (IsFloating a, LLVM.ShapeOf a ~ LLVM.ScalarShape) =>-   Param.T p Word32 -> Func.T p inp (Value a)+   (IsFloating a, LLVM.IsPrimitive a) =>+   Param.T p Word -> Func.T p inp (Value a) constantFromWord32 x =    Func.fromSignal       (CausalP.mapSimple LLVM.inttofp $* SigP.constant x)  limitMinShape ::-   (Storable a, Memory.FirstClass a, Memory.Stored a ~ am, IsSized am,-    LLVM.ShapeOf a ~ LLVM.ScalarShape,-    LLVM.IsFloating a, LLVM.CmpRet a, LLVM.CmpResult a ~ Bool) =>-   Param.T p Word32 ->+   (IsFloating a, IsSized a, LLVM.IsPrimitive a, LLVM.CmpRet a) =>+   Param.T p Word ->    CausalP.T p (Value a) (Value a) limitMinShape xLim =    CausalPV.mapAccum@@ -276,10 +262,8 @@       (Value.lift1 LLVM.inttofp) (return ()) xLim  integrateFrac ::-   (IsFloating a,-    Memory.FirstClass a, Memory.Stored a ~ am, IsSized am,-    LLVM.ShapeOf a ~ LLVM.ScalarShape) =>-   CausalP.T p (Value a) (Value Word32, Value a)+   (IsFloating a, IsSized a, LLVM.IsPrimitive a) =>+   CausalP.T p (Value a) (Value Word, Value a) integrateFrac =    CausalP.mapAccumSimple       (\a (_n,frac) -> do@@ -300,9 +284,9 @@  cellFromBuffer ::    (Memory.C a, Ip.C nodesLeap, Ip.C nodesStep) =>-   Value Word32 ->+   Value Word ->    RingBuffer.T a ->-   Value Word32 ->+   Value Word ->    CodeGenFunction r (nodesLeap (nodesStep a)) cellFromBuffer periodInt buffer offset =    Ip.indexNodes@@ -315,20 +299,20 @@ elementMargin (Ip.Margin x y) = Ip.Margin x y  peekCell ::-   (Storable a, MakeValueTuple a, ValueTuple a ~ value, Memory.C value,-    Ip.C nodesLeap, Ip.C nodesStep) =>+   (Storable.C a, Tuple.ValueOf a ~ value, Ip.C nodesLeap, Ip.C nodesStep) =>    Param.T p (Ip.Margin (nodesLeap (nodesStep value))) ->-   Param.T p Word32 ->+   Param.T p Word ->    Param.T p (SV.Vector a) ->-   CausalP.T p (Value Word32) (nodesLeap (nodesStep value))+   CausalP.T p (Value Word) (nodesLeap (nodesStep value)) peekCell margin period32 vec =-   Param.with (Param.word32 $ fmap Ip.marginOffset margin) $ \getOffset valueOffset ->-   Param.with period32 $ \getPeriod valuePeriod -> CausalPrivP.Cons+   Param.withValue (Param.wordInt $ fmap Ip.marginOffset margin) $ \getOffset valueOffset ->+   Param.withValue period32 $ \getPeriod valuePeriod -> CausalPrivP.Cons       (\(p,off,per) () n () -> MaybeCont.lift $ do-         offset <- A.sub n (valueOffset off)+         offset <- LLVM.bitcast =<< A.sub n (valueOffset off)+         perInt <- LLVM.bitcast $ valuePeriod per          nodes <--            Ip.loadNodes (Ip.loadNodes Memory.load A.one) (valuePeriod per)-               =<< LLVM.getElementPtr p (offset, ())+            Ip.loadNodes (Ip.loadNodes Storable.load A.one) perInt+               =<< Storable.advancePtr offset p          return (nodes, ()))       (return ())       (return . flip (,) ())@@ -341,14 +325,12 @@  flattenShapePhaseProc ::    (IsFloating a, SoV.Fraction a, SoV.RationalConstant a,-    Storable ah, MakeValueTuple ah, ValueTuple ah ~ Value a,-    Memory.FirstClass a, Memory.Stored a ~ am, IsSized am,-    LLVM.ShapeOf a ~ LLVM.ScalarShape) =>-   Param.T p Word32 ->+    Marshal.C ah, Tuple.ValueOf ah ~ Value a, LLVM.IsPrimitive a) =>+   Param.T p Word ->    Param.T p ah ->    CausalP.T p       (Value a, Value a)-      (Value Word32, (Value a, Value a))+      (Value Word, (Value a, Value a)) flattenShapePhaseProc period32 period =    CausalP.map       (\(perInt, per) (shape, phase) ->@@ -357,14 +339,13 @@  flattenShapePhaseProcPacked ::    (IsFloating a, Vector.Real a, SoV.RationalConstant a,-    Storable ah, MakeValueTuple ah, ValueTuple ah ~ Value a,-    Memory.FirstClass a, Memory.Stored a ~ am, IsSized am,+    Marshal.C ah, Tuple.ValueOf ah ~ Value a, LLVM.IsPrimitive a,     TypeNum.Positive n) =>-   Param.T p Word32 ->+   Param.T p Word ->    Param.T p ah ->    CausalP.T p       (Serial.Value n a, Serial.Value n a)-      (Serial.Value n Word32,+      (Serial.Value n Word,        (Serial.Value n a, Serial.Value n a)) flattenShapePhaseProcPacked period32 period =    CausalP.map@@ -409,12 +390,10 @@   limitShape ::-   (Memory.FirstClass t, Memory.Stored t ~ tm, IsSized tm,-    IsFloating t, SoV.Real t,+   (IsSized t, IsFloating t, SoV.Real t,     LLVM.ShapeOf t ~ LLVM.ShapeOf i,-    MakeValueTuple i, ValueTuple i ~ Value i,+    Marshal.C i, Tuple.ValueOf i ~ Value i,     Ring.C i, LLVM.IsInteger i, SoV.IntegerConstant i,-    Storable i, Memory.FirstClass i, Memory.Stored i ~ im, IsSized im,     Ip.C nodesStep, Ip.C nodesLeap) =>    Param.T p (Ip.Margin (nodesLeap (nodesStep value))) ->    Param.T p i ->@@ -426,15 +405,12 @@    limitShapeSignal margin periodInt len  limitShapePacked ::-   (Memory.FirstClass t, Memory.Stored t ~ tm,-    IsSized tm, LLVM.IsPrimitive tm,-    LLVM.SizeOf tm ~ tmsize,-    IsFloating t, LLVM.IsPrimitive t, Vector.Real t,+   (IsSized t, IsFloating t, LLVM.IsPrimitive t, Vector.Real t,     TypeNum.Positive n,     Ip.C nodesStep, Ip.C nodesLeap) =>    Param.T p (Ip.Margin (nodesLeap (nodesStep value))) ->-   Param.T p Word32 ->-   Param.T p Word32 ->+   Param.T p Word ->+   Param.T p Word ->    CausalP.T p (Serial.Value n t) (Serial.Value n t) limitShapePacked margin periodInt len =    CausalPV.zipWithSimple@@ -448,12 +424,10 @@    limitShapeSignal margin periodInt len  limitShapeSignal ::-   (Memory.FirstClass t, Memory.Stored t ~ tm, IsSized tm,-    IsFloating t,+   (IsSized t, IsFloating t,     LLVM.ShapeOf t ~ LLVM.ShapeOf i,-    MakeValueTuple i, ValueTuple i ~ Value i,+    Marshal.C i, Tuple.ValueOf i ~ Value i,     Ring.C i, LLVM.IsInteger i, SoV.IntegerConstant i,-    Storable i, Memory.FirstClass i, Memory.Stored i ~ im, IsSized im,     Ip.C nodesStep, Ip.C nodesLeap) =>    Param.T p (Ip.Margin (nodesLeap (nodesStep value))) ->    Param.T p i ->@@ -477,8 +451,7 @@   _limitShape ::-   (Ring.C th, Storable th, MakeValueTuple th, ValueTuple th ~ t,-    Memory.C t, A.Real t,+   (Ring.C th, Marshal.C th, Tuple.ValueOf th ~ t, A.Real t,     Ip.C nodesStep, Ip.C nodesLeap) =>    Ip.Margin (nodesLeap (nodesStep value)) ->    Param.T p th ->@@ -515,7 +488,7 @@    (Ip.C nodesLeap, Ip.C nodesStep,     IsFloating t, LLVM.ShapeOf t ~ LLVM.ScalarShape) =>    Ip.Margin (nodesLeap (nodesStep value)) ->-   Value.T (Value Word32) ->+   Value.T (Value Word) ->    Value.T (Value t) ->    (Value.T (Value t), Value.T (Value t)) _shapeLimits margin periodInt len =@@ -573,8 +546,7 @@ VectorLazy.fromChunks [Vector.pack [0.0,1.999999,3.9999995,6.0,8.0,10.0,12.0,14.0,15.999999,14.000001,12.0,10.0,7.999999,6.0,8.0,10.0,12.0,14.0,16.0,14.0,11.999999,9.999998,7.999998,6.0000024,8.000002]] -} zigZagLong ::-   (Storable a, MakeValueTuple a, ValueTuple a ~ Value a,-    Memory.FirstClass a, Memory.Stored a ~ am, IsSized am,+   (Marshal.C a, Tuple.ValueOf a ~ Value a,     SoV.Fraction a, IsFloating a, SoV.RationalConstant a, LLVM.CmpRet a,     Field.C a) =>    Param.T p a ->@@ -584,13 +556,12 @@    zigZagLongGen (CausalP.fromSignal . SigP.constant) zigZag  zigZagLongPacked ::-   (Storable a, MakeValueTuple a, ValueTuple a ~ Value a,+   (Marshal.C a, Tuple.ValueOf a ~ Value a,+    Marshal.Vector n a, Tuple.VectorValueOf n a ~ Value (LLVM.Vector n a),     SoV.Fraction a, SoV.RationalConstant a, Vector.Real a,-    Memory.FirstClass a, Memory.Stored a ~ am, IsSized am,-    LLVM.IsPrimitive am,-    Field.C a,-    (n TypeNum.:*: LLVM.SizeOf am) ~ amsize,-    TypeNum.Positive amsize,+    LLVM.IsPrimitive a, Field.C a,+    (n TypeNum.:*: LLVM.SizeOf a) ~ asize,+    TypeNum.Positive asize,     TypeNum.Positive n) =>    Param.T p a ->    Param.T p a ->@@ -618,10 +589,8 @@ The start value must be at most 2 and may be negative. -} zigZag ::-   (Storable a, MakeValueTuple a, ValueTuple a ~ Value a,-    Memory.FirstClass a, Memory.Stored a ~ am, IsSized am,-    SoV.Fraction a, IsFloating a, SoV.RationalConstant a,-    LLVM.CmpRet a) =>+   (Marshal.C a, Tuple.ValueOf a ~ Value a,+    SoV.Fraction a, IsFloating a, SoV.RationalConstant a, LLVM.CmpRet a) =>    Param.T p a ->    CausalP.T p (Value a) (Value a) zigZag start =@@ -634,9 +603,8 @@       id (return ()) start  zigZagPacked ::-   (Storable a, MakeValueTuple a, ValueTuple a ~ Value a,-    Memory.FirstClass a, Memory.Stored a ~ am, IsSized am,-    SoV.Fraction a, Vector.Real a, IsFloating a, SoV.RationalConstant a,+   (Marshal.C a, Tuple.ValueOf a ~ Value a,+    SoV.Fraction a, IsFloating a, Vector.Real a, SoV.RationalConstant a,     LLVM.CmpRet a,     TypeNum.Positive n) =>    Param.T p a ->
src/Synthesizer/LLVM/CausalParameterized/Process.hs view
@@ -75,13 +75,12 @@  import Synthesizer.LLVM.CausalParameterized.ProcessPrivate import Synthesizer.LLVM.Causal.ProcessPrivate-         (feedbackControlledAux, reverbParams, )-import Synthesizer.LLVM.Causal.Process (loopZero, mix, )+         (feedbackControlledAux, reverbParams)+import Synthesizer.LLVM.Causal.Process (loopZero, mix) import qualified Synthesizer.LLVM.Causal.ProcessPrivate as CausalPriv import qualified Synthesizer.LLVM.Causal.Process as Causal import qualified Synthesizer.LLVM.Plug.Input as PIn import qualified Synthesizer.LLVM.Plug.Output as POut-import qualified Synthesizer.LLVM.Parameter as Param import qualified Synthesizer.CausalIO.Process as PIO  import qualified Synthesizer.LLVM.CausalParameterized.RingBuffer as RingBuffer@@ -92,9 +91,7 @@ import qualified Synthesizer.LLVM.Interpolation as Interpolation import qualified Synthesizer.LLVM.Frame.Stereo as Stereo import qualified Synthesizer.LLVM.Frame as Frame-import qualified Synthesizer.LLVM.Execution as Exec import qualified Synthesizer.LLVM.ForeignPtr as ForeignPtr-import Synthesizer.LLVM.Parameter (($#), )  import qualified Synthesizer.Causal.Class as CausalClass import qualified Synthesizer.Generic.Cut as Cut@@ -104,58 +101,59 @@ import qualified Data.StorableVector as SV import qualified Data.StorableVector.Base as SVB +import qualified LLVM.DSL.Execution as Exec+import qualified LLVM.DSL.Parameter as Param+import LLVM.DSL.Parameter (($#))+ import qualified LLVM.Extra.ScalarOrVector as SoV+import qualified LLVM.Extra.Tuple as Tuple import qualified LLVM.Extra.MaybeContinuation as MaybeCont import qualified LLVM.Extra.Maybe as Maybe+import qualified LLVM.Extra.Storable as Storable import qualified LLVM.Extra.Memory as Memory+import qualified LLVM.Extra.Marshal as Marshal import qualified LLVM.Extra.Control as C import qualified LLVM.Extra.Arithmetic as A-import LLVM.Extra.Class (MakeValueTuple, ValueTuple, Undefined, undefTuple, )  import qualified LLVM.Core as LLVM-import LLVM.Util.Loop (Phi, ) import LLVM.Core           (CodeGenFunction, ret, Value, valueOf,-           IsSized, IsConst, IsArithmetic, IsFloating, )+           IsSized, IsConst, IsArithmetic, IsFloating)  import qualified Type.Data.Num.Decimal as TypeNum  import qualified Control.Category as Cat-import Control.Monad.Trans.State (runState, )-import Control.Arrow (arr, first, second, (<<<), (<<^), (>>>), (&&&), )-import Control.Monad (liftM, when, )-import Control.Applicative (liftA2, liftA3, pure, (<*>), )-import Control.Functor.HT (void, unzip, )-import Control.Exception (bracket, )+import Control.Monad.Trans.State (runState)+import Control.Arrow (arr, first, second, (<<<), (<<^), (>>>), (&&&))+import Control.Monad (liftM, when)+import Control.Applicative (liftA2, liftA3, pure, (<*>))+import Control.Functor.HT (void, unzip)+import Control.Exception (bracket)  import qualified Data.List as List-import Data.Traversable (traverse, )-import Data.Foldable (sequence_, )-import Data.Tuple.HT (swap, mapFst, mapSnd, uncurry3, snd3, )-import Data.Word (Word32, )-import Data.Int (Int8, )+import Data.Traversable (traverse)+import Data.Foldable (sequence_)+import Data.Tuple.HT (swap, mapFst, mapSnd, uncurry3, snd3)+import Data.Word (Word)+import Data.Int (Int8) -import System.Random (Random, RandomGen, )+import System.Random (Random, RandomGen) -import qualified Synthesizer.LLVM.Alloc as Alloc-import qualified Foreign.Marshal.Utils as AllocUtil-import Foreign.Storable.Tuple ()-import Foreign.Storable (Storable, poke, peek, ) import Foreign.StablePtr-          (StablePtr, newStablePtr, freeStablePtr, deRefStablePtr, )-import Foreign.ForeignPtr (touchForeignPtr, withForeignPtr, )-import Foreign.Ptr (FunPtr, Ptr, castPtr, freeHaskellFunPtr, )+          (StablePtr, newStablePtr, freeStablePtr, deRefStablePtr)+import Foreign.ForeignPtr (touchForeignPtr)+import Foreign.Ptr (FunPtr, Ptr, freeHaskellFunPtr)  import qualified System.Unsafe as Unsafe -import qualified Synthesizer.LLVM.Debug.Storable as DebugSt-import qualified Synthesizer.LLVM.Debug.Counter as DebugCnt+import qualified LLVM.DSL.Debug.Marshal as DebugSt+import qualified LLVM.DSL.Debug.Counter as DebugCnt  import qualified Algebra.Transcendental as Trans  import NumericPrelude.Numeric import NumericPrelude.Base hiding-          (and, iterate, map, unzip, zip, zipWith, take, takeWhile, sequence_, )+          (and, iterate, map, unzip, zip, zipWith, take, takeWhile, sequence_)   infixl 0 $<, $>, $*@@ -196,7 +194,7 @@     Value.Flatten ch, Value.Registers ch ~ cl,     Value.Flatten sh, Value.Registers sh ~ sl, Memory.C sl,     Value.Flatten ih, Value.Registers ih ~ il, Memory.C il,-    Storable i, MakeValueTuple i, ValueTuple i ~ il) =>+    Marshal.C i, Tuple.ValueOf i ~ il) =>    Modifier.Initialized sh ih ch ah bh -> Param.T p i -> T p (cl,al) bl fromInitializedModifier (Modifier.Initialized initF step) =    mapAccum@@ -210,7 +208,7 @@   replicateParallel ::-   (Undefined b, Phi b) =>+   (Tuple.Undefined b, Tuple.Phi b) =>    Param.T p Int -> SigP.T p b -> T p (b,b) b -> T p a b -> T p a b replicateParallel n z cum p =    replicateControlled n (first p >>> cum) $> z@@ -225,7 +223,7 @@    If types are different, the LLVM code cannot be the same, though. -} replicateControlledParam ::-   (Undefined x, Phi x) =>+   (Tuple.Undefined x, Tuple.Phi x) =>    (forall q. Param.T q p -> Param.T q a -> T q (c,x) x) ->    Param.T p [a] -> T p (c,x) x replicateControlledParam f ps =@@ -246,7 +244,7 @@  -- cf. synthesizer-core:Causal.Process feedbackControlled ::-   (Storable ch, MakeValueTuple ch, ValueTuple ch ~ c, Memory.C c) =>+   (Marshal.C ch, Tuple.ValueOf ch ~ c) =>    Param.T p ch ->    T p ((ctrl,a),c) b -> T p (ctrl,b) c -> T p (ctrl,a) b feedbackControlled initial forth back =@@ -257,7 +255,7 @@ Run a causal process independently on each stereo channel. -} stereoFromMono ::-   (Phi a, Phi b, Undefined b) =>+   (Tuple.Phi a, Tuple.Phi b, Tuple.Undefined b) =>    T p a b -> T p (Stereo.T a) (Stereo.T b) stereoFromMono       (Cons next alloca start stop createIOContext deleteIOContext) = Cons@@ -269,13 +267,13 @@    (composeDelete deleteIOContext deleteIOContext)  stereoFromMonoControlled ::-   (Phi a, Phi b, Phi c, Undefined b) =>+   (Tuple.Phi a, Tuple.Phi b, Tuple.Phi c, Tuple.Undefined b) =>    T p (c,a) b -> T p (c, Stereo.T a) (Stereo.T b) stereoFromMonoControlled proc =    stereoFromMono proc <<^ (\(c,sa) -> fmap ((,) c) sa)  stereoFromMonoParameterized ::-   (Phi a, Phi b, Undefined b) =>+   (Tuple.Phi a, Tuple.Phi b, Tuple.Undefined b) =>    (forall q. Param.T q p -> Param.T q x -> T q a b) ->    Param.T p (Stereo.T x) -> T p (Stereo.T a) (Stereo.T b) stereoFromMonoParameterized f ps =@@ -300,10 +298,10 @@   stereoNext ::-   (Phi a, Phi b, Phi c, Phi s, Phi context,-    Undefined b, Undefined s) =>+   (Tuple.Phi a, Tuple.Phi b, Tuple.Phi c, Tuple.Phi s, Tuple.Phi context,+    Tuple.Undefined b, Tuple.Undefined s) =>    (context -> s -> CodeGenFunction r ()) ->-   (forall z. (Phi z) => context -> local -> a -> s -> MaybeCont.T r z (b, s)) ->+   (forall z. (Tuple.Phi z) => context -> local -> a -> s -> MaybeCont.T r z (b, s)) ->    Stereo.T context ->    local ->    Stereo.T a ->@@ -330,20 +328,20 @@    return $ fmap unzip mbs2  stereoStart ::-   (Phi a, Phi b, Phi c, Undefined b, Undefined c) =>+   (Tuple.Phi a, Tuple.Phi b, Tuple.Phi c, Tuple.Undefined b, Tuple.Undefined c) =>    (a -> CodeGenFunction r (c, b)) ->    Stereo.T a -> CodeGenFunction r (Stereo.T c, Stereo.T b) stereoStart code a =    fmap unzip $ twiceStereo code a  stereoStop ::-   (Phi context, Phi state) =>+   (Tuple.Phi context, Tuple.Phi state) =>    (context -> state -> CodeGenFunction r ()) ->    Stereo.T context -> Stereo.T state -> CodeGenFunction r () stereoStop code c s = void $ twiceStereo (uncurry code) (liftA2 (,) c s)  twiceStereo ::-   (Phi a, Phi b, Undefined b) =>+   (Tuple.Phi a, Tuple.Phi b, Tuple.Undefined b) =>    (a -> CodeGenFunction r b) ->    Stereo.T a -> CodeGenFunction r (Stereo.T b) twiceStereo code a =@@ -351,12 +349,12 @@    twice code (Stereo.left a, Stereo.right a)  twice ::-   (Phi a, Phi b, Undefined b) =>+   (Tuple.Phi a, Tuple.Phi b, Tuple.Undefined b) =>    (a -> CodeGenFunction r b) ->    (a,a) -> CodeGenFunction r (b,b) twice code a =    fmap snd $-   C.fixedLengthLoop (valueOf (2::Int8)) (a, undefTuple) $+   C.fixedLengthLoop (valueOf (2::Int8)) (a, Tuple.undef) $       \((a0,a1), (_,b1)) -> do          b0 <- code a0          return ((a1,a0), (b1,b0))@@ -366,8 +364,7 @@ You may also use '(+)' and a 'SigP.constant' signal or a number literal. -} raise ::-   (A.Additive al, Storable a,-    MakeValueTuple a, ValueTuple a ~ al, Memory.C al) =>+   (A.Additive al, Marshal.C a, Tuple.ValueOf a ~ al) =>    Param.T p a -> T p al al raise =    map Frame.mix@@ -377,15 +374,13 @@ You may also use '(*)' and a 'SigP.constant' signal or a number literal. -} amplify ::-   (A.PseudoRing al, Storable a,-    MakeValueTuple a, ValueTuple a ~ al, Memory.C al) =>+   (A.PseudoRing al, Marshal.C a, Tuple.ValueOf a ~ al) =>    Param.T p a -> T p al al amplify =    map Frame.amplifyMono  amplifyStereo ::-   (A.PseudoRing al, Storable a,-    MakeValueTuple a, ValueTuple a ~ al, Memory.C al) =>+   (A.PseudoRing al, Marshal.C a, Tuple.ValueOf a ~ al) =>    Param.T p a -> T p (Stereo.T al) (Stereo.T al) amplifyStereo =    map Frame.amplifyStereo@@ -393,9 +388,7 @@   mapLinear ::-   (IsArithmetic a, Storable a,-    Memory.FirstClass a, Memory.Stored a ~ am, IsSized am,-    MakeValueTuple a, ValueTuple a ~ (Value a)) =>+   (IsArithmetic a, Marshal.C a, Tuple.ValueOf a ~ Value a) =>    Param.T p a -> Param.T p a -> T p (Value a) (Value a) mapLinear depth center =    map@@ -403,10 +396,8 @@       (depth&&&center)  mapExponential ::-   (Trans.C a, IsFloating a, IsConst a, Storable a,-    SoV.TranscendentalConstant a,-    Memory.FirstClass a, Memory.Stored a ~ am, IsSized am,-    MakeValueTuple a, ValueTuple a ~ (Value a)) =>+   (Trans.C a, Marshal.C a, IsFloating a, IsConst a,+    SoV.TranscendentalConstant a, Tuple.ValueOf a ~ Value a) =>    Param.T p a -> Param.T p a -> T p (Value a) (Value a) mapExponential depth center =    map@@ -426,10 +417,9 @@ -} quantizeLift ::    (Memory.C b,-    Storable c, MakeValueTuple c, ValueTuple c ~ Value cl,+    Marshal.C c, Tuple.ValueOf c ~ Value cl,     SoV.IntegerConstant cl, IsFloating cl,-    LLVM.CmpRet cl, LLVM.CmpResult cl ~ Bool,-    Memory.FirstClass cl, Memory.Stored cl ~ cm, IsSized cm) =>+    LLVM.CmpRet cl, LLVM.CmpResult cl ~ Bool) =>    Param.T p c ->    T p a b ->    T p a b@@ -439,8 +429,7 @@  -- for backwards compatibility osciSimple ::-   (Memory.FirstClass t, Memory.Stored t ~ tm, IsSized tm,-    SoV.Fraction t) =>+   (SoV.Fraction t, IsSized t) =>    (forall r. Value t -> CodeGenFunction r y) ->    T p (Value t, Value t) y osciSimple = Causal.osci@@ -452,7 +441,7 @@ The initial value is needed in order to determine the ring buffer element type. -} delay ::-   (Storable a, MakeValueTuple a, ValueTuple a ~ al, Memory.C al) =>+   (Marshal.C a, Tuple.ValueOf a ~ al) =>    Param.T p a -> Param.T p Int -> T p al al delay initial time =    mapSimple RingBuffer.oldest@@ -476,13 +465,13 @@ e.g. @pipeline (id :: T (Vector D4 Float) (Vector D4 Float))@ delays by 4 samples in an efficient way. In principle it would be also possible to use-@unpack (delay1 (const $ toVector (0,0,0,0)))@+@unpack (delay1 (pure $ consVector 0 0 0 0))@ but 'unpack' causes an additional delay. Thus @unpack (id :: T (Vector D4 Float) (Vector D4 Float))@ may do, what you want. -} delay1 ::-   (Storable a, MakeValueTuple a, ValueTuple a ~ al, Memory.C al) =>+   (Marshal.C a, Tuple.ValueOf a ~ al) =>    Param.T p a -> T p al al delay1 initial = loop initial (arr swap) @@ -492,8 +481,8 @@ The momentum delay must be between @0@ and @maxTime@, inclusively. -} delayControlled ::-   (Storable a, MakeValueTuple a, ValueTuple a ~ al, Memory.C al) =>-   Param.T p a -> Param.T p Int -> T p (Value Word32, al) al+   (Marshal.C a, Tuple.ValueOf a ~ al) =>+   Param.T p a -> Param.T p Int -> T p (Value Word, al) al delayControlled initial maxTime =    zipWithSimple RingBuffer.index    <<<@@ -506,7 +495,7 @@ -} delayControlledInterpolated ::    (Interpolation.C nodes,-    Storable vh, MakeValueTuple vh, ValueTuple vh ~ v, Memory.C v,+    Marshal.C vh, Tuple.ValueOf vh ~ v,     IsFloating a, LLVM.ShapeOf a ~ LLVM.ScalarShape) =>    (forall r. Interpolation.T r nodes (Value a) v) ->    Param.T p vh -> Param.T p Int -> T p (Value a, v) v@@ -529,8 +518,7 @@   differentiate ::-   (A.Additive al,-    Storable a, MakeValueTuple a, ValueTuple a ~ al, Memory.C al) =>+   (A.Additive al, Marshal.C a, Tuple.ValueOf a ~ al) =>    Param.T p a -> T p al al differentiate initial =    Cat.id - delay1 initial@@ -539,8 +527,7 @@ Delay time must be greater than zero! -} comb ::-   (A.PseudoRing al,-    Storable a, MakeValueTuple a, ValueTuple a ~ al, Memory.C al) =>+   (A.PseudoRing al, Marshal.C a, Tuple.ValueOf a ~ al) =>    Param.T p a -> Param.T p Int ->    T p al al comb gain time =@@ -548,8 +535,7 @@       (delayZero (time-1) >>> amplify gain)))  combStereo ::-   (A.PseudoRing al,-    Storable a, MakeValueTuple a, ValueTuple a ~ al, Memory.C al) =>+   (A.PseudoRing al, Marshal.C a, Tuple.ValueOf a ~ al) =>    Param.T p a -> Param.T p Int ->    T p (Stereo.T al) (Stereo.T al) combStereo gain time =@@ -568,10 +554,8 @@ thus they cannot depend e.g. on a dynamic sample rate as required by JACK. -} reverbSimple ::-   (Random a,-    IsArithmetic a, SoV.RationalConstant a,-    MakeValueTuple a, ValueTuple a ~ (Value a),-    Storable a, Memory.FirstClass a, Memory.Stored a ~ am, IsSized am,+   (Random a, IsArithmetic a, SoV.RationalConstant a,+    Marshal.C a, Tuple.ValueOf a ~ Value a,     RandomGen g) =>    g -> Int -> (a,a) -> (Int,Int) ->    T p (Value a) (Value a)@@ -582,18 +566,16 @@     reverbParams rnd num gainRange timeRange)  reverb ::-   (Random a,+   (Random a, Marshal.C a, Tuple.ValueOf a ~ Value a,     SoV.PseudoModule a, SoV.Scalar a ~ s,-    IsFloating s, SoV.IntegerConstant s, LLVM.ShapeOf s ~ LLVM.ScalarShape,-    MakeValueTuple a, ValueTuple a ~ Value a,-    Storable a, Memory.FirstClass a, Memory.Stored a ~ am, IsSized am,+    IsFloating s, SoV.IntegerConstant s, LLVM.IsPrimitive s,     RandomGen g) =>    Param.T p g -> Param.T p Int -> Param.T p (a,a) -> Param.T p (Int,Int) ->    T p (Value a) (Value a) reverb rnd num gainRange timeRange =    map       (\n x -> flip A.scale x =<< A.fdiv A.one =<< LLVM.inttofp n)-      (Param.word32 num)+      (Param.wordInt num)    <<<    replicateControlledParam       (\_p p -> first (comb (fmap fst p) (fmap snd p)) >>> mix)@@ -615,7 +597,7 @@ -} _skipVolatile ::    (Causal.C process, CausalClass.SignalOf process ~ signal) =>-   signal v -> process (Value Word32) v+   signal v -> process (Value Word) v _skipVolatile =    CausalPriv.alterSignal       (\(SigPriv.Core next start stop) -> CausalPriv.Core@@ -641,8 +623,8 @@ The shrinking factor must be non-negative. -} frequencyModulationLinear ::-   (SoV.IntegerConstant a, IsFloating a, LLVM.CmpRet a, LLVM.CmpResult a ~ Bool,-    Memory.FirstClass a, Memory.Stored a ~ am, IsSized am) =>+   (SoV.IntegerConstant a, IsFloating a,+    LLVM.CmpRet a, LLVM.CmpResult a ~ Bool, IsSized a) =>    SigP.T p (Value a) -> T p (Value a) (Value a) frequencyModulationLinear =    Causal.frequencyModulation Interpolation.linear . SigP.adjacentNodes02@@ -651,7 +633,7 @@ type Exporter f = f -> IO (FunPtr f)  foreign import ccall safe "wrapper" callbackCreate ::-   Exporter (Ptr lparam -> Ptr init -> IO (StablePtr ioContext))+   Exporter (LLVM.Ptr lparam -> LLVM.Ptr init -> IO (StablePtr ioContext))  foreign import ccall safe "wrapper" callbackDelete ::    Exporter (StablePtr ioContext -> IO ())@@ -666,13 +648,7 @@       uncurry stop cs       void $ LLVM.call eraser io -castBackStorablePtr ::-   (MakeValueTuple haskellValue, ValueTuple haskellValue ~ llvmValue,-    Memory.C llvmValue) =>-   Ptr (Memory.Struct (ValueTuple haskellValue)) -> Ptr haskellValue-castBackStorablePtr = castPtr - {- | @trigger fill signal@ send @signal@ to the output and restart it whenever the Boolean process input is 'True'.@@ -686,16 +662,14 @@ Are exceptions handled correctly? -} trigger ::-   (Storable a, MakeValueTuple a, ValueTuple a ~ al, Memory.C al,-    Undefined b, Phi b) =>+   (Marshal.C a, Tuple.ValueOf a ~ al, Tuple.Undefined b, Tuple.Phi b) =>    (forall q. Param.T q p -> Param.T q a -> SigP.T q b) ->    T p (Maybe.T al) (Maybe.T b) trigger sig =    triggerAux (sig (arr fst) (arr snd))  triggerAux ::-   (Storable a, MakeValueTuple a, ValueTuple a ~ al, Memory.C al,-    Undefined b, Phi b) =>+   (Marshal.C a, Tuple.ValueOf a ~ al, Tuple.Undefined b, Tuple.Phi b) =>    SigP.T (p,a) b ->    T p (Maybe.T al) (Maybe.T b) triggerAux@@ -718,13 +692,12 @@       return (fmap (fst.snd.fst) mcasio2, fmap (mapFst (mapSnd snd)) mcasio2))    (liftA2 (,) alloca $ liftA2 (,) LLVM.alloca LLVM.alloca)    (\ce -> return (ce, Maybe.nothing))-   (\(_creator, eraser) mcsio ->-      stopAndDelete eraser stop mcsio)+   (\(_creator, eraser) mcsio -> stopAndDelete eraser stop mcsio)    (\p -> do       creator <- callbackCreate $ \paramPtr xPtr -> do-         x <- peek (castBackStorablePtr xPtr)+         x <- Marshal.peek xPtr          (context, param) <- createIOContext (p,x)-         poke (castBackStorablePtr paramPtr) param+         Marshal.poke paramPtr param          newStablePtr context       eraser <- callbackDelete $ \contextPtr -> do          deleteIOContext =<< deRefStablePtr contextPtr@@ -740,8 +713,8 @@ On each restart the parameters of type @b@ are passed to the signal.  triggerParam ::-   (MakeValueTuple a, ValueTuple a ~ al,-    MakeValueTuple b, ValueTuple b ~ bl) =>+   (Tuple.Value a, Tuple.ValueOf a ~ al,+    Tuple.Value b, Tuple.ValueOf b ~ bl) =>    Param.T p a ->    (Param.T p b -> SigP.T p a) ->    T p (Value Bool, bl) al@@ -751,26 +724,27 @@   foreign import ccall safe "dynamic" derefFillPtr ::-   Exec.Importer (Ptr param -> Word32 -> Ptr a -> Ptr b -> IO Word32)+   Exec.Importer (LLVM.Ptr param -> Word -> Ptr a -> Ptr b -> IO Word)  runStorable ::-   (Storable a, MakeValueTuple a, ValueTuple a ~ valueA, Memory.C valueA,-    Storable b, MakeValueTuple b, ValueTuple b ~ valueB, Memory.C valueB) =>+   (Storable.C a, Tuple.ValueOf a ~ valueA,+    Storable.C b, Tuple.ValueOf b ~ valueB) =>    T p valueA valueB ->    IO (p -> SV.Vector a -> SV.Vector b) runStorable (Cons next alloca start stop createIOContext deleteIOContext) = do    fill <--      Exec.compileModule $+      Exec.compile "process" $       Exec.createFunction derefFillPtr "fillprocessblock" $       \paramPtr size alPtr blPtr -> do          param <- Memory.load paramPtr          (c,s) <- start param          local <- alloca-         (pos,msExit) <- MaybeCont.arrayLoop2 size alPtr blPtr s $+         (pos,msExit) <-+            Storable.arrayLoopMaybeCont2 size alPtr blPtr s $                \ aPtri bPtri s0 -> do-            a <- MaybeCont.lift $ Memory.load aPtri+            a <- MaybeCont.lift $ Storable.load aPtri             (b,s1) <- next c local a s0-            MaybeCont.lift $ Memory.store b bPtri+            MaybeCont.lift $ Storable.store b bPtri             return s1          Maybe.for msExit $ stop c          ret pos@@ -781,16 +755,13 @@       \ (_,params) ->          SVB.withStartPtr as $ \ aPtr len ->          SVB.createAndTrim len $ \ bPtr ->-         Alloc.with params $ \paramPtr ->+         Marshal.with params $ \paramPtr ->          fmap fromIntegral $-            fill (Memory.castTuplePtr paramPtr)-               (fromIntegral len)-               (Memory.castTuplePtr aPtr)-               (Memory.castTuplePtr bPtr)+            fill paramPtr (fromIntegral len) aPtr bPtr  applyStorable ::-   (Storable a, MakeValueTuple a, ValueTuple a ~ valueA, Memory.C valueA,-    Storable b, MakeValueTuple b, ValueTuple b ~ valueB, Memory.C valueB) =>+   (Storable.C a, Tuple.ValueOf a ~ valueA,+    Storable.C b, Tuple.ValueOf b ~ valueB) =>    T p valueA valueB ->    p -> SV.Vector a -> SV.Vector b applyStorable gen = Unsafe.performIO $ runStorable gen@@ -799,18 +770,17 @@  foreign import ccall safe "dynamic" derefChunkPtr ::    Exec.Importer-      (Ptr contextStateStruct -> Word32 ->-       Ptr structA -> Ptr structB -> IO Word32)+      (LLVM.Ptr contextStateStruct -> Word -> Ptr a -> Ptr b -> IO Word)   compileChunky ::-   (Memory.C valueA, Memory.Struct valueA ~ structA,-    Memory.C valueB, Memory.Struct valueB ~ structB,+   (Storable.C a, Tuple.ValueOf a ~ valueA,+    Storable.C b, Tuple.ValueOf b ~ valueB,     Memory.C parameters, Memory.Struct parameters ~ paramStruct,     Memory.C context, Memory.C state,     Memory.Struct (context, Maybe.T state) ~ contextStateStruct) =>    (forall r z.-    (Phi z) =>+    (Tuple.Phi z) =>     context -> local ->     valueA -> state ->     MaybeCont.T r z (valueB, state)) ->@@ -821,17 +791,17 @@    (forall r.     context -> state ->     CodeGenFunction r ()) ->-   IO (Ptr paramStruct -> IO (Ptr contextStateStruct),+   IO (LLVM.Ptr paramStruct -> IO (LLVM.Ptr contextStateStruct),        Exec.Finalizer contextStateStruct,-       Ptr contextStateStruct -> Word32 ->-         Ptr structA -> Ptr structB -> IO Word32)+       LLVM.Ptr contextStateStruct -> Word -> Ptr a -> Ptr b -> IO Word) compileChunky next alloca start stop =-   Exec.compileModule $+   Exec.compile "process-chunky" $       liftA3 (,,)          (Exec.createFunction derefStartPtr "startprocess" $           \paramPtr -> do              pptr <- LLVM.malloc-             flip Memory.store pptr . mapSnd Maybe.just =<< start =<< Memory.load paramPtr+             flip Memory.store pptr . mapSnd Maybe.just+                =<< start =<< Memory.load paramPtr              ret pptr)          (Exec.createFinalizer derefStopPtr "stopprocess" $           \ contextStatePtr -> do@@ -845,11 +815,11 @@              local <- alloca              (pos,msExit) <-                 Maybe.run msInit (return (A.zero, Maybe.nothing)) $ \sInit ->-                   MaybeCont.arrayLoop2 loopLen aPtr bPtr sInit $-                      \ aPtri bPtri s0 -> do-                a <- MaybeCont.lift $ Memory.load aPtri+                   Storable.arrayLoopMaybeCont2 loopLen aPtr bPtr sInit $+                   \ aPtri bPtri s0 -> do+                a <- MaybeCont.lift $ Storable.load aPtri                 (b,s1) <- next param local a s0-                MaybeCont.lift $ Memory.store b bPtri+                MaybeCont.lift $ Storable.store b bPtri                 return s1              sptr <- LLVM.getElementPtr0 contextStatePtr (TypeNum.d1, ())              Memory.store msExit sptr@@ -857,17 +827,22 @@   foreign import ccall safe "dynamic" derefStartPtr ::-   Exec.Importer (Ptr paramStruct -> IO (Ptr contextStateStruct))+   Exec.Importer (LLVM.Ptr paramStruct -> IO (LLVM.Ptr contextStateStruct))  foreign import ccall safe "dynamic" derefStopPtr ::-   Exec.Importer (Ptr contextStateStruct -> IO ())+   Exec.Importer (LLVM.Ptr contextStateStruct -> IO ()) +foreign import ccall safe "dynamic" derefChunkPluggedPtr ::+   Exec.Importer+      (LLVM.Ptr contextStateStruct -> Word ->+       LLVM.Ptr inp -> LLVM.Ptr out -> IO Word)+ compilePlugged ::    (Memory.C parameters, Memory.Struct parameters ~ paramStruct,     Memory.C context, Memory.C state,     Memory.Struct (context, Maybe.T state) ~ contextStateStruct,-    Undefined stateIn,  Phi stateIn,-    Undefined stateOut, Phi stateOut,+    Tuple.Undefined stateIn,  Tuple.Phi stateIn,+    Tuple.Undefined stateOut, Tuple.Phi stateOut,     Memory.C paramValueIn,  Memory.Struct paramValueIn  ~ paramStructIn,     Memory.C paramValueOut, Memory.Struct paramValueOut ~ paramStructOut) =>    (forall r.@@ -877,7 +852,7 @@     paramValueIn ->     LLVM.CodeGenFunction r stateIn) ->    (forall r z.-    (Phi z) =>+    (Tuple.Phi z) =>     context -> local ->     valueA -> state ->     MaybeCont.T r z (valueB, state)) ->@@ -894,17 +869,18 @@    (forall r.     paramValueOut ->     LLVM.CodeGenFunction r stateOut) ->-   IO (Ptr paramStruct -> IO (Ptr contextStateStruct),-       Ptr contextStateStruct -> IO (),-       Ptr contextStateStruct -> Word32 ->-         Ptr paramStructIn -> Ptr paramStructOut -> IO Word32)+   IO (LLVM.Ptr paramStruct -> IO (LLVM.Ptr contextStateStruct),+       LLVM.Ptr contextStateStruct -> IO (),+       LLVM.Ptr contextStateStruct -> Word ->+         LLVM.Ptr paramStructIn -> LLVM.Ptr paramStructOut -> IO Word) compilePlugged nextIn startIn next alloca start stop nextOut startOut =-   Exec.compileModule $+   Exec.compile "process-plugged" $       liftA3 (,,)          (Exec.createFunction derefStartPtr "startprocess" $           \paramPtr -> do              pptr <- LLVM.malloc-             flip Memory.store pptr . mapSnd Maybe.just =<< start =<< Memory.load paramPtr+             flip Memory.store pptr . mapSnd Maybe.just+                =<< start =<< Memory.load paramPtr              ret pptr)          (Exec.createFunction derefStopPtr "stopprocess" $           \ contextStatePtr -> do@@ -912,7 +888,7 @@              Maybe.for ms $ stop c              LLVM.free contextStatePtr              ret ())-         (Exec.createFunction derefChunkPtr "fillprocess" $+         (Exec.createFunction derefChunkPluggedPtr "fillprocess" $           \ contextStatePtr loopLen inPtr outPtr -> do              (param, msInit) <- Memory.load contextStatePtr              inParam  <- Memory.load inPtr@@ -934,8 +910,8 @@   runStorableChunky ::-   (Storable a, MakeValueTuple a, ValueTuple a ~ valueA, Memory.C valueA,-    Storable b, MakeValueTuple b, ValueTuple b ~ valueB, Memory.C valueB) =>+   (Storable.C a, Tuple.ValueOf a ~ valueA,+    Storable.C b, Tuple.ValueOf b ~ valueB) =>    T p valueA valueB ->    IO (p -> SVL.Vector a -> SVL.Vector b) runStorableChunky proc =@@ -948,12 +924,11 @@ because it does not have the risk of a memory leak. -} runStorableChunkyCont ::-   (Storable a, MakeValueTuple a, ValueTuple a ~ valueA, Memory.C valueA,-    Storable b, MakeValueTuple b, ValueTuple b ~ valueB, Memory.C valueB) =>+   (Storable.C a, Tuple.ValueOf a ~ valueA,+    Storable.C b, Tuple.ValueOf b ~ valueB) =>    T p valueA valueB ->    IO ((SVL.Vector a -> SVL.Vector b) ->-       p ->-       SVL.Vector a -> SVL.Vector b)+       p -> SVL.Vector a -> SVL.Vector b) runStorableChunkyCont       (Cons next alloca start stop createIOContext deleteIOContext) = do    (startFunc, stopFunc, fill) <- compileChunky next alloca start stop@@ -962,7 +937,8 @@       SVL.fromChunks $ Unsafe.performIO $ do          (ioContext, param) <- createIOContext p -         when False $ DebugCnt.with DebugSt.dumpCounter $ do+         when False $+            DebugCnt.next DebugSt.dumpCounter >>=             DebugSt.dump "param" param           statePtr <- ForeignPtr.newParam stopFunc startFunc param@@ -974,13 +950,10 @@                   [] -> return []                   x:xs -> SVB.withStartPtr x $ \aPtr size -> do                      v <--                        withForeignPtr statePtr $ \sptr ->+                        ForeignPtr.with statePtr $ \sptr ->                         SVB.createAndTrim size $                         fmap fromIntegral .-                        fill sptr-                           (fromIntegral size)-                           (Memory.castTuplePtr aPtr) .-                        Memory.castTuplePtr+                        fill sptr (fromIntegral size) aPtr                      touchForeignPtr ioContextPtr                      (if SV.length v > 0                         then fmap (v:)@@ -993,8 +966,8 @@          go (SVL.chunks sig)  applyStorableChunky ::-   (Storable a, MakeValueTuple a, ValueTuple a ~ valueA, Memory.C valueA,-    Storable b, MakeValueTuple b, ValueTuple b ~ valueB, Memory.C valueB) =>+   (Storable.C a, Tuple.ValueOf a ~ valueA,+    Storable.C b, Tuple.ValueOf b ~ valueB) =>    T p valueA valueB ->    p -> SVL.Vector a -> SVL.Vector b applyStorableChunky gen =@@ -1044,24 +1017,19 @@          (contextIn, paramIn)  <- createIn a          (contextOut,paramOut) <- createOut maximumSize          actualSize <--            AllocUtil.with paramIn $ \inptr ->-            AllocUtil.with paramOut $ \outptr ->-            fill paramPtr-               (fromIntegral maximumSize)-               (Memory.castTuplePtr inptr)-               (Memory.castTuplePtr outptr)+            Marshal.with paramIn $ \inptr ->+            Marshal.with paramOut $ \outptr ->+            fill paramPtr (fromIntegral maximumSize) inptr outptr          deleteIn contextIn          b <- deleteOut (fromIntegral actualSize) contextOut          return (b, s))       (do          (ioContext, param) <- createIOContext p -         when False $ DebugCnt.with DebugSt.dumpCounter $ do+         when False $+            DebugCnt.next DebugSt.dumpCounter >>=             DebugSt.dump "param" param--         contextStatePtr <--            AllocUtil.with param-               (startFunc . Memory.castTuplePtr)+         contextStatePtr <- Marshal.with param startFunc           return (ioContext, contextStatePtr))       (\(ioContext, contextStatePtr) -> do
src/Synthesizer/LLVM/CausalParameterized/ProcessPacked.hs view
@@ -17,20 +17,21 @@    CausalS.arrayElement,    ) where -import Synthesizer.LLVM.CausalParameterized.ProcessPrivate (T, )+import Synthesizer.LLVM.CausalParameterized.ProcessPrivate (T) import qualified Synthesizer.LLVM.CausalParameterized.Process as CausalP import qualified Synthesizer.LLVM.Causal.ProcessPacked as CausalS import qualified Synthesizer.LLVM.Causal.Process as Causal-import qualified Synthesizer.LLVM.Parameter as Param import qualified Synthesizer.LLVM.Frame as Frame import qualified Synthesizer.LLVM.Frame.SerialVector as Serial import qualified Synthesizer.LLVM.Frame.Stereo as Stereo +import qualified LLVM.DSL.Parameter as Param+ import qualified LLVM.Extra.ScalarOrVector as SoV import qualified LLVM.Extra.Vector as Vector-import qualified LLVM.Extra.Memory as Memory+import qualified LLVM.Extra.Marshal as Marshal+import qualified LLVM.Extra.Tuple as Tuple import qualified LLVM.Extra.Arithmetic as A-import LLVM.Extra.Class (MakeValueTuple, ValueTuple, )  import qualified LLVM.Core as LLVM import LLVM.Core (CodeGenFunction, Value, IsSized, IsArithmetic, IsPrimitive)@@ -39,19 +40,14 @@  import qualified Control.Category as Cat -import Data.Tuple.HT (swap, )--import Foreign.Storable (Storable, )+import Data.Tuple.HT (swap)  import NumericPrelude.Numeric-import NumericPrelude.Base hiding (and, iterate, map, zip, zipWith, )+import NumericPrelude.Base hiding (and, iterate, map, zip, zipWith)   raise ::-   (Storable a, IsArithmetic a,-    MakeValueTuple a, ValueTuple a ~ (Value a),-    IsPrimitive a, Memory.FirstClass a,-    Memory.Stored a ~ am, IsSized am,+   (IsArithmetic a, Marshal.C a, Tuple.ValueOf a ~ Value a, IsPrimitive a,     TypeNum.Positive n) =>    Param.T p a ->    T p (Serial.Value n a) (Serial.Value n a)@@ -60,10 +56,7 @@       (\x y -> Serial.upsample x >>= flip Frame.mix y)  amplify ::-   (Storable a, IsArithmetic a,-    MakeValueTuple a, ValueTuple a ~ (Value a),-    IsPrimitive a, Memory.FirstClass a,-    Memory.Stored a ~ am, IsSized am,+   (IsArithmetic a, Marshal.C a, Tuple.ValueOf a ~ Value a, IsPrimitive a,     TypeNum.Positive n) =>    Param.T p a ->    T p (Serial.Value n a) (Serial.Value n a)@@ -72,10 +65,7 @@       (\x y -> Serial.upsample x >>= flip Frame.amplifyMono y)  amplifyStereo ::-   (Storable a, IsArithmetic a,-    MakeValueTuple a, ValueTuple a ~ (Value a),-    IsPrimitive a, Memory.FirstClass a,-    Memory.Stored a ~ am, IsSized am,+   (IsArithmetic a, Marshal.C a, Tuple.ValueOf a ~ Value a, IsPrimitive a,     TypeNum.Positive n) =>    Param.T p a ->    T p (Stereo.T (Serial.Value n a)) (Stereo.T (Serial.Value n a))@@ -87,8 +77,7 @@ -- for backwards compatibility osciSimple ::    (Causal.C process,-    Memory.FirstClass t, Memory.Stored t ~ tm, IsSized t, IsSized tm,-    Vector.Real t, SoV.Fraction t, LLVM.IsFloating t,+    Vector.Real t, SoV.Fraction t, LLVM.IsFloating t, IsSized t,     TypeNum.Positive n) =>    (forall r. Serial.Value n t -> CodeGenFunction r y) ->    process (Serial.Value n t, Serial.Value n t) y@@ -97,9 +86,7 @@  delay1 ::    (Serial.C va, n ~ Serial.Size va, al ~ Serial.Element va,-    Storable a,-    MakeValueTuple a, ValueTuple a ~ al,-    Memory.C al) =>+    Marshal.C a, Tuple.ValueOf a ~ al) =>    Param.T p a -> T p va va delay1 initial =    CausalP.loop initial $@@ -108,16 +95,13 @@ differentiate ::    (Serial.C va, n ~ Serial.Size va, al ~ Serial.Element va,     A.Additive va,-    Storable a,-    MakeValueTuple a, ValueTuple a ~ al,-    Memory.C al) =>+    Marshal.C a, Tuple.ValueOf a ~ al) =>    Param.T p a -> T p va va differentiate initial =    Cat.id - delay1 initial  integrate ::-   (Storable a, MakeValueTuple a, ValueTuple a ~ Value a, Vector.Arithmetic a,-    Memory.FirstClass a, Memory.Stored a ~ am, IsSized am,+   (Vector.Arithmetic a, Marshal.C a, Tuple.ValueOf a ~ Value a, IsPrimitive a,     TypeNum.Positive n) =>    Param.T p a ->    T p (Serial.Value n a) (Serial.Value n a)
src/Synthesizer/LLVM/CausalParameterized/ProcessPrivate.hs view
@@ -6,64 +6,61 @@ module Synthesizer.LLVM.CausalParameterized.ProcessPrivate where  import qualified Synthesizer.LLVM.Parameterized.SignalPrivate as Sig-import qualified Synthesizer.LLVM.Parameter as Param import qualified Synthesizer.LLVM.Causal.ProcessPrivate as CausalPriv import qualified Synthesizer.LLVM.Causal.Process as Causal-import Synthesizer.LLVM.Causal.ProcessPrivate (loopNext, )-import Synthesizer.LLVM.Causal.Process (mapProc, zipProcWith, )+import qualified Synthesizer.LLVM.ForeignPtr as ForeignPtr+import Synthesizer.LLVM.Causal.ProcessPrivate (loopNext)+import Synthesizer.LLVM.Causal.Process (mapProc, zipProcWith)+import Synthesizer.LLVM.Simple.SignalPrivate (proxyFromElement2)  import qualified Synthesizer.Causal.Class as CausalClass import qualified Synthesizer.Causal.Utility as ArrowUtil +import qualified LLVM.DSL.Parameter as Param++import qualified LLVM.Extra.Tuple as Tuple import qualified LLVM.Extra.Control as C import qualified LLVM.Extra.Arithmetic as A import qualified LLVM.Extra.MaybeContinuation as MaybeCont+import qualified LLVM.Extra.Marshal as Marshal import qualified LLVM.Extra.Memory as Memory-import LLVM.Extra.Class (MakeValueTuple, ValueTuple, Undefined, ) +import qualified LLVM.ExecutionEngine as EE import qualified LLVM.Core as LLVM-import LLVM.Util.Loop (Phi, )-import LLVM.Core (CodeGenFunction, Value, valueOf, )+import LLVM.Core (CodeGenFunction, Value, valueOf) -import Type.Data.Num.Decimal (d1, )+import Type.Data.Num.Decimal (d1)  import qualified Control.Monad.HT as M import qualified Control.Arrow    as Arr import qualified Control.Category as Cat-import Control.Arrow (arr, (^<<), (<<<), (&&&), )-import Control.Applicative (Applicative, pure, (<*>), (<$>), )-import Data.Tuple.HT (mapSnd, )+import Control.Arrow (arr, (^<<), (<<<), (&&&))+import Control.Applicative (Applicative, pure, (<*>), (<$>))+import Data.Tuple.HT (mapSnd) -import qualified Synthesizer.LLVM.Storable.Vector as SVU-import qualified Data.StorableVector as SV+import Data.Word (Word) -import Data.Word (Word32, )-import Foreign.Storable.Tuple ()-import Foreign.Storable (Storable, )-import Foreign.ForeignPtr (ForeignPtr, touchForeignPtr, )-import Foreign.Ptr (Ptr, )+import Foreign.ForeignPtr (ForeignPtr, touchForeignPtr, mallocForeignPtrBytes) +import qualified System.Unsafe as Unsafe+ import qualified Number.Ratio as Ratio import qualified Algebra.Field as Field import qualified Algebra.Ring as Ring import qualified Algebra.Additive as Additive  import NumericPrelude.Numeric-import NumericPrelude.Base hiding (and, iterate, map, zip, zipWith, take, takeWhile, init, )+import NumericPrelude.Base hiding (and, iterate, map, zip, zipWith, take, takeWhile, init)  import qualified Prelude as P   data T p a b =    forall context state local ioContext parameters.-      (Storable parameters,-       MakeValueTuple parameters,-       Memory.C (ValueTuple parameters),-       Memory.C context,-       Memory.C state) =>+      (Marshal.C parameters, Memory.C context, Memory.C state) =>    Cons       (forall r c.-       (Phi c) =>+       (Tuple.Phi c) =>        context -> local ->        a -> state -> MaybeCont.T r c (b, state))           -- compute next value@@ -71,7 +68,7 @@        CodeGenFunction r local)           -- allocate temporary variables before a loop       (forall r.-       ValueTuple parameters ->+       Tuple.ValueOf parameters ->        CodeGenFunction r (context, state))           -- initial state       (forall r.@@ -111,20 +108,16 @@   simple ::-   (Storable parameters,-    MakeValueTuple parameters, ValueTuple parameters ~ paramValue,-    Memory.C paramValue,-    Memory.C context,-    Memory.C state) =>+   (Marshal.C parameters, Memory.C context, Memory.C state) =>    (forall r c.-    (Phi c) =>+    (Tuple.Phi c) =>     context -> a -> state -> MaybeCont.T r c (b, state)) ->    (forall r.-    paramValue ->+    Tuple.ValueOf parameters ->     CodeGenFunction r (context, state)) ->    Param.T p parameters -> T p a b simple f start param =-   Param.with param $ \get value ->+   Param.withValue param $ \get value ->    Cons       (\context () -> f context)       (return ())@@ -152,8 +145,8 @@   mapAccum ::-   (Storable pnh, MakeValueTuple pnh, ValueTuple pnh ~ pnl, Memory.C pnl,-    Storable psh, MakeValueTuple psh, ValueTuple psh ~ psl, Memory.C psl,+   (Marshal.C pnh, Tuple.ValueOf pnh ~ pnl,+    Marshal.C psh, Tuple.ValueOf psh ~ psl,     Memory.C s) =>    (forall r. pnl -> a -> s -> CodeGenFunction r (b,s)) ->    (forall r. psl -> CodeGenFunction r s) ->@@ -168,7 +161,7 @@   map ::-   (Storable ph, MakeValueTuple ph, ValueTuple ph ~ pl, Memory.C pl) =>+   (Marshal.C ph, Tuple.ValueOf ph ~ pl) =>    (forall r. pl -> a -> CodeGenFunction r b) ->    Param.T p ph ->    T p a b@@ -186,7 +179,7 @@    map (const f) (return ())  zipWith ::-   (Storable ph, MakeValueTuple ph, ValueTuple ph ~ pl, Memory.C pl) =>+   (Marshal.C ph, Tuple.ValueOf ph ~ pl) =>    (forall r. pl -> a -> b -> CodeGenFunction r c) ->    Param.T p ph ->    T p (a,b) c@@ -278,20 +271,20 @@ But you may also use it for a parallel replication, see 'replicateParallel'. -} replicateControlled ::-   (Undefined x, Phi x) =>+   (Tuple.Undefined x, Tuple.Phi x) =>    Param.T p Int -> T p (c,x) x -> T p (c,x) x replicateControlled       n (Cons next alloca start stop createIOContext deleteIOContext) =-   case Param.word32 n of+   case Param.wordInt n of       n32 -> Cons          (\(len, cs) ->-            replicateControlledNext next stop (Param.value n32 len, cs))+            replicateControlledNext next stop (Param.valueTuple n32 len, cs))          (-- we re-use the temporary variable for all stages)           alloca)          (\(len, param) ->-            replicateControlledStart start (Param.value n32 len, param))+            replicateControlledStart start (Param.valueTuple n32 len, param))          (\(len, cs) ->-            replicateControlledStop stop (Param.value n32 len, cs))+            replicateControlledStop stop (Param.valueTuple n32 len, cs))          (\p ->             replicateControlledCreate $                M.replicate (Param.get n p) (createIOContext p))@@ -301,12 +294,12 @@    (Memory.C context, Memory.C state,     contextState ~        LLVM.Struct (Memory.Struct context, (Memory.Struct state, ())),-    Phi z, Phi a, Undefined a) =>-   (forall z0. (Phi z0) =>+    Tuple.Phi z, Tuple.Phi a, Tuple.Undefined a) =>+   (forall z0. (Tuple.Phi z0) =>     context -> local -> (ctrl, a) -> state ->     MaybeCont.T r z0 (a, state)) ->    (context -> state -> CodeGenFunction r ()) ->-   (Value Word32, Value (Ptr contextState)) ->+   (Value Word, Value (LLVM.Ptr contextState)) ->    local ->    (ctrl, a) ->    () ->@@ -329,9 +322,9 @@    (Memory.C a, Memory.C b,     ab ~ LLVM.Struct (Memory.Struct a, (Memory.Struct b, ()))) =>    (a -> b -> CodeGenFunction r ()) ->-   Value Word32 ->-   Value (Ptr ab) ->-   Value (Ptr ab) ->+   Value Word ->+   Value (LLVM.Ptr ab) ->+   Value (LLVM.Ptr ab) ->    CodeGenFunction r () replicateControlledStopExcept stop len contextStates contextStatePtr =    C.arrayLoop len contextStates () $ \ptr () -> do@@ -342,11 +335,11 @@    (Memory.C context, Memory.C state,     contextState ~        LLVM.Struct (Memory.Struct context, (Memory.Struct state, ())),-    Phi z, Phi a, Undefined a) =>-   (forall z0. (Phi z0) =>+    Tuple.Phi z, Tuple.Phi a, Tuple.Undefined a) =>+   (forall z0. (Tuple.Phi z0) =>     context -> (ctrl, a) -> state ->     MaybeCont.T r z0 (a, state)) ->-   (Value Word32, Value (Ptr contextState)) ->+   (Value Word, Value (LLVM.Ptr contextState)) ->    (ctrl, a) ->    () ->    MaybeCont.T r z (a, ())@@ -362,8 +355,8 @@ replicateControlledStart ::    (Memory.C a, Memory.C b) =>    (a -> CodeGenFunction r b) ->-   (Value Word32, Value (Ptr (Memory.Struct a))) ->-   CodeGenFunction r ((Value Word32, Value (Ptr (Memory.Struct b))), ())+   (Value Word, Value (LLVM.Ptr (Memory.Struct a))) ->+   CodeGenFunction r ((Value Word, Value (LLVM.Ptr (Memory.Struct b))), ()) replicateControlledStart start (len, params) = do    contextStates <- LLVM.arrayMalloc len    C.arrayLoop2 len params contextStates () $ \paramPtr statePtr () ->@@ -374,7 +367,7 @@    (Memory.C a, Memory.C b,     ab ~ LLVM.Struct (Memory.Struct a, (Memory.Struct b, ()))) =>    (a -> b -> CodeGenFunction r ()) ->-   (Value Word32, Value (Ptr ab)) ->+   (Value Word, Value (LLVM.Ptr ab)) ->    () ->    CodeGenFunction r () replicateControlledStop stop (len, contextStates) () = do@@ -384,16 +377,20 @@   replicateControlledCreate ::-   (Monad m, MakeValueTuple b, Storable b, ValueTuple b ~ bl, Memory.C bl) =>+   (Monad m, Marshal.C b, Marshal.Struct b ~ struct) =>    m [(a, b)] ->-   m (([a], ForeignPtr b),-      (Word32, Ptr (Memory.Struct bl)))+   m (([a], ForeignPtr.MemoryPtr struct), (Word, LLVM.Ptr struct)) replicateControlledCreate createIOContexts = do    (ioContexts, params) <- M.lift unzip createIOContexts-   let (fptr, ptr, len) = SVU.unsafeToPointers $ SV.pack params-   return-      ((ioContexts, fptr),-       (fromIntegral len, ptr))+   let len = length params+   let fptr = Unsafe.performIO $ do+         fptr0 <-+            mallocForeignPtrBytes $ EE.sizeOfArray (proxyFromElement2 fptr) len+         ForeignPtr.with fptr0 $ flip EE.pokeList (fmap Marshal.pack params)+         return fptr0+   return ((ioContexts, fptr),+           (fromIntegral len,+            EE.castFromStoredPtr $ Unsafe.foreignPtrToPtr fptr))  replicateControlledDelete ::    (a -> IO ()) ->@@ -461,10 +458,10 @@ in a way that allows to access a result before creating the input. -} loop ::-   (Storable c, MakeValueTuple c, ValueTuple c ~ cl, Memory.C cl) =>+   (Marshal.C c, Tuple.ValueOf c ~ cl) =>    Param.T p c -> T p (a,cl) (b,cl) -> T p a b loop initial (Cons next alloca start stop createIOContext deleteIOContext) =-   Param.with initial $ \getInitial valueInitial -> Cons+   Param.withValue initial $ \getInitial valueInitial -> Cons       (curry $ loopNext $ uncurry next)       alloca       (\(i,p) -> fmap (mapSnd ((,) (valueInitial i))) $ start p)@@ -479,7 +476,7 @@   takeWhile ::-   (Storable ph, MakeValueTuple ph, ValueTuple ph ~ pl, Memory.C pl) =>+   (Marshal.C ph, Tuple.ValueOf ph ~ pl) =>    (forall r. pl -> a -> CodeGenFunction r (Value Bool)) ->    Param.T p ph ->    T p a a@@ -496,10 +493,10 @@    T p a a take len =    snd ^<<-   takeWhile (const $ A.cmp LLVM.CmpLT A.zero . fst) (return ()) <<<+   Causal.takeWhile (A.cmp LLVM.CmpLT A.zero . fst) <<<    feedFst       (Sig.iterate (const A.dec) (return ())-         (Param.word32 $ max 0 ^<< len))+         (Param.wordInt $ max 0 ^<< len))   {- |@@ -507,16 +504,14 @@ Thus 'integrate' delays by one sample compared with 'integrateSync'. -} integrate ::-   (Storable a, A.Additive al,-    MakeValueTuple a, ValueTuple a ~ al, Memory.C al) =>+   (Marshal.C a, Tuple.ValueOf a ~ al, A.Additive al) =>    Param.T p a ->    T p al al integrate =    flip loop (arr snd &&& zipWithSimple A.add)  integrateSync ::-   (Storable a, A.Additive al,-    MakeValueTuple a, ValueTuple a ~ al, Memory.C al) =>+   (Marshal.C a, Tuple.ValueOf a ~ al, A.Additive al) =>    Param.T p a ->    T p al al integrateSync =
src/Synthesizer/LLVM/CausalParameterized/ProcessValue.hs view
@@ -12,29 +12,28 @@    takeWhile,    ) where -import Synthesizer.LLVM.CausalParameterized.ProcessPrivate (T, )+import Synthesizer.LLVM.CausalParameterized.ProcessPrivate (T) import qualified Synthesizer.LLVM.CausalParameterized.ProcessPrivate as CausalP import qualified Synthesizer.LLVM.Causal.ProcessValue as CausalV import qualified Synthesizer.LLVM.Simple.Value as Value-import qualified Synthesizer.LLVM.Parameter as Param +import qualified LLVM.DSL.Parameter as Param++import qualified LLVM.Extra.Tuple as Tuple+import qualified LLVM.Extra.Marshal as Marshal import qualified LLVM.Extra.Memory as Memory-import LLVM.Extra.Class (MakeValueTuple, ValueTuple, )  import qualified LLVM.Core as LLVM -import Foreign.Storable.Tuple ()-import Foreign.Storable (Storable, )--import Prelude hiding (map, zipWith, takeWhile, )+import Prelude hiding (map, zipWith, takeWhile)   {- simple ::    (Storable startParamTuple,     Storable nextParamTuple,-    MakeValueTuple startParamTuple, ValueTuple startParamTuple ~ startParamValue,-    MakeValueTuple nextParamTuple, ValueTuple nextParamTuple ~ nextParamValue,+    Tuple.Value startParamTuple, Tuple.ValueOf startParamTuple ~ startParamValue,+    Tuple.Value nextParamTuple, Tuple.ValueOf nextParamTuple ~ nextParamValue,     Memory.C startParamValue,     Memory.C nextParamValue,     Memory.C state) =>@@ -55,7 +54,7 @@ -}  map ::-   (Storable ph, MakeValueTuple ph, ValueTuple ph ~ pl, Memory.C pl) =>+   (Marshal.C ph, Tuple.ValueOf ph ~ pl) =>    (Value.T pl -> Value.T a -> Value.T b) ->    Param.T p ph ->    T p a b@@ -67,7 +66,7 @@ mapSimple = CausalV.map  zipWith ::-   (Storable ph, MakeValueTuple ph, ValueTuple ph ~ pl, Memory.C pl) =>+   (Marshal.C ph, Tuple.ValueOf ph ~ pl) =>    (Value.T pl -> Value.T a -> Value.T b -> Value.T c) ->    Param.T p ph -> T p (a,b) c zipWith f =@@ -79,8 +78,8 @@ zipWithSimple = CausalV.zipWith  mapAccum ::-   (Storable pnh, MakeValueTuple pnh, ValueTuple pnh ~ pnl, Memory.C pnl,-    Storable psh, MakeValueTuple psh, ValueTuple psh ~ psl, Memory.C psl,+   (Marshal.C pnh, Tuple.ValueOf pnh ~ pnl,+    Marshal.C psh, Tuple.ValueOf psh ~ psl,     Memory.C s) =>    (Value.T pnl -> Value.T a -> Value.T s -> (Value.T b, Value.T s)) ->    (Value.T psl -> Value.T s) ->@@ -93,7 +92,7 @@       (Value.unlift1 start)  takeWhile ::-   (Storable ph, MakeValueTuple ph, ValueTuple ph ~ pl, Memory.C pl) =>+   (Marshal.C ph, Tuple.ValueOf ph ~ pl) =>    (Value.T pl -> Value.T a -> Value.T (LLVM.Value Bool)) ->    Param.T p ph ->    T p a a
src/Synthesizer/LLVM/CausalParameterized/RingBuffer.hs view
@@ -8,13 +8,11 @@ import Synthesizer.LLVM.RingBuffer  import qualified Synthesizer.LLVM.CausalParameterized.ProcessPrivate as CausalP-import qualified Synthesizer.LLVM.Parameter as Param+import qualified LLVM.DSL.Parameter as Param +import qualified LLVM.Extra.Marshal as Marshal import qualified LLVM.Extra.Memory as Memory-import qualified LLVM.Extra.Class as Class--import Foreign.Storable.Tuple ()-import Foreign.Storable (Storable, )+import qualified LLVM.Extra.Tuple as Tuple   {- |@@ -29,12 +27,11 @@ The initial value is also needed for determining the ring buffer element type. -} track ::-   (Storable a, Class.MakeValueTuple a,-    Class.ValueTuple a ~ al, Memory.C al) =>+   (Marshal.C a, Tuple.ValueOf a ~ al) =>    Param.T p a -> Param.T p Int -> CausalP.T p al (T al) track initial time =-   Param.with initial $ \getInitial valueInitial ->-   Param.with (Param.word32 time) $ \getTime valueTime ->+   Param.withValue initial $ \getInitial valueInitial ->+   Param.withValue (Param.wordInt time) $ \getTime valueTime ->       CausalP.Cons          (trackNext valueTime)          (return ())@@ -52,7 +49,7 @@ -} trackConst :: (Memory.C al) => al -> Param.T p Int -> CausalP.T p al (T al) trackConst initial time =-   Param.with (Param.word32 time) $ \getTime valueTime ->+   Param.withValue (Param.wordInt time) $ \getTime valueTime ->       CausalP.Cons          (trackNext valueTime)          (return ())
src/Synthesizer/LLVM/CausalParameterized/RingBufferForward.hs view
@@ -10,29 +10,28 @@                                                               as CausalPrivP import qualified Synthesizer.LLVM.CausalParameterized.Process as CausalP import qualified Synthesizer.LLVM.Parameterized.SignalPrivate as SigP-import qualified Synthesizer.LLVM.Parameter as Param-import Synthesizer.LLVM.CausalParameterized.Process (($<), ($*), )+import Synthesizer.LLVM.CausalParameterized.Process (($<), ($*))+import Synthesizer.LLVM.RingBuffer (MemoryPtr) +import qualified LLVM.DSL.Parameter as Param+ import qualified LLVM.Extra.MaybeContinuation as MaybeCont import qualified LLVM.Extra.Maybe as Maybe import qualified LLVM.Extra.Memory as Memory import qualified LLVM.Extra.Control as C import qualified LLVM.Extra.Arithmetic as A-import qualified LLVM.Extra.Class as Class+import qualified LLVM.Extra.Tuple as Tuple  import qualified LLVM.Core as LLVM-import LLVM.Util.Loop (Phi, )-import LLVM.Core (CodeGenFunction, Value, )+import LLVM.Core (CodeGenFunction, Value) -import Control.Arrow ((<<<), )-import Control.Applicative (pure, )-import Data.Tuple.HT (mapSnd, )+import Control.Arrow ((<<<))+import Control.Applicative (pure)+import Data.Tuple.HT (mapSnd) -import Data.Word (Word32, )-import Foreign.Storable.Tuple ()-import Foreign.Ptr (Ptr, )+import Data.Word (Word) -import Prelude hiding (length, )+import Prelude hiding (length)   {- |@@ -67,9 +66,9 @@ -} data T a =    Cons {-      buffer :: Value (Ptr (Memory.Struct a)),-      length :: Value Word32,-      current :: Value Word32+      buffer :: Value (MemoryPtr a),+      length :: Value Word,+      current :: Value Word    }  {- |@@ -79,9 +78,7 @@ Index zero refers to the current sample and index @time-1@ refers to the one that is farthermost in the future. -}-index ::-   (Memory.C a) =>-   Value Word32 -> T a -> CodeGenFunction r a+index :: (Memory.C a) => Value Word -> T a -> CodeGenFunction r a index i rb = do    k <- flip A.irem (length rb) =<< A.add (current rb) i    Memory.load =<< LLVM.getElementPtr (buffer rb) (k, ())@@ -94,9 +91,7 @@  The @time@ parameter must be non-negative. -}-track ::-   (Memory.C a) =>-   Param.T p Int -> SigP.T p a -> SigP.T p (T a)+track :: (Memory.C a) => Param.T p Int -> SigP.T p a -> SigP.T p (T a) track time input = trackSkip time input $* 1  {- |@@ -108,9 +103,9 @@ -} trackSkip ::    (Memory.C a) =>-   Param.T p Int -> SigP.T p a -> CausalP.T p (Value Word32) (T a)+   Param.T p Int -> SigP.T p a -> CausalP.T p (Value Word) (T a) trackSkip time (SigP.Cons next alloca start stop create delete) =-   Param.with (Param.word32 time) $ \getTime valueTime ->+   Param.withValue (Param.wordInt time) $ \getTime valueTime ->       CausalPrivP.Cons          (trackNext next valueTime)          alloca@@ -125,7 +120,7 @@ The returned 'Bool' flag is 'True' if a skip could be performed completely and it is 'False' if the skip exceeds the end of the input. That is, once a 'False' is returned all following values are tagged with 'False'.-The returned 'Word32' value is the number of actually skipped values.+The returned 'Word' value is the number of actually skipped values. This lags one step behind the input of skip values. The number of an actual number of skips is at most the number of requested skips.@@ -143,7 +138,7 @@ trackSkipHold, trackSkipHold_ ::    (Memory.C a) =>    Param.T p Int -> SigP.T p a ->-   CausalP.T p (Value Word32) ((Value Bool, Value Word32), T a)+   CausalP.T p (Value Word) ((Value Bool, Value Word), T a) trackSkipHold time xs =    (CausalP.zipWithSimple        (\b ((c,x), buf) -> do@@ -158,7 +153,7 @@    trackSkipHold_ time xs  trackSkipHold_ time (SigP.Cons next alloca start stop create delete) =-   (Param.with (Param.word32 time) $ \getTime valueTime ->+   (Param.withValue (Param.wordInt time) $ \getTime valueTime ->       CausalPrivP.Cons          (trackNextHold next valueTime)          alloca@@ -169,15 +164,15 @@   trackNext ::-   (Memory.C al, Memory.Struct al ~ am, Phi z,-    Phi state, Class.Undefined state) =>-   (forall z0. (Phi z0) =>+   (Memory.C al, Tuple.Phi z,+    Tuple.Phi state, Tuple.Undefined state) =>+   (forall z0. (Tuple.Phi z0) =>     context -> local -> state -> MaybeCont.T r z0 (al, state)) ->-   (tl -> Value Word32) ->-   (context, (tl, Value (Ptr am))) -> local ->-   Value Word32 ->-   (Value Word32, (state, Value Word32)) ->-   MaybeCont.T r z (T al, (Value Word32, (state, Value Word32)))+   (tl -> Value Word) ->+   (context, (tl, Value (MemoryPtr al))) -> local ->+   Value Word ->+   (Value Word, (state, Value Word)) ->+   MaybeCont.T r z (T al, (Value Word, (state, Value Word))) trackNext next valueTime (context, (size,ptr)) local n1 (n0, statePos) = do    let size0 = valueTime size    (state3, pos3) <-@@ -189,14 +184,13 @@    return (Cons ptr size0 pos3, (n1, (state3, pos3)))  trackStart ::-   (LLVM.IsSized am,-    Phi state, Class.Undefined state) =>+   (LLVM.IsSized am, Tuple.Phi state, Tuple.Undefined state) =>    (param -> CodeGenFunction r (context, state)) ->-   (tl -> Value Word32) ->+   (tl -> Value Word) ->    (param, tl) ->    CodeGenFunction r-      ((context, (tl, Value (Ptr am))),-       (Value Word32, (state, Value Word32)))+      ((context, (tl, Value (LLVM.Ptr am))),+       (Value Word, (state, Value Word))) trackStart start valueTime (param, size) = do    (context, state) <- start param    let size0 = valueTime size@@ -206,8 +200,8 @@ trackStop ::    (LLVM.IsType am) =>    (context -> state -> CodeGenFunction r ()) ->-   (context, (tl, Value (Ptr am))) ->-   (Value Word32, (state, Value Word32)) ->+   (context, (tl, Value (LLVM.Ptr am))) ->+   (Value Word, (state, Value Word)) ->    CodeGenFunction r () trackStop stop (context, (_size,ptr)) (_n, (state, _remain)) = do    LLVM.free ptr@@ -215,17 +209,17 @@   trackNextHold ::-   (Memory.C al, Memory.Struct al ~ am, Phi z,-    Phi state, Class.Undefined state) =>-   (forall z0. (Phi z0) =>+   (Memory.C al, Tuple.Phi z,+    Tuple.Phi state, Tuple.Undefined state) =>+   (forall z0. (Tuple.Phi z0) =>     context -> local -> state -> MaybeCont.T r z0 (al, state)) ->-   (tl -> Value Word32) ->-   (context, (tl, Value (Ptr am))) -> local ->-   Value Word32 ->-   (Value Word32, (Maybe.T state, Value Word32)) ->+   (tl -> Value Word) ->+   (context, (tl, Value (MemoryPtr al))) -> local ->+   Value Word ->+   (Value Word, (Maybe.T state, Value Word)) ->    MaybeCont.T r z-      (((Value Bool, Value Word32), T al),-       (Value Word32, (Maybe.T state, Value Word32)))+      (((Value Bool, Value Word), T al),+       (Value Word, (Maybe.T state, Value Word))) trackNextHold    next valueTime (context, (size,ptr)) local nNext (n0, (mstate0, pos0)) =       MaybeCont.lift $ do@@ -252,9 +246,9 @@            (nNext, (state3, pos3)))  storeNext ::-   (Memory.C al, Memory.Struct al ~ am) =>-   (Value Word32, Value (Ptr am)) ->-   al -> Value Word32 -> CodeGenFunction r (Value Word32)+   (Memory.C al) =>+   (Value Word, Value (MemoryPtr al)) ->+   al -> Value Word -> CodeGenFunction r (Value Word) storeNext (size0,ptr) a pos0 = do    Memory.store a =<< LLVM.getElementPtr ptr (pos0, ())    pos1 <- A.inc pos0@@ -264,13 +258,13 @@  trackStartHold ::    (LLVM.IsSized am,-    Phi state, Class.Undefined state) =>+    Tuple.Phi state, Tuple.Undefined state) =>    (param -> CodeGenFunction r (context, state)) ->-   (tl -> Value Word32) ->+   (tl -> Value Word) ->    (param, tl) ->    CodeGenFunction r-      ((context, (tl, Value (Ptr am))),-       (Value Word32, (Maybe.T state, Value Word32)))+      ((context, (tl, Value (LLVM.Ptr am))),+       (Value Word, (Maybe.T state, Value Word))) trackStartHold start valueTime (param, size) = do    (context, state) <- start param    let size0 = valueTime size@@ -280,8 +274,8 @@ trackStopHold ::    (LLVM.IsType am) =>    (context -> state -> CodeGenFunction r ()) ->-   (context, (tl, Value (Ptr am))) ->-   (Value Word32, (Maybe.T state, Value Word32)) ->+   (context, (tl, Value (LLVM.Ptr am))) ->+   (Value Word, (Maybe.T state, Value Word)) ->    CodeGenFunction r () trackStopHold stop (context, (_size,ptr)) (_n, (state, _remain)) = do    LLVM.free ptr
src/Synthesizer/LLVM/Complex.hs view
@@ -12,22 +12,17 @@ import qualified Synthesizer.LLVM.Simple.Value as Value  import qualified LLVM.Extra.Memory as Memory-import LLVM.Extra.Class (Undefined, undefTuple, )+import qualified LLVM.Extra.Tuple as Tuple  import qualified LLVM.Core as LLVM-import LLVM.Core (Value, ConstValue, IsConst, )-import LLVM.Util.Loop (Phi, phis, addPhis, )+import LLVM.Core (Value, ConstValue, IsConst)  import qualified Type.Data.Num.Decimal      as TypeNum -import Control.Applicative (liftA2, )+import Control.Applicative (liftA2)  import qualified Number.Complex as Complex -{--import NumericPrelude.Numeric-import NumericPrelude.Base--}  type Struct a = LLVM.Struct (a, (a, ())) @@ -47,17 +42,17 @@    Value.lift0 (LLVM.extractvalue x TypeNum.d1)  -instance (Undefined a) => Undefined (Complex.T a) where-   undefTuple = (Complex.+:) undefTuple undefTuple+instance (Tuple.Undefined a) => Tuple.Undefined (Complex.T a) where+   undef = (Complex.+:) Tuple.undef Tuple.undef -instance (Phi a) => Phi (Complex.T a) where-   phis bb v =+instance (Tuple.Phi a) => Tuple.Phi (Complex.T a) where+   phi bb v =       liftA2 (Complex.+:)-         (phis bb (Complex.real v))-         (phis bb (Complex.imag v))-   addPhis bb x y = do-      addPhis bb (Complex.real x) (Complex.real y)-      addPhis bb (Complex.imag x) (Complex.imag y)+         (Tuple.phi bb (Complex.real v))+         (Tuple.phi bb (Complex.imag v))+   addPhi bb x y = do+      Tuple.addPhi bb (Complex.real x) (Complex.real y)+      Tuple.addPhi bb (Complex.imag x) (Complex.imag y)   memory ::
src/Synthesizer/LLVM/ConstantPiece.hs view
@@ -5,11 +5,17 @@ Data type that allows handling of piecewise constant signals independently from the source. -}-module Synthesizer.LLVM.ConstantPiece where+module Synthesizer.LLVM.ConstantPiece (+   T(..),+   Struct,+   parameterMemory,+   flatten,+   piecewiseConstant,+   lazySize,+   ) where  import qualified Synthesizer.LLVM.Parameterized.SignalPrivate as SigP import qualified Synthesizer.LLVM.Simple.SignalPrivate as Sig-import qualified Synthesizer.LLVM.Parameter as Param  import qualified Synthesizer.LLVM.Storable.LazySizeIterator as SizeIt import qualified Data.StorableVector.Lazy.Pattern as SVP@@ -18,44 +24,43 @@ import qualified Data.EventList.Relative.BodyTime as EventList import qualified Numeric.NonNegative.Wrapper as NonNeg +import qualified LLVM.DSL.Parameter as Param+ import qualified LLVM.Extra.MaybeContinuation as Maybe+import qualified LLVM.Extra.Marshal as Marshal import qualified LLVM.Extra.Memory as Memory-import qualified LLVM.Extra.Class as Class+import qualified LLVM.Extra.Tuple as Tuple import qualified LLVM.Extra.Arithmetic as A-import LLVM.Extra.Control (whileLoop, )-import LLVM.Extra.Class (MakeValueTuple, ValueTuple, Undefined, undefTuple, )+import LLVM.Extra.Control (whileLoop) -import LLVM.Util.Loop (Phi, phis, addPhis, )-import LLVM.Core (Value, valueOf, ) import qualified LLVM.Core as LLVM+import LLVM.Core (Value, valueOf) -import Type.Data.Num.Decimal (d0, d1, )+import Type.Data.Num.Decimal (d0, d1) -import Data.Word (Word32, )-import Foreign.Storable.Tuple ()-import Foreign.Storable (Storable, )+import Data.Word (Word) -import Control.Applicative (liftA2, )+import Control.Applicative (liftA2)  import NumericPrelude.Numeric () import NumericPrelude.Base  -data T a = Cons (Value Word32) a+data T a = Cons (Value Word) a -instance (Phi a) => Phi (T a) where-   phis bb (Cons len y) =-      liftA2 Cons (phis bb len) (phis bb y)-   addPhis bb (Cons lenA ya) (Cons lenB yb) =-      addPhis bb lenA lenB >> addPhis bb ya yb+instance (Tuple.Phi a) => Tuple.Phi (T a) where+   phi bb (Cons len y) =+      liftA2 Cons (Tuple.phi bb len) (Tuple.phi bb y)+   addPhi bb (Cons lenA ya) (Cons lenB yb) =+      Tuple.addPhi bb lenA lenB >> Tuple.addPhi bb ya yb -instance (Undefined a) => Undefined (T a) where-   undefTuple = Cons Class.undefTuple Class.undefTuple+instance (Tuple.Undefined a) => Tuple.Undefined (T a) where+   undef = Cons Tuple.undef Tuple.undef -instance (Class.Zero a) => Class.Zero (T a) where-   zeroTuple = Cons Class.zeroTuple Class.zeroTuple+instance (Tuple.Zero a) => Tuple.Zero (T a) where+   zero = Cons Tuple.zero Tuple.zero -type Struct a = LLVM.Struct (Word32, (a, ()))+type Struct a = LLVM.Struct (Word, (a, ()))  parameterMemory ::    (Memory.C a) =>@@ -89,12 +94,12 @@                   Maybe.toBool $ next context s)          length2 <- Maybe.lift (A.dec length1)          return (y1, (Cons length2 y1, s1)))-      (fmap ((,) (Cons A.zero undefTuple)) . start)+      (fmap ((,) (Cons A.zero Tuple.undef)) . start)       (stop . snd))   piecewiseConstant ::-   (Storable a, MakeValueTuple a, ValueTuple a ~ value, Memory.C value) =>+   (Marshal.C a, Tuple.ValueOf a ~ value, Marshal.Struct a ~ struct) =>    Param.T p (EventList.T NonNeg.Int a) ->    SigP.T p (T value) piecewiseConstant evs = SigP.Cons
− src/Synthesizer/LLVM/Debug/Counter.hs 
@@ -1,32 +0,0 @@-module Synthesizer.LLVM.Debug.Counter where--import qualified Control.Monad.Trans.Reader as R-import qualified Data.IORef as IORef-import qualified Data.List.HT as ListHT---newtype T ident = Cons Int-   deriving (Eq, Ord)--instance Enum (T ident) where-   fromEnum (Cons n) = n-   toEnum n = (Cons n)--format :: Int -> T ident -> String-format pad (Cons n) =-   ListHT.padLeft '0' pad (show n)--new :: IO (IORef.IORef (T ident))-new =-   IORef.newIORef (Cons 0)--{--wrap :: (Int -> IO ()) -> R.ReaderT (T ident) IO ()-wrap act =-   R.ReaderT $ \(Cons n) -> act n--}--with :: IORef.IORef (T ident) -> R.ReaderT (T ident) IO () -> IO ()-with cnt act = do-   R.runReaderT act =<< IORef.readIORef cnt-   IORef.modifyIORef cnt succ
− src/Synthesizer/LLVM/Debug/StablePtr.hs 
@@ -1,12 +0,0 @@-module Synthesizer.LLVM.Debug.StablePtr where--import Foreign.StablePtr (StablePtr, castStablePtrToPtr, )-import Control.Monad (when, )---{-# INLINE trace #-}-trace :: String -> StablePtr a -> IO (StablePtr a)-trace name s = do-   when False $-      putStrLn $ "EventIterator." ++ name ++ ": " ++ (show $ castStablePtrToPtr $ s)-   return s
− src/Synthesizer/LLVM/Debug/Storable.hs 
@@ -1,94 +0,0 @@-{-# LANGUAGE Rank2Types #-}-module Synthesizer.LLVM.Debug.Storable where--import qualified Synthesizer.LLVM.Debug.Counter as Counter--import qualified Type.Data.Num.Decimal as TypeNum-import Type.Base.Proxy (Proxy)--import qualified LLVM.Core as LLVM-import LLVM.Core (Array, ConstValue, constOf, )--import qualified System.IO as IO-import Numeric (showHex, )--import qualified Data.IORef as IORef-import qualified Data.List as List-import qualified Foreign.Marshal.Utils as Marshal-import Foreign.Marshal.Array (advancePtr, )-import Foreign.Storable (Storable, peek, peekByteOff, sizeOf, alignment, )-import Foreign.Ptr (Ptr, castPtr, )-import Data.Word (Word8, Word32, )-import qualified System.Unsafe as Unsafe--import qualified Control.Monad.Trans.Reader as R-import Control.Monad (when, )-import Data.Maybe (fromMaybe, )---data Dump = Dump--dumpCounter :: IORef.IORef (Counter.T Dump)-dumpCounter =-   Unsafe.performIO $ Counter.new--format :: Storable a => a -> IO String-format a =-   Marshal.with a $ \ptr ->-      fmap (concatMap (\byte ->-               (if byte<16 then ('0':) else id) (showHex byte ""))) $-      mapM peek-         (List.take (sizeOf a) $-          List.iterate (flip advancePtr 1) $-          (castPtr ptr :: Ptr Word8))--dump :: Storable a => FilePath -> a -> R.ReaderT (Counter.T Dump) IO ()-dump path a =-   R.ReaderT $ \cnt ->-   IO.withBinaryFile-      (path ++ Counter.format 3 cnt ++ ".dump")-      IO.WriteMode $ \h ->-   Marshal.with a $ \ptr ->-   IO.hPutBuf h ptr (sizeOf a)---type ArrayElem = Word32--{--Unfortunately, you cannot 'alloca' or 'malloc' the constructed array,-because an IsSized instance is missing.-We may employ a specialised reifyIntegral for this purpose.--}-withConstArray ::-   Storable a =>-   a ->-   (forall n. TypeNum.Natural n => ConstValue (Array n ArrayElem) -> b) ->-   IO b-withConstArray a f =-   Marshal.with a $ \ptr -> do-      content <--         mapM-            (peekByteOff ptr)-            (takeWhile (< sizeOf a) [0,(sizeOf (undefined :: ArrayElem))..])-          :: IO [ArrayElem]-      return $-         fromMaybe (error "Debug.Storable.withConstArray: length must always be non-negative") $-         TypeNum.reifyNatural (fromIntegral (length content))-            (\n ->-               let makeArray ::-                      TypeNum.Natural n =>-                      Proxy n -> [ConstValue ArrayElem] ->-                      ConstValue (Array n ArrayElem)-                   makeArray _ = LLVM.constArray-               in  f (makeArray n (map constOf content)))---traceMalloc :: Storable a => a -> Int -> Ptr a -> IO (Ptr a)-traceMalloc a size ptr = do-   when False $ putStrLn $-      showString "%addr" . shows ptr .-      showString " = call float* @malloc(i8* getelementptr (i8* null, i32 " .-      shows size .-      showString "))   ; alignment " . shows (alignment a) $-      ""-   return ptr
src/Synthesizer/LLVM/EventIterator.hs view
@@ -6,36 +6,33 @@ import qualified Data.EventList.Relative.BodyTime as EventList import qualified Numeric.NonNegative.Wrapper as NonNeg -import qualified LLVM.Extra.Memory as Memory-import qualified LLVM.Extra.Class as Class+import qualified LLVM.Extra.Marshal as Marshal+import qualified LLVM.Core as LLVM -import Foreign.Storable (Storable, poke, ) import Foreign.StablePtr-          (StablePtr, newStablePtr, freeStablePtr, deRefStablePtr, )-import Foreign.Ptr (FunPtr, Ptr, castPtr, )-import Data.IORef (IORef, newIORef, readIORef, writeIORef, )-import Data.Word (Word32, )+          (StablePtr, newStablePtr, freeStablePtr, deRefStablePtr)+import Foreign.Ptr (FunPtr)+import Data.IORef (IORef, newIORef, readIORef, writeIORef)+import Data.Word (Word) -import Control.Monad ((<=<), )+import Control.Monad ((<=<)) -import qualified Synthesizer.LLVM.Debug.StablePtr as DebugStable+import qualified LLVM.DSL.Debug.StablePtr as DebugStable   {- For problems on constraints, see ChunkIterator. -}-data T a =-   (Storable a, Class.MakeValueTuple a, Memory.C (Class.ValueTuple a)) =>-   Cons (IORef (EventList.T NonNeg.Int a))+data T a = (Marshal.C a) => Cons (IORef (EventList.T NonNeg.Int a)) -type MemoryPtr a = Ptr (Memory.Struct (Class.ValueTuple a))+type MarshalPtr a = LLVM.Ptr (Marshal.Struct a)   foreign import ccall "&nextConstant"-   nextCallBack :: FunPtr (StablePtr (T a) -> MemoryPtr a -> IO Word32)+   nextCallBack :: FunPtr (StablePtr (T a) -> MarshalPtr a -> IO Word)  foreign export ccall "nextConstant"-   next :: StablePtr (T a) -> MemoryPtr a -> IO Word32+   next :: StablePtr (T a) -> MarshalPtr a -> IO Word   {- |@@ -43,9 +40,7 @@ (and for performance reasons it should not contain too many small values, say below 100). -}-new ::-   (Storable a, Class.MakeValueTuple a, Memory.C (Class.ValueTuple a)) =>-   EventList.T NonNeg.Int a -> IO (StablePtr (T a))+new :: (Marshal.C a) => EventList.T NonNeg.Int a -> IO (StablePtr (T a)) new evs =    DebugStable.trace "new" =<<    newStablePtr . Cons@@ -57,7 +52,7 @@ dispose :: StablePtr (T a) -> IO () dispose = freeStablePtr <=< DebugStable.trace "dispose" -next :: StablePtr (T a) -> MemoryPtr a -> IO Word32+next :: StablePtr (T a) -> MarshalPtr a -> IO Word next stable eventPtr =    DebugStable.trace "next" stable >>=    deRefStablePtr >>= \state ->@@ -68,5 +63,5 @@             (return 0)             (\body time xs ->                writeIORef listRef xs >>-               poke (castPtr eventPtr) body >>+               Marshal.poke eventPtr body >>                return (fromIntegral time))
− src/Synthesizer/LLVM/Execution.hs 
@@ -1,89 +0,0 @@-{-# LANGUAGE TypeFamilies #-}-module Synthesizer.LLVM.Execution where--import qualified LLVM.ExecutionEngine as EE-import qualified LLVM.Util.Optimize as Opt-import qualified LLVM.Core as LLVM--import Foreign.Ptr (Ptr, FunPtr, )--import qualified Control.Monad.Trans.Reader as R-import Control.Monad (liftM2, when, void, )-import Control.Applicative (liftA2, pure, (<$>), )--import qualified Data.IORef as IORef-import Data.Functor.Compose (Compose(Compose))--import qualified System.Unsafe as Unsafe--import qualified Synthesizer.LLVM.Debug.Counter as Counter---type Importer f = FunPtr f -> f--data BitCodeCnt = BitCodeCnt--{- |-This is only for debugging purposes-and thus I felt free to use unsafePerformIO.--}-counter :: IORef.IORef (Counter.T BitCodeCnt)-counter =-   Unsafe.performIO $ Counter.new---writeBitcodeToFile :: String -> Counter.T ident -> LLVM.Module -> IO ()-writeBitcodeToFile ext cnt =-   when False .-      LLVM.writeBitcodeToFile-         ("generator" ++ Counter.format 3 cnt ++ ext ++ ".bc")---type Exec = Compose LLVM.CodeGenModule EE.EngineAccess-type Engine = EE.ExecutionEngine--{- |-This function also initializes LLVM.-This simplifies usage from GHCi.-The @llvm@ packages prevents multiple initialization.--}-compileModule :: Exec externFunction -> IO externFunction-compileModule (Compose bld) = do-   LLVM.initializeNativeTarget-   m <- LLVM.newModule-   (funcs, mappings) <--      LLVM.defineModule m $ do-         LLVM.setTarget LLVM.hostTriple-         liftM2 (,) bld LLVM.getGlobalMappings--   Counter.with counter $ R.ReaderT $ \cnt -> do-      writeBitcodeToFile "" cnt m-      when False $ do-         void $ Opt.optimizeModule 3 m-         writeBitcodeToFile "-opt" cnt m--   EE.runEngineAccessWithModule m $-      EE.addGlobalMappings mappings >> funcs---createLLVMFunction ::-   (LLVM.FunctionArgs f) =>-   String -> LLVM.FunctionCodeGen f -> LLVM.CodeGenModule (LLVM.Function f)-createLLVMFunction = LLVM.createNamedFunction LLVM.ExternalLinkage--createFunction ::-   (EE.ExecutionFunction f, LLVM.FunctionArgs f) =>-   Importer f -> String -> LLVM.FunctionCodeGen f -> Exec f-createFunction importer name f =-   Compose $ EE.getExecutionFunction importer <$> createLLVMFunction name f---type Finalizer a = (Engine, Ptr a -> IO ())--createFinalizer ::-   (EE.ExecutionFunction f, LLVM.FunctionArgs f) =>-   Importer f -> String -> LLVM.FunctionCodeGen f -> Exec (Engine, f)-createFinalizer importer name f =-   liftA2 (,)-      (Compose $ pure EE.getEngine)-      (createFunction importer name f)
src/Synthesizer/LLVM/Filter/Allpass.hs view
@@ -18,7 +18,7 @@    causalPackedP, cascadePackedP, phaserPackedP,    ) where -import Synthesizer.Plain.Filter.Recursive.Allpass (Parameter(Parameter), )+import Synthesizer.Plain.Filter.Recursive.Allpass (Parameter(Parameter)) import qualified Synthesizer.Plain.Filter.Recursive.Allpass as Allpass import qualified Synthesizer.Plain.Filter.Recursive.FirstOrder as Filt1 @@ -32,33 +32,30 @@ import qualified Synthesizer.LLVM.Frame.SerialVector as Serial import qualified Synthesizer.LLVM.Simple.Value as Value -import qualified LLVM.Extra.Multi.Vector.Memory as MultiVectorMemory-import qualified LLVM.Extra.Multi.Value.Memory as MultiValueMemory import qualified LLVM.Extra.Multi.Vector as MultiVector import qualified LLVM.Extra.Multi.Value as MultiValue import qualified LLVM.Extra.Vector as Vector import qualified LLVM.Extra.Scalar as Scalar+import qualified LLVM.Extra.Storable as Storable+import qualified LLVM.Extra.Marshal as Marshal import qualified LLVM.Extra.Memory as Memory-import qualified LLVM.Extra.Class as Class+import qualified LLVM.Extra.Tuple as Tuple import qualified LLVM.Extra.Arithmetic as A-import qualified LLVM.Util.Loop as Loop import qualified LLVM.Core as LLVM-import LLVM.Extra.Class (Undefined, undefTuple, )-import LLVM.Core (CodeGenFunction, )-import LLVM.Util.Loop (Phi, phis, addPhis, )+import LLVM.Core (CodeGenFunction)  import qualified Type.Data.Num.Decimal as TypeNum-import Type.Base.Proxy (Proxy(Proxy), )+import Type.Base.Proxy (Proxy(Proxy)) -import Foreign.Storable (Storable, )+import Foreign.Storable (Storable)  import qualified Control.Category as Cat import qualified Control.Applicative as App-import Control.Arrow ((<<<), (^<<), (<<^), (&&&), arr, first, second, )+import Control.Arrow ((<<<), (^<<), (<<^), (&&&), arr, first, second)  import qualified Data.Traversable as Trav import qualified Data.Foldable as Fold-import Data.Tuple.HT (mapPair, )+import Data.Tuple.HT (mapPair)  import qualified Algebra.Transcendental as Trans @@ -66,15 +63,15 @@ import NumericPrelude.Base  -instance (Phi a) => Phi (Parameter a) where-   phis = Class.phisTraversable-   addPhis = Class.addPhisFoldable+instance (Tuple.Phi a) => Tuple.Phi (Parameter a) where+   phi = Tuple.phiTraversable+   addPhi = Tuple.addPhiFoldable -instance Undefined a => Undefined (Parameter a) where-   undefTuple = Class.undefTuplePointed+instance Tuple.Undefined a => Tuple.Undefined (Parameter a) where+   undef = Tuple.undefPointed -instance Class.Zero a => Class.Zero (Parameter a) where-   zeroTuple = Class.zeroTuplePointed+instance Tuple.Zero a => Tuple.Zero (Parameter a) where+   zero = Tuple.zeroPointed  instance (Memory.C a) => Memory.C (Parameter a) where    type Struct (Parameter a) = Memory.Struct a@@ -83,7 +80,15 @@    decompose = Memory.decomposeNewtype Parameter    compose = Memory.composeNewtype (\(Parameter k) -> k) +instance (Marshal.C a) => Marshal.C (Parameter a) where+   pack (Parameter k) = Marshal.pack k+   unpack = Parameter . Marshal.unpack +instance (Storable.C a) => Storable.C (Parameter a) where+   load = Storable.loadNewtype Parameter Parameter+   store = Storable.storeNewtype Parameter (\(Parameter k) -> k)++ {- instance LLVM.ValueTuple a => LLVM.ValueTuple (Parameter a) where    buildTuple f = Class.buildTupleTraversable (LLVM.buildTuple f)@@ -92,23 +97,26 @@    tupleDesc = Class.tupleDescFoldable -} -instance (Class.MakeValueTuple a) => Class.MakeValueTuple (Parameter a) where-   type ValueTuple (Parameter a) = Parameter (Class.ValueTuple a)-   valueTupleOf = Class.valueTupleOfFunctor+instance (Tuple.Value a) => Tuple.Value (Parameter a) where+   type ValueOf (Parameter a) = Parameter (Tuple.ValueOf a)+   valueOf = Tuple.valueOfFunctor +instance (Tuple.VectorValue n a) => Tuple.VectorValue n (Parameter a) where+   type VectorValueOf n (Parameter a) = Parameter (Tuple.VectorValueOf n a)+   vectorValueOf = fmap Tuple.vectorValueOf . Trav.sequenceA+ instance (MultiValue.C a) => MultiValue.C (Allpass.Parameter a) where-   type Repr f (Allpass.Parameter a) = Allpass.Parameter (MultiValue.Repr f a)    cons = paramFromPlainValue . MultiValue.cons . Allpass.getParameter     undef = paramFromPlainValue MultiValue.undef    zero = paramFromPlainValue MultiValue.zero -   phis bb =+   phi bb =       fmap paramFromPlainValue .-      MultiValue.phis bb .+      MultiValue.phi bb .       plainFromParamValue-   addPhis bb a b =-      MultiValue.addPhis bb+   addPhi bb a b =+      MultiValue.addPhi bb          (plainFromParamValue a)          (plainFromParamValue b) @@ -117,12 +125,12 @@    undef = paramFromPlainVector MultiVector.undef    zero = paramFromPlainVector MultiVector.zero -   phis bb =+   phi bb =       fmap paramFromPlainVector .-      MultiVector.phis bb .+      MultiVector.phi bb .       plainFromParamVector-   addPhis bb a b =-      MultiVector.addPhis bb+   addPhi bb a b =+      MultiVector.addPhi bb          (plainFromParamVector a)          (plainFromParamVector b) @@ -163,14 +171,6 @@    MultiValue.lift1 Allpass.getParameter  -instance (MultiVectorMemory.C n a) => MultiVectorMemory.C n (Allpass.Parameter a) where-   type Struct n (Allpass.Parameter a) = MultiVectorMemory.Struct n a-   load      = fmap paramFromPlainVector . MultiVectorMemory.load-   store     = MultiVectorMemory.store . plainFromParamVector-   decompose = fmap paramFromPlainVector . MultiVectorMemory.decompose-   compose   = MultiVectorMemory.compose . plainFromParamVector-- instance (Value.Flatten a) => Value.Flatten (Parameter a) where    type Registers (Parameter a) = Parameter (Value.Registers a)    flattenCode = Value.flattenCodeTraversable@@ -186,7 +186,11 @@ instance (Vector.C v) => Vector.C (Parameter v) where    insert = Vector.insertTraversable +type instance F.Arguments f (Parameter a) = f (Parameter a)+instance F.MakeArguments (Parameter a) where+   makeArgs = id + parameter ::    (A.Transcendental a, A.RationalConstant a) =>    a -> a -> CodeGenFunction r (Parameter a)@@ -196,12 +200,12 @@ newtype CascadeParameter n a =    CascadeParameter (Allpass.Parameter a)       deriving-         (Undefined, Class.Zero, Storable,+         (Tuple.Undefined, Tuple.Zero, Storable,           Functor, App.Applicative, Fold.Foldable, Trav.Traversable) -instance (Phi a) => Phi (CascadeParameter n a) where-   phis bb (CascadeParameter v) = fmap CascadeParameter $ Loop.phis bb v-   addPhis bb (CascadeParameter x) (CascadeParameter y) = Loop.addPhis bb x y+instance (Tuple.Phi a) => Tuple.Phi (CascadeParameter n a) where+   phi bb (CascadeParameter v) = fmap CascadeParameter $ Tuple.phi bb v+   addPhi bb (CascadeParameter x) (CascadeParameter y) = Tuple.addPhi bb x y   instance (Memory.C a) => Memory.C (CascadeParameter n a) where@@ -211,7 +215,15 @@    decompose = Memory.decomposeNewtype CascadeParameter    compose = Memory.composeNewtype (\(CascadeParameter k) -> k) +instance (Marshal.C a) => Marshal.C (CascadeParameter n a) where+   pack (CascadeParameter k) = Marshal.pack k+   unpack = CascadeParameter . Marshal.unpack +instance (Storable.C a) => Storable.C (CascadeParameter n a) where+   load = Storable.loadNewtype CascadeParameter id+   store = Storable.storeNewtype CascadeParameter id++ {- instance LLVM.ValueTuple a => LLVM.ValueTuple (CascadeParameter n a) where    buildTuple f = Class.buildTupleTraversable (LLVM.buildTuple f)@@ -220,23 +232,30 @@    tupleDesc = Class.tupleDescFoldable -} -instance (Class.MakeValueTuple a) => Class.MakeValueTuple (CascadeParameter n a) where-   type ValueTuple (CascadeParameter n a) = CascadeParameter n (Class.ValueTuple a)-   valueTupleOf = Class.valueTupleOfFunctor+instance (Tuple.Value a) => Tuple.Value (CascadeParameter n a) where+   type ValueOf (CascadeParameter n a) = Parameter (Tuple.ValueOf a)+   valueOf (CascadeParameter a) = Tuple.valueOf a +instance+   (Tuple.VectorValue n a) =>+      Tuple.VectorValue n (CascadeParameter m a) where+   type VectorValueOf n (CascadeParameter m a) =+            Parameter (Tuple.VectorValueOf n a)+   vectorValueOf =+      fmap Tuple.vectorValueOf . Trav.traverse (\(CascadeParameter k) -> k)+ instance (MultiValue.C a) => MultiValue.C (CascadeParameter n a) where-   type Repr f (CascadeParameter n a) = MultiValue.Repr f (Allpass.Parameter a)    cons (CascadeParameter a) = cascadeFromParamValue $ MultiValue.cons a     undef = cascadeFromParamValue MultiValue.undef    zero = cascadeFromParamValue MultiValue.zero -   phis bb =+   phi bb =       fmap cascadeFromParamValue .-      MultiValue.phis bb .+      MultiValue.phi bb .       paramFromCascadeValue-   addPhis bb a b =-      MultiValue.addPhis bb+   addPhi bb a b =+      MultiValue.addPhi bb          (paramFromCascadeValue a)          (paramFromCascadeValue b) @@ -247,12 +266,12 @@    undef = cascadeFromParamVector MultiVector.undef    zero = cascadeFromParamVector MultiVector.zero -   phis bb =+   phi bb =       fmap cascadeFromParamVector .-      MultiVector.phis bb .+      MultiVector.phi bb .       paramFromCascadeVector-   addPhis bb a b =-      MultiVector.addPhis bb+   addPhi bb a b =+      MultiVector.addPhi bb          (paramFromCascadeVector a)          (paramFromCascadeVector b) @@ -289,13 +308,6 @@    MultiValue.T (Allpass.Parameter a) paramFromCascadeValue = MultiValue.lift1 id -instance (MultiVectorMemory.C n a) => MultiVectorMemory.C n (CascadeParameter n a) where-   type Struct n (CascadeParameter n a) = MultiVectorMemory.Struct n (Allpass.Parameter a)-   load      = fmap cascadeFromParamVector . MultiVectorMemory.load-   store     = MultiVectorMemory.store . paramFromCascadeVector-   decompose = fmap cascadeFromParamVector . MultiVectorMemory.decompose-   compose   = MultiVectorMemory.compose . paramFromCascadeVector- instance (Value.Flatten a) => Value.Flatten (CascadeParameter n a) where    type Registers (CascadeParameter n a) = CascadeParameter n (Value.Registers a)    flattenCode = Value.flattenCodeTraversable@@ -354,7 +366,7 @@  replicateStage ::    (Causal.C process,-    TypeNum.Natural n, Phi b, Undefined b) =>+    TypeNum.Natural n, Tuple.Phi b, Tuple.Undefined b) =>    Proxy n ->    process (Parameter a, b) b ->    process (CascadeParameter n a, b) b@@ -403,7 +415,7 @@     TypeNum.Positive n, MultiVector.C a,     MultiVector.T n (CascadeParameter n a, a) ~ v,     MultiValue.PseudoRing a, MultiValue.IntegerConstant a,-    MultiValueMemory.C a) =>+    Marshal.C a) =>    Proxy n -> process v v stage _ =    Causal.vectorize $@@ -433,9 +445,9 @@ cascadePipeline ::    (Causal.C process,     TypeNum.Positive n, MultiVector.C a,-    MultiValue.Repr LLVM.Value a ~ ar,+    Tuple.ValueOf a ~ ar,     MultiValue.PseudoRing a, MultiValue.IntegerConstant a,-    MultiValueMemory.C a, MultiVectorMemory.C n a) =>+    Marshal.C a, Marshal.Vector n a) =>    process       (MultiValue.T (CascadeParameter n a), MultiValue.T a)       (MultiValue.T a)@@ -458,17 +470,17 @@   multiValue ::-   (MultiValue.Repr LLVM.Value a ~ LLVM.Value a) =>+   (Tuple.ValueOf a ~ LLVM.Value a) =>    LLVM.Value a -> MultiValue.T a multiValue = MultiValue.Cons  unmultiValue ::-   (MultiValue.Repr LLVM.Value a ~ LLVM.Value a) =>+   (Tuple.ValueOf a ~ LLVM.Value a) =>    MultiValue.T a -> LLVM.Value a unmultiValue (MultiValue.Cons a) = a  multiCascadeParam ::-   (MultiValue.Repr LLVM.Value a ~ LLVM.Value a) =>+   (Tuple.ValueOf a ~ LLVM.Value a) =>    CascadeParameter n (LLVM.Value a) ->    MultiValue.T (CascadeParameter n a) multiCascadeParam (CascadeParameter a) =@@ -478,8 +490,8 @@    (Causal.C process,     TypeNum.Positive n,     MultiValue.PseudoRing a, MultiValue.RationalConstant a,-    MultiValueMemory.C a, MultiVectorMemory.C n a,-    MultiValue.Repr LLVM.Value a ~ LLVM.Value a) =>+    Marshal.C a, Marshal.Vector n a, MultiVector.C a,+    Tuple.ValueOf a ~ LLVM.Value a) =>    process       (CascadeParameter n (LLVM.Value a), LLVM.Value a)       (LLVM.Value a)@@ -495,7 +507,7 @@    (Causal.C process,     TypeNum.Positive n,     MultiValue.PseudoRing a, MultiValue.RationalConstant a,-    MultiValueMemory.C a, MultiVectorMemory.C n a) =>+    Marshal.C a, Marshal.Vector n a, MultiVector.C a) =>    process       (MultiValue.T (CascadeParameter n a), MultiValue.T a)       (MultiValue.T a)
src/Synthesizer/LLVM/Filter/Butterworth.hs view
@@ -16,8 +16,8 @@ import qualified Synthesizer.LLVM.Simple.Value as Value  import qualified Synthesizer.Plain.Filter.Recursive.Butterworth as Butterworth-import Synthesizer.Plain.Filter.Recursive (Passband, )-import Synthesizer.Causal.Class (($<), )+import Synthesizer.Plain.Filter.Recursive (Passband)+import Synthesizer.Causal.Class (($<))  import qualified LLVM.Extra.ScalarOrVector as SoV import qualified LLVM.Extra.Control as U@@ -25,17 +25,15 @@  import qualified LLVM.Core as LLVM import LLVM.Core-   (Value, valueOf, constOf,-    IsFloating, IsSized, SizeOf,-    CodeGenFunction, )+   (CodeGenFunction, Value, valueOf, constOf,+    IsFloating, IsSized, SizeOf) -import Data.Word (Word32, )+import Data.Word (Word) -import Foreign.Ptr (Ptr, )  import qualified Type.Data.Num.Decimal as TypeNum-import Type.Data.Num.Decimal.Number ((:*:), )-import Type.Base.Proxy (Proxy, )+import Type.Data.Num.Decimal.Number ((:*:))+import Type.Base.Proxy (Proxy)  import qualified Algebra.Transcendental as Trans @@ -80,8 +78,8 @@     TypeNum.Positive (n :*: SizeOf a),     IsSized (Cascade.ParameterStruct n a)) =>    Proxy n -> Passband ->-   Value (Ptr (LLVM.Array n a)) ->-   Value (Ptr (Cascade.ParameterStruct n a)) ->+   Value (LLVM.Ptr (LLVM.Array n a)) ->+   Value (LLVM.Ptr (Cascade.ParameterStruct n a)) ->    Value a -> Value a ->    CodeGenFunction r (Cascade.ParameterValue n a) parameterCore n kind psine ps ratio freq = do@@ -91,9 +89,9 @@           Cascade.constArray n $           map constOf $ Butterworth.makeSines order    LLVM.store sines psine-   s <- LLVM.getElementPtr0 psine (valueOf (0::Word32), ())-   p <- LLVM.getElementPtr0 ps (valueOf (0::Word32), ())-   let len = valueOf $ (TypeNum.integralFromProxy n :: Word32)+   s <- LLVM.getElementPtr0 psine (valueOf (0::Word), ())+   p <- LLVM.getElementPtr0 ps (valueOf (0::Word), ())+   let len = valueOf $ (TypeNum.integralFromProxy n :: Word)    _ <- U.arrayLoop len p s $ \ptri si -> do       sinw <- LLVM.load si       flip LLVM.store ptri =<<
src/Synthesizer/LLVM/Filter/Chebyshev.hs view
@@ -18,8 +18,8 @@  import qualified Synthesizer.Plain.Filter.Recursive.Chebyshev as Chebyshev import qualified Synthesizer.Plain.Filter.Recursive.SecondOrder as Filt2Core-import Synthesizer.Plain.Filter.Recursive (Passband, )-import Synthesizer.Causal.Class (($<), )+import Synthesizer.Plain.Filter.Recursive (Passband)+import Synthesizer.Causal.Class (($<))  import qualified LLVM.Extra.ScalarOrVector as SoV import qualified LLVM.Extra.Control as U@@ -27,14 +27,13 @@  import qualified LLVM.Core as LLVM import LLVM.Core-   (Value, valueOf, IsSized, SizeOf, IsFloating, CodeGenFunction, )-import Data.Word (Word32, )+   (Value, valueOf, IsSized, SizeOf, IsFloating, CodeGenFunction)+import Data.Word (Word) -import Foreign.Ptr (Ptr, )  import qualified Type.Data.Num.Decimal as TypeNum-import Type.Data.Num.Decimal.Number ((:*:), )-import Type.Base.Proxy (Proxy, )+import Type.Data.Num.Decimal.Number ((:*:))+import Type.Base.Proxy (Proxy)  import qualified Synthesizer.LLVM.Complex as ComplexL @@ -80,7 +79,8 @@    allocaArrays  allocaArrays ::-   (Sig.C signal, IsSized a, IsSized b) => signal (Value (Ptr a), Value (Ptr b))+   (Sig.C signal, IsSized a, IsSized b) =>+   signal (Value (LLVM.Ptr a), Value (LLVM.Ptr b)) allocaArrays = Sig.zipWith (curry return) Sig.alloca Sig.alloca  parameterA, parameterB ::@@ -104,7 +104,7 @@  withArrays ::    (LLVM.IsSized a, LLVM.IsSized b) =>-   (Value (Ptr a) -> Value (Ptr b) -> CodeGenFunction r c) ->+   (Value (LLVM.Ptr a) -> Value (LLVM.Ptr b) -> CodeGenFunction r c) ->    CodeGenFunction r c withArrays act = do    psine <- LLVM.malloc@@ -124,8 +124,8 @@ adjustAmplitude ratio pv = do    filt0 <-       Filt2.decomposeParameter =<<-      LLVM.extractvalue pv (0::Word32)-   flip (LLVM.insertvalue pv) (0::Word32) =<<+      LLVM.extractvalue pv (0::Word)+   flip (LLVM.insertvalue pv) (0::Word) =<<       Filt2.composeParameter =<<       Value.flatten          (Filt2Core.amplify (Value.constantValue ratio) (Value.unfold filt0))@@ -140,8 +140,8 @@     (n :*: LLVM.UnknownSize) ~ paramSize, TypeNum.Positive paramSize) =>    (Passband -> Int -> av -> Complex.T av -> av -> Filt2Core.Parameter av) ->    Proxy n -> Passband ->-   Value (Ptr (LLVM.Array n (ComplexL.Struct a))) ->-   Value (Ptr (Cascade.ParameterStruct n a)) ->+   Value (LLVM.Ptr (LLVM.Array n (ComplexL.Struct a))) ->+   Value (LLVM.Ptr (Cascade.ParameterStruct n a)) ->    Value a -> Value a ->    CodeGenFunction r (Value (Cascade.ParameterStruct n a)) parameter partialParameter n kind psine ps ratio freq = do@@ -151,9 +151,9 @@           map ComplexL.constOf $           Chebyshev.makeCirclePoints order    LLVM.store sines psine-   s <- LLVM.getElementPtr0 psine (valueOf (0::Word32), ())-   p <- LLVM.getElementPtr0 ps (valueOf (0::Word32), ())-   let len = valueOf $ (TypeNum.integralFromProxy n :: Word32)+   s <- LLVM.getElementPtr0 psine (valueOf (0::Word), ())+   p <- LLVM.getElementPtr0 ps (valueOf (0::Word), ())+   let len = valueOf $ (TypeNum.integralFromProxy n :: Word)    _ <- U.arrayLoop len p s $ \ptri si -> do       c <- LLVM.load si       flip LLVM.store ptri =<<
src/Synthesizer/LLVM/Filter/ComplexFirstOrder.hs view
@@ -14,17 +14,15 @@  import qualified LLVM.Extra.Arithmetic as A import qualified LLVM.Extra.Memory as Memory-import qualified LLVM.Extra.Class as Class-import LLVM.Extra.Class (Undefined, undefTuple, )+import qualified LLVM.Extra.Tuple as Tuple  import qualified LLVM.Core as LLVM-import LLVM.Core (CodeGenFunction, )-import LLVM.Util.Loop (Phi, phis, addPhis, )+import LLVM.Core (CodeGenFunction) -import Type.Data.Num.Decimal (d0, d1, d2, )+import Type.Data.Num.Decimal (d0, d1, d2)  import qualified Control.Applicative as App-import Control.Applicative (liftA2, liftA3, (<*>), )+import Control.Applicative (liftA2, liftA3, (<*>))  import qualified Data.Traversable as Trav import qualified Data.Foldable as Fold@@ -62,12 +60,12 @@       liftA2 (Complex.+:) (Complex.real c) (Complex.imag c)  -instance (Phi a) => Phi (Parameter a) where-   phis = Class.phisTraversable-   addPhis = Class.addPhisFoldable+instance (Tuple.Phi a) => Tuple.Phi (Parameter a) where+   phi = Tuple.phiTraversable+   addPhi = Tuple.addPhiFoldable -instance Undefined a => Undefined (Parameter a) where-   undefTuple = Class.undefTuplePointed+instance Tuple.Undefined a => Tuple.Undefined (Parameter a) where+   undef = Tuple.undefPointed   type ParameterStruct a = LLVM.Struct (a, (a, (a, ())))
src/Synthesizer/LLVM/Filter/ComplexFirstOrderPacked.hs view
@@ -18,20 +18,19 @@ import qualified LLVM.Extra.Vector as Vector import qualified LLVM.Extra.Arithmetic as A import qualified LLVM.Extra.Memory as Memory-import LLVM.Extra.Class (Undefined, undefTuple, )+import qualified LLVM.Extra.Tuple as Tuple  import qualified LLVM.Core as LLVM import LLVM.Core    (Value, valueOf, Struct,     IsPrimitive, IsFloating, IsSized,     Vector, insertelement,-    CodeGenFunction, )-import LLVM.Util.Loop (Phi, phis, addPhis, )+    CodeGenFunction)  import qualified Type.Data.Num.Decimal as TypeNum-import Type.Data.Num.Decimal (D4, d0, d1, (:*:), )+import Type.Data.Num.Decimal (D4, d0, d1, (:*:)) -import Control.Applicative (liftA2, )+import Control.Applicative (liftA2)  import NumericPrelude.Numeric import NumericPrelude.Base@@ -41,29 +40,27 @@ data Parameter a =    Parameter (Value (Vector D4 a)) (Value (Vector D4 a)) -instance IsPrimitive a => Phi (Parameter a) where-   phis bb (Parameter r i) = do-      r' <- phis bb r-      i' <- phis bb i+instance IsPrimitive a => Tuple.Phi (Parameter a) where+   phi bb (Parameter r i) = do+      r' <- Tuple.phi bb r+      i' <- Tuple.phi bb i       return (Parameter r' i')-   addPhis bb+   addPhi bb         (Parameter r i)         (Parameter r' i') = do-      addPhis bb r r'-      addPhis bb i i'+      Tuple.addPhi bb r r'+      Tuple.addPhi bb i i' -instance IsPrimitive a => Undefined (Parameter a) where-   undefTuple = Parameter undefTuple undefTuple+instance IsPrimitive a => Tuple.Undefined (Parameter a) where+   undef = Parameter Tuple.undef Tuple.undef   type ParameterStruct a = Struct (Vector D4 a, (Vector D4 a, ()))  parameterMemory ::-   (Memory.FirstClass a, Memory.Stored a ~ am,-    IsPrimitive a, IsPrimitive am,-    TypeNum.Positive (TypeNum.D4 :*: LLVM.SizeOf am),-    IsSized am) =>-   Memory.Record r (ParameterStruct am) (Parameter a)+   (IsPrimitive a, IsSized a,+    TypeNum.Positive (TypeNum.D4 :*: LLVM.SizeOf a)) =>+   Memory.Record r (ParameterStruct a) (Parameter a) parameterMemory =    liftA2 Parameter       (Memory.element (\(Parameter kr _) -> kr) d0)@@ -80,12 +77,10 @@       Memory.C (Parameter l) (Struct (Vector D4 l, (Vector D4 l, ()))) where -} instance-   (Memory.FirstClass a, Memory.Stored a ~ am,-    IsPrimitive a, IsPrimitive am,-    IsSized am,-    TypeNum.Positive (TypeNum.D4 :*: LLVM.SizeOf am)) =>+   (IsPrimitive a, IsSized a,+    TypeNum.Positive (TypeNum.D4 :*: LLVM.SizeOf a)) =>       Memory.C (Parameter a) where-   type Struct (Parameter a) = ParameterStruct (Memory.Stored a)+   type Struct (Parameter a) = ParameterStruct a    load = Memory.loadRecord parameterMemory    store = Memory.storeRecord parameterMemory    decompose = Memory.decomposeRecord parameterMemory
src/Synthesizer/LLVM/Filter/FirstOrder.hs view
@@ -18,39 +18,38 @@  import qualified Synthesizer.Plain.Filter.Recursive.FirstOrder as FirstOrder import Synthesizer.Plain.Filter.Recursive.FirstOrder-          (Parameter(Parameter), Result(Result))+          (Parameter(Parameter), Result(Result,lowpass_,highpass_))  import qualified Synthesizer.Plain.Modifier as Modifier  import qualified Synthesizer.LLVM.CausalParameterized.Process as CausalP import qualified Synthesizer.LLVM.Causal.Process as Causal import qualified Synthesizer.LLVM.Frame.SerialVector as Serial-import qualified Synthesizer.LLVM.Parameter as Param import qualified Synthesizer.LLVM.Simple.Value as Value +import qualified LLVM.DSL.Parameter as Param++import qualified LLVM.Extra.Storable as Storable+import qualified LLVM.Extra.Marshal as Marshal import qualified LLVM.Extra.Memory as Memory-import qualified LLVM.Extra.Class as Class+import qualified LLVM.Extra.Tuple as Tuple import qualified LLVM.Extra.Arithmetic as A-import LLVM.Extra.Class (Undefined, undefTuple, )  import qualified LLVM.Core as LLVM-import LLVM.Util.Loop (Phi, phis, addPhis, ) -import Foreign.Storable (Storable, )--import Control.Arrow (arr, (&&&), (<<<), )-import Control.Monad (liftM2, foldM, )+import Control.Arrow (arr, (&&&), (<<<))+import Control.Monad (liftM2, foldM)  import NumericPrelude.Numeric import NumericPrelude.Base  -instance (Phi a) => Phi (Parameter a) where-   phis = Class.phisTraversable-   addPhis = Class.addPhisFoldable+instance (Tuple.Phi a) => Tuple.Phi (Parameter a) where+   phi = Tuple.phiTraversable+   addPhi = Tuple.addPhiFoldable -instance Undefined a => Undefined (Parameter a) where-   undefTuple = Class.undefTuplePointed+instance Tuple.Undefined a => Tuple.Undefined (Parameter a) where+   undef = Tuple.undefPointed  instance (Memory.C a) => Memory.C (Parameter a) where    type Struct (Parameter a) = Memory.Struct a@@ -59,6 +58,14 @@    decompose = Memory.decomposeNewtype Parameter    compose = Memory.composeNewtype (\(Parameter k) -> k) +instance (Marshal.C a) => Marshal.C (Parameter a) where+   pack (Parameter k) = Marshal.pack k+   unpack = Parameter . Marshal.unpack++instance (Storable.C a) => Storable.C (Parameter a) where+   load = Storable.loadNewtype Parameter Parameter+   store = Storable.storeNewtype Parameter (\(Parameter k) -> k)+ instance (Value.Flatten a) => Value.Flatten (Parameter a) where    type Registers (Parameter a) = Parameter (Value.Registers a)    flattenCode = Value.flattenCodeTraversable@@ -77,9 +84,9 @@    tupleDesc = Class.tupleDescFoldable -} -instance (Class.MakeValueTuple a) => Class.MakeValueTuple (Parameter a) where-   type ValueTuple (Parameter a) = Parameter (Class.ValueTuple a)-   valueTupleOf = Class.valueTupleOfFunctor+instance (Tuple.Value a) => Tuple.Value (Parameter a) where+   type ValueOf (Parameter a) = Parameter (Tuple.ValueOf a)+   valueOf = Tuple.valueOfFunctor   parameter ::@@ -94,7 +101,7 @@       (Value.T v)       (Parameter (Value.T a))       (Value.T v) (Result (Value.T v))-modifier  = FirstOrder.modifier+modifier = FirstOrder.modifier  lowpassModifier, highpassModifier ::    (a ~ A.Scalar v, A.PseudoModule v, A.IntegerConstant a) =>@@ -186,7 +193,7 @@  preampPacked =    Causal.map-      (\(FirstOrder.Parameter k, x) ->+      (\(Parameter k, x) ->          A.mul x =<< Serial.upsample =<< A.sub (A.fromInteger' 1) k)  @@ -293,8 +300,7 @@ -}    Causal.map (\(l,x) -> do       h <- A.sub x l-      return (Result{FirstOrder.lowpass_ = l,-                     FirstOrder.highpass_ = h}))+      return (Result{lowpass_ = l, highpass_ = h}))     <<< (lowpass &&& arr snd)  causalPacked ::@@ -327,14 +333,14 @@ highpassCausalP = highpassCausal  causalInitP ::-   (A.IntegerConstant a, a ~ A.Scalar v, A.PseudoModule v, Memory.C v,-    Storable vh, Class.MakeValueTuple vh, Class.ValueTuple vh ~ v) =>+   (A.IntegerConstant a, a ~ A.Scalar v, A.PseudoModule v,+    Marshal.C vh, Tuple.ValueOf vh ~ v) =>    Param.T p vh -> CausalP.T p (Parameter a, v) (Result v) causalInitP = CausalP.fromInitializedModifier modifierInit  lowpassCausalInitP, highpassCausalInitP ::-   (A.IntegerConstant a, a ~ A.Scalar v, A.PseudoModule v, Memory.C v,-    Storable vh, Class.MakeValueTuple vh, Class.ValueTuple vh ~ v) =>+   (A.IntegerConstant a, a ~ A.Scalar v, A.PseudoModule v,+    Marshal.C vh, Tuple.ValueOf vh ~ v) =>    Param.T p vh -> CausalP.T p (Parameter a, v) v lowpassCausalInitP = CausalP.fromInitializedModifier lowpassModifierInit highpassCausalInitP = CausalP.fromInitializedModifier highpassModifierInit@@ -351,8 +357,8 @@ lowpassCausalInitPackedP, highpassCausalInitPackedP,       causalRecursiveInitPackedP ::    (A.PseudoRing v, Serial.C v, Serial.Element v ~ a,-    A.PseudoRing a, A.IntegerConstant a, Memory.C a,-    Storable ah, Class.MakeValueTuple ah, Class.ValueTuple ah ~ a) =>+    A.PseudoRing a, A.IntegerConstant a,+    Marshal.C ah, Tuple.ValueOf ah ~ a) =>    Param.T p ah -> CausalP.T p (Parameter a, v) v causalRecursiveInitPackedP a =    CausalP.mapAccum (\() -> causalRecursivePackedStep) return (return ()) a@@ -371,8 +377,8 @@  causalInitPackedP ::    (A.PseudoRing v, Serial.C v, Serial.Element v ~ a,-    A.PseudoRing a, A.IntegerConstant a, Memory.C a,-    Storable ah, Class.MakeValueTuple ah, Class.ValueTuple ah ~ a) =>+    A.PseudoRing a, A.IntegerConstant a,+    Marshal.C ah, Tuple.ValueOf ah ~ a) =>    Param.T p ah -> CausalP.T p (Parameter a, v) (Result v) causalInitPackedP a = addHighpass (lowpassCausalInitPackedP a)
src/Synthesizer/LLVM/Filter/Moog.hs view
@@ -17,30 +17,28 @@ import qualified Synthesizer.LLVM.CausalParameterized.Process as CausalP import qualified Synthesizer.LLVM.Causal.Process as Causal import qualified Synthesizer.LLVM.Simple.Value as Value-import qualified Synthesizer.LLVM.Parameter as Param -import Foreign.Storable (Storable, )+import qualified LLVM.DSL.Parameter as Param  import qualified LLVM.Extra.Vector as Vector+import qualified LLVM.Extra.Marshal as Marshal import qualified LLVM.Extra.Memory as Memory import qualified LLVM.Extra.Arithmetic as A-import qualified LLVM.Extra.Class as Class-import LLVM.Extra.Class (Undefined, undefTuple, )+import qualified LLVM.Extra.Tuple as Tuple  import qualified LLVM.Core as LLVM-import LLVM.Core (CodeGenFunction, )-import LLVM.Util.Loop (Phi, phis, addPhis, )+import LLVM.Core (CodeGenFunction)  import qualified Type.Data.Num.Decimal as TypeNum-import Type.Data.Num.Decimal (d0, d1, )-import Type.Base.Proxy (Proxy(Proxy), )+import Type.Data.Num.Decimal (d0, d1)+import Type.Base.Proxy (Proxy(Proxy))  import qualified Control.Arrow as Arrow import qualified Control.Applicative as App import qualified Data.Foldable as Fold import qualified Data.Traversable as Trav-import Control.Arrow (arr, (>>>), (&&&), )-import Control.Applicative (liftA2, )+import Control.Arrow (arr, (>>>), (&&&))+import Control.Applicative (liftA2)  import NumericPrelude.Numeric import NumericPrelude.Base@@ -50,18 +48,18 @@    deriving (Functor, App.Applicative, Fold.Foldable, Trav.Traversable)  -instance (Phi a, TypeNum.Natural n) =>-      Phi (Parameter n a) where-   phis = Class.phisTraversable-   addPhis = Class.addPhisFoldable+instance (Tuple.Phi a, TypeNum.Natural n) =>+      Tuple.Phi (Parameter n a) where+   phi = Tuple.phiTraversable+   addPhi = Tuple.addPhiFoldable -instance (Undefined a, TypeNum.Natural n) =>-      Undefined (Parameter n a) where-   undefTuple = Class.undefTuplePointed+instance (Tuple.Undefined a, TypeNum.Natural n) =>+      Tuple.Undefined (Parameter n a) where+   undef = Tuple.undefPointed -instance (Class.Zero a, TypeNum.Natural n) =>-      Class.Zero (Parameter n a) where-   zeroTuple = Class.zeroTuplePointed+instance (Tuple.Zero a, TypeNum.Natural n) =>+      Tuple.Zero (Parameter n a) where+   zero = Tuple.zeroPointed   type ParameterStruct a = LLVM.Struct (a, (a, ()))@@ -146,14 +144,13 @@   causalInit, causalInitP ::-   (Storable vh, Class.MakeValueTuple vh,-    Class.ValueTuple vh ~ v, Memory.C v,+   (Marshal.C vh, Tuple.ValueOf vh ~ v,     A.PseudoModule v, A.Scalar v ~ a, A.IntegerConstant a,     TypeNum.Natural n) =>    Param.T p vh -> CausalP.T p (Parameter n a, v) v causalInit = causalInitP causalInitP initial =-   let selectOutput :: Param.T p vh -> (b, Class.ValueTuple vh) -> Class.ValueTuple vh+   let selectOutput :: Param.T p vh -> (b, Tuple.ValueOf vh) -> Tuple.ValueOf vh        selectOutput _ = snd    in  causalSize           (flip
src/Synthesizer/LLVM/Filter/NonRecursive.hs view
@@ -9,31 +9,31 @@  import qualified Synthesizer.LLVM.CausalParameterized.ProcessPrivate as CausalP import qualified Synthesizer.LLVM.CausalParameterized.RingBuffer as RingBuffer-import qualified Synthesizer.LLVM.Parameter as Param import qualified Synthesizer.LLVM.Frame.SerialVector as Serial  import qualified Synthesizer.LLVM.Storable.Vector as SVU import qualified Data.StorableVector as SV +import qualified LLVM.DSL.Parameter as Param++import qualified LLVM.Extra.Storable as Storable import qualified LLVM.Extra.Memory as Memory import qualified LLVM.Extra.Control as C import qualified LLVM.Extra.Arithmetic as A-import qualified LLVM.Extra.Class as Class-import LLVM.Extra.Class (undefTuple, )+import qualified LLVM.Extra.Tuple as Tuple  import qualified LLVM.Core as LLVM-import LLVM.Core (Value, valueOf, CodeGenFunction, IsSized, SizeOf, )+import LLVM.Core (Value, valueOf, CodeGenFunction, IsSized, SizeOf)  import qualified Type.Data.Num.Decimal as TypeNum-import Type.Data.Num.Decimal.Number ((:*:), )+import Type.Data.Num.Decimal.Number ((:*:)) -import Foreign.ForeignPtr (touchForeignPtr, )-import Foreign.Storable (Storable, )-import Foreign.Ptr (Ptr, )-import Data.Word (Word32, )+import Foreign.ForeignPtr (touchForeignPtr)+import Foreign.Ptr (Ptr)+import Data.Word (Word) -import Control.Arrow ((<<<), (&&&), )-import Control.Monad (liftM2, )+import Control.Arrow ((<<<), (&&&))+import Control.Monad (liftM2)  import qualified Algebra.IntegralDomain as Integral @@ -47,30 +47,26 @@ No Karatsuba, No Toom-Cook, No Fourier. -} convolve ::-   (Storable a,-    Class.MakeValueTuple a, Class.ValueTuple a ~ al,-    Memory.C al, A.PseudoRing al) =>+   (Storable.C a, Tuple.ValueOf a ~ al, Memory.C al, A.PseudoRing al) =>    Param.T p (SV.Vector a) -> CausalP.T p al al convolve mask =    let len = fmap SV.length mask-   in  CausalP.zipWith scalarProduct (fmap (fromIntegral :: Int -> Word32) len)+   in  CausalP.zipWith scalarProduct+         (fmap (fromIntegral :: Int -> Word) len)        <<<        RingBuffer.trackConst A.zero len &&& provideMask mask  convolvePacked ::-   (LLVM.IsPrimitive a, Memory.FirstClass a, Memory.Stored a ~ am,-    LLVM.IsPrimitive am, IsSized am, SizeOf am ~ amsize,-    TypeNum.Positive n, TypeNum.Positive (n :*: amsize),-    Class.MakeValueTuple a, Class.ValueTuple a ~ al, Memory.Struct al ~ am,-    Storable a, Memory.C al,-    LLVM.IsArithmetic a) =>+   (TypeNum.Positive n, TypeNum.Positive (n :*: asize),+    Storable.C a, Tuple.ValueOf a ~ Value al,+    LLVM.IsArithmetic al, LLVM.IsPrimitive al, IsSized al, SizeOf al ~ asize) =>    Param.T p (SV.Vector a) ->-   CausalP.T p (Serial.Value n a) (Serial.Value n a)+   CausalP.T p (Serial.Value n al) (Serial.Value n al) convolvePacked mask =    Serial.withSize $ \vectorSize ->       let len = fmap SV.length mask       in  CausalP.zipWith scalarProductPacked-             (fmap (fromIntegral :: Int -> Word32) len)+             (fmap (fromIntegral :: Int -> Word) len)           <<<           RingBuffer.trackConst A.zero              (fmap (flip Integral.divUp vectorSize) len)@@ -78,10 +74,7 @@           provideMask mask  provideMask ::-   (Storable a,-    Class.MakeValueTuple a, Class.ValueTuple a ~ al,-    Memory.C al, Memory.Struct al ~ am) =>-   Param.T p (SV.Vector a) -> CausalP.T p x (Value (Ptr am))+   (Storable.C a) => Param.T p (SV.Vector a) -> CausalP.T p x (Value (Ptr a)) provideMask mask =    CausalP.Cons       (\p () _x () -> return (p,()))@@ -96,45 +89,43 @@   scalarProduct ::-   (Memory.C a, Memory.Struct a ~ am,-    A.PseudoRing a) =>-   Value Word32 ->-   RingBuffer.T a -> Value (Ptr am) ->-   CodeGenFunction r a+   (Storable.C a, Tuple.ValueOf a ~ al, Memory.C al, A.PseudoRing al) =>+   Value Word ->+   RingBuffer.T al -> Value (Ptr a) ->+   CodeGenFunction r al scalarProduct n rb mask =    fmap snd $-   C.arrayLoop n mask (A.zero, A.zero) $ \ptr (k, s) -> do+   Storable.arrayLoop n mask (A.zero, A.zero) $ \ptr (k, s) -> do       a <- RingBuffer.index k rb-      b <- Memory.load ptr+      b <- Storable.load ptr       liftM2 (,) (A.inc k) (A.add s =<< A.mul a b)  _scalarProduct ::-   (Memory.FirstClass a, Memory.Stored a ~ am, IsSized am,-    LLVM.IsArithmetic a) =>-   Value Word32 ->-   RingBuffer.T (Value a) -> Value (Ptr am) ->+   (Storable.C a, IsSized a,+    Tuple.ValueOf a ~ Value a, LLVM.IsArithmetic a) =>+   Value Word ->+   RingBuffer.T (Value a) -> Value (Ptr a) ->    CodeGenFunction r (Value a) _scalarProduct = scalarProduct   scalarProductPacked ::-   (LLVM.IsPrimitive a, Memory.FirstClass a, Memory.Stored a ~ am,-    LLVM.IsPrimitive am, IsSized am, SizeOf am ~ amsize,-    TypeNum.Positive n, TypeNum.Positive (n :*: amsize),-    LLVM.IsArithmetic a) =>-   Value Word32 ->-   RingBuffer.T (Serial.Value n a) -> Value (Ptr am) ->-   CodeGenFunction r (Serial.Value n a)+   (Storable.C a,+    Tuple.ValueOf a ~ Value al, LLVM.IsArithmetic al,+    LLVM.IsPrimitive al, IsSized al, SizeOf al ~ asize,+    TypeNum.Positive n, TypeNum.Positive (n :*: asize)) =>+   Value Word ->+   RingBuffer.T (Serial.Value n al) -> Value (Ptr a) ->+   CodeGenFunction r (Serial.Value n al) scalarProductPacked n0 rb mask0 = do    (ax, rx) <- readSerialStart rb-   bx <- Memory.load mask0+   bx <- Storable.load mask0    sx <- A.scale bx ax    n1 <- A.dec n0-   mask1 <- A.advanceArrayElementPtr mask0-   fmap snd $ C.arrayLoop n1 mask1 (rx, sx) $-         \ptr (r1, s1) -> do+   mask1 <- Storable.incrementPtr mask0+   fmap snd $ Storable.arrayLoop n1 mask1 (rx, sx) $ \ptr (r1, s1) -> do       (a,r2) <- readSerialNext rb r1-      b <- Memory.load ptr+      b <- Storable.load ptr       fmap ((,) r2) (A.add s1 =<< A.scale b a)  @@ -147,23 +138,21 @@         that is, from high to low indices.         -}         Serial.Value n a,-        Value Word32),-       Value Word32)+        Value Word),+       Value Word)  readSerialStart ::-   (LLVM.IsPrimitive a, Memory.FirstClass a, Memory.Stored a ~ am,-    LLVM.IsPrimitive am, IsSized am, SizeOf am ~ amsize,-    TypeNum.Positive n, TypeNum.Positive (n :*: amsize)) =>+   (LLVM.IsPrimitive a, IsSized a, SizeOf a ~ asize,+    TypeNum.Positive n, TypeNum.Positive (n :*: asize)) =>    RingBuffer.T (Serial.Value n a) ->    CodeGenFunction r (Serial.Value n a, Iterator n a) readSerialStart rb = do    a <- RingBuffer.index A.zero rb-   return (a, ((a, undefTuple, A.zero), A.zero))+   return (a, ((a, Tuple.undef, A.zero), A.zero))  readSerialNext ::-   (LLVM.IsPrimitive a, Memory.FirstClass a, Memory.Stored a ~ am,-    LLVM.IsPrimitive am, IsSized am, SizeOf am ~ amsize,-    TypeNum.Positive n, TypeNum.Positive (n :*: amsize)) =>+   (LLVM.IsPrimitive a, IsSized a, SizeOf a ~ asize,+    TypeNum.Positive n, TypeNum.Positive (n :*: asize)) =>    RingBuffer.T (Serial.Value n a) ->    Iterator n a ->    CodeGenFunction r (Serial.Value n a, Iterator n a)@@ -173,8 +162,8 @@       C.ifThen vectorEnd ((r0,j0), k0) $ do          k <- A.inc k0          r <- RingBuffer.index k rb-         return ((r, valueOf (fromIntegral $ Serial.size r :: Word32)), k)+         return ((r, valueOf (fromIntegral $ Serial.size r :: Word)), k)    j2 <- A.dec j1-   (ai,r2) <- Serial.shiftUp undefTuple r1+   (ai,r2) <- Serial.shiftUp Tuple.undef r1    (_, a1) <- Serial.shiftUp ai a0    return (a1, ((a1,r2,j2), k1))
src/Synthesizer/LLVM/Filter/SecondOrder.hs view
@@ -13,7 +13,7 @@    ) where  import qualified Synthesizer.Plain.Filter.Recursive.SecondOrder as Filt2-import Synthesizer.Plain.Filter.Recursive.SecondOrder (Parameter(Parameter), )+import Synthesizer.Plain.Filter.Recursive.SecondOrder (Parameter(Parameter))  import qualified Synthesizer.Plain.Modifier as Modifier @@ -22,34 +22,34 @@ import qualified Synthesizer.LLVM.Frame.SerialVector as Serial import qualified Synthesizer.LLVM.Simple.Value as Value +import qualified LLVM.Extra.Storable as Storable+import qualified LLVM.Extra.Marshal as Marshal import qualified LLVM.Extra.Memory as Memory-import qualified LLVM.Extra.Class as Class+import qualified LLVM.Extra.Tuple as Tuple import qualified LLVM.Extra.Arithmetic as A-import LLVM.Extra.Class (Undefined, undefTuple, )  import qualified LLVM.Core as LLVM-import LLVM.Core (CodeGenFunction, valueOf, )-import LLVM.Util.Loop (Phi, phis, addPhis, )+import LLVM.Core (CodeGenFunction, valueOf)  import qualified Type.Data.Num.Decimal as TypeNum-import Type.Data.Num.Decimal (d0, d1, d2, d3, d4, )+import Type.Data.Num.Decimal (d0, d1, d2, d3, d4)  import qualified Control.Monad.HT as M import qualified Control.Applicative.HT as App-import Control.Arrow (arr, (<<<), (&&&), )-import Control.Monad (liftM2, foldM, )-import Control.Applicative (pure, (<*>), )+import Control.Arrow (arr, (<<<), (&&&))+import Control.Monad (liftM2, foldM)+import Control.Applicative (pure, (<$>), (<*>))  import NumericPrelude.Numeric import NumericPrelude.Base  -instance (Phi a) => Phi (Parameter a) where-   phis = Class.phisTraversable-   addPhis = Class.addPhisFoldable+instance (Tuple.Phi a) => Tuple.Phi (Parameter a) where+   phi = Tuple.phiTraversable+   addPhi = Tuple.addPhiFoldable -instance Undefined a => Undefined (Parameter a) where-   undefTuple = Class.undefTuplePointed+instance Tuple.Undefined a => Tuple.Undefined (Parameter a) where+   undef = Tuple.undefPointed  {- instance LLVM.ValueTuple a => LLVM.ValueTuple (Parameter a) where@@ -59,9 +59,9 @@    tupleDesc = Class.tupleDescFoldable -} -instance (Class.MakeValueTuple a) => Class.MakeValueTuple (Parameter a) where-   type ValueTuple (Parameter a) = Parameter (Class.ValueTuple a)-   valueTupleOf = Class.valueTupleOfFunctor+instance (Tuple.Value a) => Tuple.Value (Parameter a) where+   type ValueOf (Parameter a) = Parameter (Tuple.ValueOf a)+   valueOf = Tuple.valueOfFunctor   type ParameterStruct a = LLVM.Struct (a, (a, (a, (a, (a, ())))))@@ -107,7 +107,18 @@    decompose = Memory.decomposeRecord parameterMemory    compose = Memory.composeRecord parameterMemory +instance (Marshal.C a) => Marshal.C (Parameter a) where+   pack p =+      case Marshal.pack <$> p of+         Filt2.Parameter c0_ c1_ c2_ d1_ d2_ ->+            LLVM.consStruct c0_ c1_ c2_ d1_ d2_+   unpack = fmap Marshal.unpack . LLVM.uncurryStruct Filt2.Parameter +instance (Storable.C a) => Storable.C (Parameter a) where+   load = Storable.loadApplicative+   store = Storable.storeFoldable++ instance (Value.Flatten a) => Value.Flatten (Parameter a) where    type Registers (Parameter a) = Parameter (Value.Registers a)    flattenCode = Value.flattenCodeTraversable@@ -115,12 +126,12 @@   -instance (Phi a) => Phi (Filt2.State a) where-   phis = Class.phisTraversable-   addPhis = Class.addPhisFoldable+instance (Tuple.Phi a) => Tuple.Phi (Filt2.State a) where+   phi = Tuple.phiTraversable+   addPhi = Tuple.addPhiFoldable -instance Undefined a => Undefined (Filt2.State a) where-   undefTuple = Class.undefTuplePointed+instance Tuple.Undefined a => Tuple.Undefined (Filt2.State a) where+   undef = Tuple.undefPointed   type StateStruct a = LLVM.Struct (a, (a, (a, (a, (a, ())))))
src/Synthesizer/LLVM/Filter/SecondOrderCascade.hs view
@@ -18,32 +18,29 @@ import qualified Synthesizer.LLVM.CausalParameterized.Process as CausalP import qualified Synthesizer.LLVM.Causal.Process as Causal import qualified Synthesizer.LLVM.Simple.SignalPrivate as Sig-import Synthesizer.LLVM.CausalParameterized.Functional (($&), (&|&), )+import Synthesizer.LLVM.CausalParameterized.Functional (($&), (&|&))  import qualified Synthesizer.LLVM.Frame.SerialVector as Serial-import Synthesizer.Causal.Class (($<), )+import Synthesizer.Causal.Class (($<))  import qualified LLVM.Extra.Arithmetic as A-import qualified LLVM.Extra.Class as Class+import qualified LLVM.Extra.Tuple as Tuple import qualified LLVM.Extra.ScalarOrVector as SoV import qualified LLVM.Extra.Memory as Memory-import LLVM.Extra.Class (Undefined, undefTuple, )  import qualified LLVM.Core as LLVM-import LLVM.Util.Loop (Phi, phis, addPhis, )-import LLVM.Core (Value, IsArithmetic, IsSized, CodeGenFunction, )+import LLVM.Core (Value, IsArithmetic, IsSized, CodeGenFunction)  import qualified Type.Data.Num.Decimal as TypeNum-import Type.Data.Num.Decimal.Number ((:*:), )-import Type.Base.Proxy (Proxy, )+import Type.Data.Num.Decimal.Number ((:*:))+import Type.Base.Proxy (Proxy) -import Data.Word (Word32, )+import Data.Word (Word)  import qualified Control.Arrow as Arrow-import Control.Arrow ((>>>), (<<<), (^<<), (&&&), arr, )-import Control.Applicative (liftA2, )+import Control.Arrow ((>>>), (<<<), (^<<), (&&&), arr)+import Control.Applicative (liftA2) -import Foreign.Ptr (Ptr, )  import NumericPrelude.Numeric import NumericPrelude.Base@@ -58,32 +55,31 @@ because of IsSized constraint and it would also be wrong for Functor and friends.       deriving-         (Phi, Class.Undefined, Class.Zero,+         (Tuple.Phi, Tuple.Undefined, Tuple.Zero,           Functor, App.Applicative, Fold.Foldable, Trav.Traversable) -}  instance (TypeNum.Natural n, IsSized a) =>-      Phi (ParameterValue n a) where-   phis bb (ParameterValue r) =-      fmap ParameterValue $ phis bb r-   addPhis bb+      Tuple.Phi (ParameterValue n a) where+   phi bb (ParameterValue r) =+      fmap ParameterValue $ Tuple.phi bb r+   addPhi bb         (ParameterValue r)         (ParameterValue r') =-      addPhis bb r r'+      Tuple.addPhi bb r r'  instance (TypeNum.Natural n, IsSized a) =>-      Class.Undefined (ParameterValue n a) where-   undefTuple = ParameterValue Class.undefTuple+      Tuple.Undefined (ParameterValue n a) where+   undef = ParameterValue Tuple.undef  instance (TypeNum.Natural n, IsSized a) =>-      Class.Zero (ParameterValue n a) where-   zeroTuple = ParameterValue Class.zeroTuple+      Tuple.Zero (ParameterValue n a) where+   zero = ParameterValue Tuple.zero -instance (TypeNum.Natural n,-          Memory.FirstClass a, Memory.Stored a ~ am, IsSized a, IsSized am,+instance (TypeNum.Natural n, IsSized a,           TypeNum.Positive (n :*: LLVM.UnknownSize)) =>       Memory.C (ParameterValue n a) where-   type Struct (ParameterValue n a) = ParameterStruct n (Memory.Stored a)+   type Struct (ParameterValue n a) = ParameterStruct n a    load = Memory.loadNewtype ParameterValue    store = Memory.storeNewtype (\(ParameterValue k) -> k)    decompose = Memory.decomposeNewtype ParameterValue@@ -114,22 +110,17 @@   causalP ::-   (LLVM.Value a ~ A.Scalar v, A.PseudoModule v,-    Memory.FirstClass a, Memory.Stored a ~ am, IsSized a, IsSized am,-    Memory.C v,-    IsArithmetic a, SoV.IntegerConstant a, TypeNum.Natural n,+   (Memory.C v, A.PseudoModule v, A.Scalar v ~ LLVM.Value a,+    IsSized a, IsArithmetic a, SoV.IntegerConstant a, TypeNum.Natural n,     TypeNum.Positive (n :*: LLVM.UnknownSize)) =>    CausalP.T p (ParameterValue n a, v) v causalP = causal  causalPackedP ::-   (LLVM.Value a ~ A.Scalar v, A.PseudoModule v,+   (Memory.C v, A.PseudoRing v, A.IntegerConstant v, A.PseudoModule v,     Serial.C v, Serial.Element v ~ LLVM.Value a,-    SoV.IntegerConstant a,-    A.PseudoRing v, A.IntegerConstant v, Memory.C v,-    Memory.FirstClass a, Memory.Stored a ~ am, IsSized a, IsSized am,-    LLVM.IsPrimitive a,-    LLVM.IsPrimitive am,+    A.Scalar v ~ LLVM.Value a,+    SoV.IntegerConstant a, LLVM.IsPrimitive a, IsSized a,     TypeNum.Positive (n :*: LLVM.UnknownSize),     TypeNum.Natural n) =>    CausalP.T p (ParameterValue n a, v) v@@ -138,30 +129,25 @@  causal ::    (Causal.C process,-    LLVM.Value a ~ A.Scalar v, A.PseudoModule v,-    Memory.FirstClass a, Memory.Stored a ~ am, IsSized a, IsSized am,-    Memory.C v,-    IsArithmetic a, SoV.IntegerConstant a, TypeNum.Natural n,+    Memory.C v, A.PseudoModule v, A.Scalar v ~ LLVM.Value a,+    IsSized a, IsArithmetic a, SoV.IntegerConstant a, TypeNum.Natural n,     TypeNum.Positive (n :*: LLVM.UnknownSize)) =>    process (ParameterValue n a, v) v causal = causalGen Filt2.causal  causalPacked ::    (Causal.C process,-    LLVM.Value a ~ A.Scalar v, A.PseudoModule v,+    A.PseudoRing v, A.IntegerConstant v,+    Memory.C v, A.PseudoModule v, A.Scalar v ~ LLVM.Value a,     Serial.C v, Serial.Element v ~ LLVM.Value a,-    SoV.IntegerConstant a,-    A.PseudoRing v, A.IntegerConstant v, Memory.C v,-    Memory.FirstClass a, Memory.Stored a ~ am, IsSized a, IsSized am,-    LLVM.IsPrimitive a,-    LLVM.IsPrimitive am,+    SoV.IntegerConstant a, LLVM.IsPrimitive a, IsSized a,     TypeNum.Positive (n :*: LLVM.UnknownSize),     TypeNum.Natural n) =>    process (ParameterValue n a, v) v causalPacked = causalGen Filt2.causalPacked  causalGen ::-   (Causal.C process, IsSized a, Phi v, Undefined v,+   (Causal.C process, IsSized a, Tuple.Phi v, Tuple.Undefined v,     TypeNum.Natural n, TypeNum.Positive (n :*: LLVM.UnknownSize)) =>    process (Filt2Core.Parameter (Value a), v) v ->    process (ParameterValue n a, v) v@@ -185,7 +171,7 @@     TypeNum.Natural n, TypeNum.Positive (n :*: LLVM.UnknownSize)) =>    process (Filt2Core.Parameter (Value a), v) v ->    process-      (Value (Ptr (ParameterStruct n a)), (Value Word32, v)) (Value Word32, v)+      (Value (LLVM.Ptr (ParameterStruct n a)), (Value Word, v)) (Value Word, v) paramStage stage =    let p = arr fst        i = arr (fst.snd)@@ -202,7 +188,7 @@     TypeNum.Natural n, TypeNum.Positive (n :*: LLVM.UnknownSize)) =>    CausalP.T p (Filt2Core.Parameter (Value a), v) v ->    CausalP.T p-      (Value (Ptr (ParameterStruct n a)), (Value Word32, v)) (Value Word32, v)+      (Value (LLVM.Ptr (ParameterStruct n a)), (Value Word, v)) (Value Word, v) _paramStage stage =    Func.withGuidedArgs (Func.atom, (Func.atom, Func.atom)) $ \(p,(i,v)) ->       liftA2 (,) (i+1)@@ -230,7 +216,7 @@    (IsSized a,     TypeNum.Natural n, TypeNum.Positive (n :*: LLVM.UnknownSize)) =>    ParameterValue n a ->-   Word32 ->+   Word ->    CodeGenFunction r (Filt2Core.Parameter (Value a)) getStageParameter ps k =    Filt2.decomposeParameter =<< LLVM.extractvalue (parameterValue ps) k@@ -243,8 +229,8 @@ getStageParameterGEP ::    (IsSized a,     TypeNum.Natural n, TypeNum.Positive (n :*: LLVM.UnknownSize)) =>-   Value (Ptr (ParameterStruct n a)) ->-   Value Word32 -> CodeGenFunction r (Filt2Core.Parameter (Value a))+   Value (LLVM.Ptr (ParameterStruct n a)) ->+   Value Word -> CodeGenFunction r (Filt2Core.Parameter (Value a)) getStageParameterGEP ptr k =    Filt2.decomposeParameter     =<< LLVM.load
src/Synthesizer/LLVM/Filter/SecondOrderPacked.hs view
@@ -16,20 +16,19 @@ import qualified LLVM.Extra.Vector as Vector import qualified LLVM.Extra.Memory as Memory import qualified LLVM.Extra.Arithmetic as A-import LLVM.Extra.Class (Undefined, undefTuple, )+import qualified LLVM.Extra.Tuple as Tuple  import qualified LLVM.Core as LLVM import LLVM.Core    (Value, valueOf, Struct,     IsFirstClass, IsFloating,     Vector, IsPrimitive, IsSized,-    CodeGenFunction, )-import LLVM.Util.Loop (Phi, phis, addPhis, )+    CodeGenFunction)  import qualified Type.Data.Num.Decimal as TypeNum-import Type.Data.Num.Decimal (D4, d0, d1, (:*:), )+import Type.Data.Num.Decimal (D4, d0, d1, (:*:)) -import Control.Applicative (liftA2, )+import Control.Applicative (liftA2)  import qualified Algebra.Transcendental as Trans @@ -45,37 +44,33 @@ data Parameter a =    Parameter (Value a) (Value (Vector D4 a)) -instance (IsFirstClass a, IsPrimitive a) => Phi (Parameter a) where-   phis bb (Parameter r i) = do-      r' <- phis bb r-      i' <- phis bb i+instance (IsFirstClass a, IsPrimitive a) => Tuple.Phi (Parameter a) where+   phi bb (Parameter r i) = do+      r' <- Tuple.phi bb r+      i' <- Tuple.phi bb i       return (Parameter r' i')-   addPhis bb (Parameter r i) (Parameter r' i') = do-      addPhis bb r r'-      addPhis bb i i'+   addPhi bb (Parameter r i) (Parameter r' i') = do+      Tuple.addPhi bb r r'+      Tuple.addPhi bb i i' -instance (IsFirstClass a, IsPrimitive a) => Undefined (Parameter a) where-   undefTuple = Parameter undefTuple undefTuple+instance (IsFirstClass a, IsPrimitive a) => Tuple.Undefined (Parameter a) where+   undef = Parameter Tuple.undef Tuple.undef   type ParameterStruct a = Struct (a, (Vector D4 a, ()))  parameterMemory ::-   (Memory.FirstClass a, Memory.Stored a ~ am, IsSized a, IsSized am,-    IsPrimitive a, IsPrimitive am,-    TypeNum.Positive (D4 :*: LLVM.SizeOf am)) =>-   Memory.Record r (ParameterStruct am) (Parameter a)+   (IsPrimitive a, IsSized a, TypeNum.Positive (D4 :*: LLVM.SizeOf a)) =>+   Memory.Record r (ParameterStruct a) (Parameter a) parameterMemory =    liftA2 Parameter       (Memory.element (\(Parameter c0 _) -> c0) d0)       (Memory.element (\(Parameter _ cd) -> cd) d1)  instance-   (Memory.FirstClass a, Memory.Stored a ~ am, IsSized a, IsSized am,-    IsPrimitive a, IsPrimitive am,-    TypeNum.Positive (D4 :*: LLVM.SizeOf am)) =>+   (IsPrimitive a, IsSized a, TypeNum.Positive (D4 :*: LLVM.SizeOf a)) =>       Memory.C (Parameter a) where-   type Struct (Parameter a) = ParameterStruct (Memory.Stored a)+   type Struct (Parameter a) = ParameterStruct a    load = Memory.loadRecord parameterMemory    store = Memory.storeRecord parameterMemory    decompose = Memory.decomposeRecord parameterMemory@@ -112,13 +107,14 @@    return (y0, yv)  causal ::-   (Causal.C process, Vector.Arithmetic a, Memory.C (Value (State a))) =>+   (Causal.C process,+    Vector.Arithmetic a, Value (State a) ~ value, Memory.C value) =>    process (Parameter a, Value a) (Value a) causal =    Causal.mapAccum next (return A.zero)  {-# DEPRECATED causalP "use causal instead" #-} causalP ::-   (Vector.Arithmetic a, Memory.C (Value (State a))) =>+   (Vector.Arithmetic a, Value (State a) ~ value, Memory.C value) =>    CausalP.T p (Parameter a, Value a) (Value a) causalP = causal
src/Synthesizer/LLVM/Filter/Universal.hs view
@@ -7,7 +7,7 @@  import qualified Synthesizer.Plain.Filter.Recursive.Universal as Universal import Synthesizer.Plain.Filter.Recursive.Universal-          (Parameter(Parameter), Result, )+          (Parameter(Parameter), Result) import Synthesizer.Plain.Filter.Recursive (Pole(..))  import qualified Synthesizer.Plain.Modifier as Modifier@@ -17,27 +17,28 @@ import qualified Synthesizer.LLVM.Frame.SerialVector as Serial import qualified Synthesizer.LLVM.Simple.Value as Value +import qualified LLVM.Extra.Storable as Storable+import qualified LLVM.Extra.Marshal as Marshal import qualified LLVM.Extra.Memory as Memory-import qualified LLVM.Extra.Class as Class+import qualified LLVM.Extra.Tuple as Tuple import qualified LLVM.Extra.Vector as Vector import qualified LLVM.Extra.Arithmetic as A-import LLVM.Extra.Class (Undefined, undefTuple, )  import qualified LLVM.Core as LLVM-import LLVM.Core (CodeGenFunction, )-import LLVM.Util.Loop (Phi, phis, addPhis, )+import LLVM.Core (CodeGenFunction) -import Type.Data.Num.Decimal (d0, d1, d2, d3, d4, d5, )+import Type.Data.Num.Decimal (d0, d1, d2, d3, d4, d5)  import qualified Control.Applicative.HT as App+import Control.Applicative ((<$>))  -instance (Phi a) => Phi (Parameter a) where-   phis = Class.phisTraversable-   addPhis = Class.addPhisFoldable+instance (Tuple.Phi a) => Tuple.Phi (Parameter a) where+   phi = Tuple.phiTraversable+   addPhi = Tuple.addPhiFoldable -instance Undefined a => Undefined (Parameter a) where-   undefTuple = Class.undefTuplePointed+instance Tuple.Undefined a => Tuple.Undefined (Parameter a) where+   undef = Tuple.undefPointed   type ParameterStruct a = LLVM.Struct (a, (a, (a, (a, (a, (a, ()))))))@@ -62,6 +63,17 @@    decompose = Memory.decomposeRecord parameterMemory    compose = Memory.composeRecord parameterMemory +instance (Marshal.C a) => Marshal.C (Parameter a) where+   pack p =+      case Marshal.pack <$> p of+         Parameter k1 k2 ampIn ampI1 ampI2 ampLimit ->+            LLVM.consStruct k1 k2 ampIn ampI1 ampI2 ampLimit+   unpack = fmap Marshal.unpack . LLVM.uncurryStruct Parameter++instance (Storable.C a) => Storable.C (Parameter a) where+   load = Storable.loadApplicative+   store = Storable.storeFoldable+ {- instance LLVM.ValueTuple a => LLVM.ValueTuple (Result a) where    buildTuple f = Class.buildTupleTraversable (LLVM.buildTuple f)@@ -70,9 +82,9 @@    tupleDesc = Class.tupleDescFoldable -} -instance (Class.MakeValueTuple a) => Class.MakeValueTuple (Result a) where-   type ValueTuple (Result a) = Result (Class.ValueTuple a)-   valueTupleOf = Class.valueTupleOfFunctor+instance (Tuple.Value a) => Tuple.Value (Result a) where+   type ValueOf (Result a) = Result (Tuple.ValueOf a)+   valueOf = Tuple.valueOfFunctor  instance (Value.Flatten a) => Value.Flatten (Result a) where    type Registers (Result a) = Result (Value.Registers a)@@ -88,9 +100,9 @@    tupleDesc = Class.tupleDescFoldable -} -instance (Class.MakeValueTuple a) => Class.MakeValueTuple (Parameter a) where-   type ValueTuple (Parameter a) = Parameter (Class.ValueTuple a)-   valueTupleOf = Class.valueTupleOfFunctor+instance (Tuple.Value a) => Tuple.Value (Parameter a) where+   type ValueOf (Parameter a) = Parameter (Tuple.ValueOf a)+   valueOf = Tuple.valueOfFunctor  instance (Value.Flatten a) => Value.Flatten (Parameter a) where    type Registers (Parameter a) = Parameter (Value.Registers a)@@ -108,12 +120,12 @@    insert = Vector.insertTraversable  -instance (Phi a) => Phi (Result a) where-   phis = Class.phisTraversable-   addPhis = Class.addPhisFoldable+instance (Tuple.Phi a) => Tuple.Phi (Result a) where+   phi = Tuple.phiTraversable+   addPhi = Tuple.addPhiFoldable -instance Undefined a => Undefined (Result a) where-   undefTuple = Class.undefTuplePointed+instance Tuple.Undefined a => Tuple.Undefined (Result a) where+   undef = Tuple.undefPointed  instance (Vector.Simple v) => Vector.Simple (Result v) where    type Element (Result v) = Result (Vector.Element v)
src/Synthesizer/LLVM/ForeignPtr.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-} {- | Adding the finalizer to a ForeignPtr seems to be the only way that warrants execution of the finalizer (not too early and not never).@@ -11,18 +11,16 @@ -} module Synthesizer.LLVM.ForeignPtr where -import qualified LLVM.Extra.Memory as Memory-import LLVM.Extra.Class (MakeValueTuple, ValueTuple, )-+import qualified LLVM.DSL.Execution as Exec+import qualified LLVM.Extra.Marshal as Marshal import qualified LLVM.ExecutionEngine as EE+import qualified LLVM.Core as LLVM -import qualified Foreign.Marshal.Utils as Marshal import qualified Foreign.ForeignPtr as FPtr import qualified Foreign.Concurrent as FC-import Foreign.ForeignPtr (ForeignPtr, withForeignPtr, )+import Foreign.ForeignPtr (ForeignPtr, withForeignPtr) import Foreign.StablePtr (newStablePtr, freeStablePtr)-import Foreign.Storable (Storable, poke, )-import Foreign.Ptr (Ptr, nullPtr, )+import Foreign.Ptr (nullPtr)   newAux :: IO () -> IO (ForeignPtr ())@@ -34,29 +32,31 @@    stable <- newStablePtr ee    return $ finalizer >> freeStablePtr stable -newInit ::-   (EE.ExecutionEngine, Ptr a -> IO ()) -> IO (Ptr a) -> IO (ForeignPtr a)+type MemoryPtr struct = ForeignPtr (EE.Stored struct)++newInit :: Exec.Finalizer a -> IO (LLVM.Ptr a) -> IO (MemoryPtr a) newInit (ee, stop) start = do    state <- start-   FC.newForeignPtr state =<< makeFinalizer (ee, stop state)+   FC.newForeignPtr (EE.castToStoredPtr state)+      =<< makeFinalizer (ee, stop state)  newParam ::-   (Storable b, MakeValueTuple b, Memory.C (ValueTuple b)) =>-   (EE.ExecutionEngine, Ptr a -> IO ()) ->-   (Ptr (Memory.Struct (ValueTuple b)) -> IO (Ptr a)) ->-   b -> IO (ForeignPtr a)+   (Marshal.C b) =>+   Exec.Finalizer a ->+   (LLVM.Ptr (Marshal.Struct b) -> IO (LLVM.Ptr a)) ->+   b -> IO (MemoryPtr a) newParam stop start b =-   newInit stop (Marshal.with b (start . Memory.castTuplePtr))+   newInit stop (Marshal.with b start) -new :: Storable a => IO () -> a -> IO (ForeignPtr a)+new ::+   (Marshal.C a, Marshal.Struct a ~ struct) =>+   IO () -> a -> IO (MemoryPtr struct) new finalizer a = do    ptr <- FPtr.mallocForeignPtr    FC.addForeignPtrFinalizer ptr finalizer-   withForeignPtr ptr (flip poke a)+   with ptr $ flip Marshal.poke a    return ptr -with ::-   (Storable a, MakeValueTuple a, Memory.C (ValueTuple a)) =>-   ForeignPtr a -> (Ptr (Memory.Struct (ValueTuple a)) -> IO b) -> IO b-with fp func =-   withForeignPtr fp (func . Memory.castTuplePtr)++with :: MemoryPtr struct -> (LLVM.Ptr struct -> IO a) -> IO a+with fptr act = withForeignPtr fptr $ act . EE.castFromStoredPtr
src/Synthesizer/LLVM/Frame.hs view
@@ -11,17 +11,15 @@ import qualified LLVM.Core as LLVM import LLVM.Core           (CodeGenFunction, Value, Vector,-           IsPrimitive, IsArithmetic, )+           IsPrimitive, IsArithmetic)  import qualified Type.Data.Num.Decimal as TypeNum-import Type.Data.Num.Decimal (D2, D4, )--import Foreign.Storable.Tuple ()+import Type.Data.Num.Decimal (D2, D4)  import qualified Data.Traversable as Trav import qualified Data.Foldable as Fold -import NumericPrelude.Numeric hiding (zero, one, div, signum, )+import NumericPrelude.Numeric hiding (zero, one, div, signum) import NumericPrelude.Base
src/Synthesizer/LLVM/Frame/SerialVector.hs view
@@ -33,7 +33,7 @@    upsample, subsample,    cumulate, iterate, iteratePlain, reverse,    shiftUp, shiftUpMultiZero, shiftDownMultiZero,-   replicate, replicateOf, fromList, fromFixedList,+   replicate, replicate_, replicateOf, fromList, fromFixedList,    mapPlain, mapV, zipV,    ) where @@ -41,21 +41,20 @@  import qualified LLVM.Extra.Vector as Vector import qualified LLVM.Extra.Arithmetic as A-import qualified LLVM.Extra.Class as Class+import qualified LLVM.Extra.Tuple as Tuple+import qualified LLVM.Extra.Storable as Storable+import qualified LLVM.Extra.Marshal as Marshal import qualified LLVM.Extra.Memory as Memory-import LLVM.Extra.Class (MakeValueTuple, valueTupleOf, ) -import qualified LLVM.Util.Loop as Loop import qualified LLVM.Core as LLVM-import LLVM.Util.Loop (Phi, )  import qualified Type.Data.Num.Decimal as TypeNum  import qualified Foreign.Storable as St-import Data.Word (Word32, )+import Data.Word (Word32) -import Control.Monad (liftM2, liftM3, foldM, replicateM, (<=<), )-import Control.Applicative (liftA2, )+import Control.Monad (liftM2, liftM3, foldM, replicateM, (<=<))+import Control.Applicative (liftA2) import qualified Control.Monad.Trans.State as MS import qualified Control.Applicative as App import qualified Data.Traversable as Trav@@ -64,9 +63,9 @@ import qualified Data.NonEmpty as NonEmpty import qualified Data.List.HT as ListHT import qualified Data.List as List-import Data.Tuple.HT (mapSnd, fst3, snd3, thd3, )+import Data.Tuple.HT (mapSnd, fst3, snd3, thd3) -import Prelude hiding (Read, replicate, reverse, iterate, )+import Prelude hiding (Read, replicate, reverse, iterate)   {-@@ -87,13 +86,13 @@ newtype T v = Cons v    deriving (       Eq, St.Storable,-      Class.Zero, Class.Undefined,+      Tuple.Zero, Tuple.Undefined,       A.IntegerConstant, A.RationalConstant, Num) --      SoV.IntegerConstant, SoV.RationalConstant, SoV.TranscendentalConstant) -instance (Phi v) => Phi (T v) where-   phis bb (Cons v) = fmap Cons $ Loop.phis bb v-   addPhis bb (Cons x) (Cons y) = Loop.addPhis bb x y+instance (Tuple.Phi v) => Tuple.Phi (T v) where+   phi bb (Cons v) = fmap Cons $ Tuple.phi bb v+   addPhi bb (Cons x) (Cons y) = Tuple.addPhi bb x y  instance (A.Additive v) => A.Additive (T v) where    add = lift2 A.add@@ -155,6 +154,9 @@ replicate :: (TypeNum.Positive n) => a -> Plain n a replicate x = Cons $ App.pure x +replicate_ :: (TypeNum.Positive n) => TypeNum.Singleton n -> a -> Plain n a+replicate_ _ = replicate+ replicateOf :: (TypeNum.Positive n, LLVM.IsPrimitive a, LLVM.IsConst a) => a -> Value n a replicateOf x = Cons $ LLVM.valueOf $ App.pure x @@ -171,11 +173,11 @@   newtype Iterator mode it v = Iterator {unIterator :: it}-   deriving (Class.Undefined)+   deriving (Tuple.Undefined) -instance Phi it => Phi (Iterator mode it v) where-   phis bb (Iterator x) = fmap Iterator $ Loop.phis bb x-   addPhis bb (Iterator x) (Iterator y) = Loop.addPhis bb x y+instance Tuple.Phi it => Tuple.Phi (Iterator mode it v) where+   phi bb (Iterator x) = fmap Iterator $ Tuple.phi bb x+   addPhi bb (Iterator x) (Iterator y) = Tuple.addPhi bb x y   type ReadIterator = Iterator ReadMode@@ -221,8 +223,8 @@  class    (TypeNum.Positive (Size v), Sized v,-    Phi (ReadIt v), Class.Undefined (ReadIt v),-    Phi v, Class.Undefined v) =>+    Tuple.Phi (ReadIt v), Tuple.Undefined (ReadIt v),+    Tuple.Phi v, Tuple.Undefined v) =>       Read v where     type Element v :: *@@ -241,14 +243,14 @@       ReadIterator (ReadIt v) v ->       LLVM.CodeGenFunction r (Element v, ReadIterator (ReadIt v) v) -class (Read v, Phi (WriteIt v), Class.Undefined (WriteIt v)) => C v where+class (Read v, Tuple.Phi (WriteIt v), Tuple.Undefined (WriteIt v)) => C v where    type WriteIt v :: *     insert :: LLVM.Value Word32 -> Element v -> v -> LLVM.CodeGenFunction r v     assemble :: [Element v] -> LLVM.CodeGenFunction r v    assemble =-      foldM (\v (k,x) -> insert (LLVM.valueOf k) x v) Class.undefTuple .+      foldM (\v (k,x) -> insert (LLVM.valueOf k) x v) Tuple.undef .       zip [0..]     writeStart :: LLVM.CodeGenFunction r (WriteIterator (WriteIt v) v)@@ -257,7 +259,7 @@       LLVM.CodeGenFunction r (WriteIterator (WriteIt v) v)    writeStop :: WriteIterator (WriteIt v) v -> LLVM.CodeGenFunction r v -class (C v, Phi (WriteIt v), Class.Zero (WriteIt v)) => Zero v where+class (C v, Tuple.Phi (WriteIt v), Tuple.Zero (WriteIt v)) => Zero v where    -- initializes the target with zeros    -- you may only call 'writeStop' on the result of 'writeZero'    writeZero :: LLVM.CodeGenFunction r (WriteIterator (WriteIt v) v)@@ -289,14 +291,14 @@     insert k a (Cons v) = fmap Cons $ Vector.insert k a v -   writeStart = return (Iterator Class.undefTuple)+   writeStart = return (Iterator Tuple.undef)    writeNext x (Iterator v0) = do       v1 <- fmap snd $ Vector.shiftDown x v0       return (Iterator v1)    writeStop (Iterator v0) = return (Cons v0) -instance (Vector.C v, Class.Zero v) => Zero (T v) where-   writeZero = return (Iterator Class.zeroTuple)+instance (Vector.C v, Tuple.Zero v) => Zero (T v) where+   writeZero = return (Iterator Tuple.zero)   instance@@ -571,9 +573,9 @@    fmap combineItFunctor $ Trav.sequence $ App.pure writeZero  -instance (MakeValueTuple v) => MakeValueTuple (T v) where-   type ValueTuple (T v) = T (Class.ValueTuple v)-   valueTupleOf (Cons v) = Cons (Class.valueTupleOf v)+instance (Tuple.Value v) => Tuple.Value (T v) where+   type ValueOf (T v) = T (Tuple.ValueOf v)+   valueOf (Cons v) = Cons (Tuple.valueOf v)  instance (Memory.C v) => Memory.C (T v) where    type Struct (T v) = Memory.Struct v@@ -581,6 +583,14 @@    store = Memory.storeNewtype (\(Cons v) -> v)    decompose = Memory.decomposeNewtype Cons    compose = Memory.composeNewtype (\(Cons v) -> v)++instance (Marshal.C v) => Marshal.C (T v) where+   pack (Cons v) = Marshal.pack v+   unpack v = Cons $ Marshal.unpack v++instance (Storable.C v) => Storable.C (T v) where+   load = Storable.loadNewtype Cons Cons+   store = Storable.storeNewtype Cons (\(Cons v) -> v)   mapV :: (Functor m) =>
src/Synthesizer/LLVM/Frame/Stereo.hs view
@@ -21,30 +21,28 @@ import qualified Synthesizer.Frame.Stereo as Stereo  import qualified LLVM.Extra.Arithmetic as A-import qualified LLVM.Extra.Class as Class+import qualified LLVM.Extra.Tuple as Tuple+import qualified LLVM.Extra.Storable as Storable+import qualified LLVM.Extra.Marshal as Marshal import qualified LLVM.Extra.Memory as Memory import qualified LLVM.Extra.Control as C import qualified LLVM.Extra.Vector as Vector import qualified LLVM.Core as LLVM-import LLVM.Extra.Class-   (Undefined, undefTuple,-    MakeValueTuple, ValueTuple, valueTupleOf, )-import LLVM.Util.Loop (Phi, phis, addPhis, ) -import Type.Data.Num.Decimal (d0, d1, )+import Type.Data.Num.Decimal (d0, d1) -import Control.Monad (liftM2, )-import Control.Applicative (liftA2, )+import Control.Monad (liftM2)+import Control.Applicative (liftA2) import qualified Data.Traversable as Trav -import Prelude hiding (Either(Left, Right), sequence, )+import Prelude hiding (Either(Left, Right), sequence)  -instance (Class.Zero a) => Class.Zero (Stereo.T a) where-   zeroTuple = Stereo.cons Class.zeroTuple Class.zeroTuple+instance (Tuple.Zero a) => Tuple.Zero (Stereo.T a) where+   zero = Stereo.cons Tuple.zero Tuple.zero -instance (Undefined a) => Undefined (Stereo.T a) where-   undefTuple = Stereo.cons undefTuple undefTuple+instance (Tuple.Undefined a) => Tuple.Undefined (Stereo.T a) where+   undef = Stereo.cons Tuple.undef Tuple.undef  instance (C.Select a) => C.Select (Stereo.T a) where    select = C.selectTraversable@@ -53,15 +51,15 @@ instance LLVM.CmpRet a, LLVM.CmpResult a ~ b => LLVM.CmpRet (Stereo.T a) (Stereo.T b) where -} -instance (MakeValueTuple h) => MakeValueTuple (Stereo.T h) where-   type ValueTuple (Stereo.T h) = Stereo.T (ValueTuple h)-   valueTupleOf s =+instance (Tuple.Value h) => Tuple.Value (Stereo.T h) where+   type ValueOf (Stereo.T h) = Stereo.T (Tuple.ValueOf h)+   valueOf s =       Stereo.cons-         (Class.valueTupleOf $ Stereo.left s)-         (Class.valueTupleOf $ Stereo.right s)+         (Tuple.valueOf $ Stereo.left s)+         (Tuple.valueOf $ Stereo.right s)  {--instance ValueTuple a => ValueTuple (Stereo.T a) where+instance Tuple.Value a => Tuple.Value (Stereo.T a) where    buildTuple f =       liftM2 Stereo.cons (buildTuple f) (buildTuple f) @@ -71,14 +69,14 @@       tupleDesc (Stereo.right s) -} -instance (Phi a) => Phi (Stereo.T a) where-   phis bb v =+instance (Tuple.Phi a) => Tuple.Phi (Stereo.T a) where+   phi bb v =       liftM2 Stereo.cons-         (phis bb (Stereo.left v))-         (phis bb (Stereo.right v))-   addPhis bb x y = do-      addPhis bb (Stereo.left  x) (Stereo.left  y)-      addPhis bb (Stereo.right x) (Stereo.right y)+         (Tuple.phi bb (Stereo.left v))+         (Tuple.phi bb (Stereo.right v))+   addPhi bb x y = do+      Tuple.addPhi bb (Stereo.left  x) (Stereo.left  y)+      Tuple.addPhi bb (Stereo.right x) (Stereo.right y)   instance (Vector.Simple v) => Vector.Simple (Stereo.T v) where@@ -107,6 +105,14 @@    store = Memory.storeRecord memory    decompose = Memory.decomposeRecord memory    compose = Memory.composeRecord memory++instance (Marshal.C l) => Marshal.C (Stereo.T l) where+   pack x = Marshal.pack (Stereo.left x, Stereo.right x)+   unpack = uncurry Stereo.cons . Marshal.unpack++instance (Storable.C l) => Storable.C (Stereo.T l) where+   load = Storable.loadApplicative+   store = Storable.storeFoldable   {-
src/Synthesizer/LLVM/Frame/StereoInterleaved.hs view
@@ -39,28 +39,24 @@  import qualified LLVM.Extra.Arithmetic as A import qualified LLVM.Extra.Control as C-import qualified LLVM.Extra.Class as Class+import qualified LLVM.Extra.Tuple as Tuple+import qualified LLVM.Extra.Storable as Storable import qualified LLVM.Extra.Memory as Memory import qualified LLVM.Extra.ScalarOrVector as SoV import qualified LLVM.Extra.Vector as Vector import qualified LLVM.Core as LLVM-import LLVM.Extra.Class-   (Undefined, undefTuple,-    MakeValueTuple, valueTupleOf, )-import LLVM.Core (Vector, IsSized, SizeOf, )-import LLVM.Util.Loop (Phi, phis, addPhis, )+import LLVM.Core (Vector, IsSized, SizeOf)  import qualified Type.Data.Num.Decimal as TypeNum -import Foreign.Ptr (castPtr, ) import qualified Foreign.Storable as St--- import Data.Word (Word32, )+import Foreign.Ptr (Ptr, castPtr)  import qualified Data.Foldable as Fold-import Control.Monad (liftM2, )-import Control.Applicative (liftA2, pure, )+import Control.Monad (liftM2)+import Control.Applicative (liftA2, pure) -import Data.Tuple.HT (mapPair, )+import Data.Tuple.HT (mapPair)  import qualified Algebra.Additive as Additive @@ -144,17 +140,17 @@       in  St.pokeElemOff p 0 v0 >>           St.pokeElemOff p 1 v1 -instance (TypeNum.Positive n, LLVM.IsPrimitive a) => Class.Zero (Value n a) where-   zeroTuple = Value Class.zeroTuple Class.zeroTuple+instance (TypeNum.Positive n, LLVM.IsPrimitive a) => Tuple.Zero (Value n a) where+   zero = Value Tuple.zero Tuple.zero -instance (TypeNum.Positive n, LLVM.IsPrimitive a) => Undefined (Value n a) where-   undefTuple = Value (LLVM.value LLVM.undef) (LLVM.value LLVM.undef)+instance (TypeNum.Positive n, LLVM.IsPrimitive a) => Tuple.Undefined (Value n a) where+   undef = Value (LLVM.value LLVM.undef) (LLVM.value LLVM.undef)  {- Can only be implemented by ifThenElse since the atomic 'select' command wants a bool vector. -instance (TypeNum.Positive n, LLVM.IsPrimitive a, Phi a) => C.Select (Value n a) where+instance (TypeNum.Positive n, LLVM.IsPrimitive a, Tuple.Phi a) => C.Select (Value n a) where    select b (Value x0 x1) (Value y0 y1) =       liftM2 Value          (C.select b x0 y0)@@ -164,16 +160,16 @@ -}  instance (TypeNum.Positive n, LLVM.IsPrimitive a, LLVM.IsConst a) =>-      MakeValueTuple (T n a) where-   type ValueTuple (T n a) = Value n a-   valueTupleOf (Cons v0 v1) =+      Tuple.Value (T n a) where+   type ValueOf (T n a) = Value n a+   valueOf (Cons v0 v1) =       Value          (LLVM.valueOf v0)          (LLVM.valueOf v1) -instance (TypeNum.Positive n, LLVM.IsPrimitive a) => Phi (Value n a) where-   phis bb = mapV (phis bb)-   addPhis bb = zipV (\_ _ -> ()) (addPhis bb)+instance (TypeNum.Positive n, LLVM.IsPrimitive a) => Tuple.Phi (Value n a) where+   phi bb = mapV (Tuple.phi bb)+   addPhi bb = zipV (\_ _ -> ()) (Tuple.addPhi bb)   instance (TypeNum.Positive n) => Serial.Sized (Value n a) where@@ -214,7 +210,7 @@ The implementation of 'insert' may need to perform arithmetics at run-time and is thus a bit inefficient. -}-instance (TypeNum.Positive n, LLVM.IsPrimitive a, LLVM.IsFirstClass a) => Serial.C (Value n a) where+instance (TypeNum.Positive n, LLVM.IsPrimitive a) => Serial.C (Value n a) where    type WriteIt (Value n a) = Value n a     insert k x v =@@ -234,7 +230,7 @@     assemble = assemble -   writeStart = return (Serial.Iterator Class.undefTuple)+   writeStart = return (Serial.Iterator Tuple.undef)    writeNext x (Serial.Iterator v) = do       xs <- extractAll v       fmap Serial.Iterator $ assemble $ tail xs ++ [x]@@ -244,10 +240,9 @@ type Struct n a = LLVM.Struct (Vector n a, (Vector n a, ()))  memory ::-   (TypeNum.Positive n, LLVM.IsPrimitive a, LLVM.IsPrimitive am,-    Memory.FirstClass a, Memory.Stored a ~ am,-    IsSized am, TypeNum.Positive (n TypeNum.:*: SizeOf am)) =>-   Memory.Record r (Struct n am) (Value n a)+   (TypeNum.Positive n, LLVM.IsPrimitive a, IsSized a,+    TypeNum.Positive (n TypeNum.:*: SizeOf a)) =>+   Memory.Record r (Struct n a) (Value n a) memory =    liftA2 Value       (Memory.element (\(Value v _) -> v) TypeNum.d0)@@ -255,17 +250,34 @@  instance       (TypeNum.Positive n,-       Memory.FirstClass a, Memory.Stored a ~ am,-       LLVM.IsPrimitive a,  IsSized a,-       TypeNum.Positive (n TypeNum.:*: SizeOf a),-       LLVM.IsPrimitive am, IsSized am,-       TypeNum.Positive (n TypeNum.:*: SizeOf am)) =>+       LLVM.IsPrimitive a, IsSized a,+       TypeNum.Positive (n TypeNum.:*: SizeOf a)) =>       Memory.C (Value n a) where-   type Struct (Value n a) = Struct n (Memory.Stored a)+   type Struct (Value n a) = Struct n a    load = Memory.loadRecord memory    store = Memory.storeRecord memory    decompose = Memory.decomposeRecord memory    compose = Memory.composeRecord memory++instance+   (TypeNum.Positive n, Tuple.VectorValue n a,+    Tuple.VectorValueOf n a ~ LLVM.Value (Vector n a),+    LLVM.IsPrimitive a, LLVM.IsConst a, Storable.Vector a) =>+      Storable.C (T n a) where+   load ptrV = do+      ptr <- castHalfPtr ptrV+      liftM2 Value+         (Storable.load ptr)+         (Storable.load =<< Storable.incrementPtr ptr)+   store (Value v0 v1) ptrV = do+      ptr <- castHalfPtr ptrV+      Storable.storeNext v0 ptr >>= Storable.store v1++castHalfPtr ::+   LLVM.Value (Ptr (T n a)) ->+   LLVM.CodeGenFunction r (LLVM.Value (Ptr (Vector n a)))+castHalfPtr = LLVM.bitcast+  {- | This instance allows to run @arrange@ on interleaved stereo vectors.
src/Synthesizer/LLVM/Generator/Exponential2.hs view
@@ -20,27 +20,27 @@  import qualified Synthesizer.LLVM.CausalParameterized.Process as CausalP import qualified Synthesizer.LLVM.Simple.Value as Value-import qualified Synthesizer.LLVM.Parameter as Param import qualified Synthesizer.LLVM.Frame.SerialVector as Serial import qualified Synthesizer.LLVM.CausalParameterized.Functional as F +import qualified LLVM.DSL.Parameter as Param+ import qualified LLVM.Extra.ScalarOrVector as SoV import qualified LLVM.Extra.Vector as Vector+import qualified LLVM.Extra.Storable as Storable+import qualified LLVM.Extra.Marshal as Marshal import qualified LLVM.Extra.Memory as Memory-import qualified LLVM.Extra.Class as Class+import qualified LLVM.Extra.Tuple as Tuple import qualified LLVM.Extra.Arithmetic as A-import LLVM.Extra.Class (MakeValueTuple, ValueTuple, Undefined, undefTuple, )  import qualified LLVM.Core as LLVM import LLVM.Core-   (Value, IsArithmetic, IsPrimitive, IsFloating, IsSized, SizeOf,-    CodeGenFunction, )-import LLVM.Util.Loop (Phi, phis, addPhis, )+         (CodeGenFunction, Value, IsArithmetic, IsPrimitive, IsFloating, SizeOf)  import qualified Type.Data.Num.Decimal as TypeNum-import Type.Data.Num.Decimal.Number ((:*:), )+import Type.Data.Num.Decimal.Number ((:*:)) -import Foreign.Storable (Storable, )+import Foreign.Storable (Storable) import qualified Foreign.Storable -- import qualified Foreign.Storable.Record as Store import qualified Foreign.Storable.Traversable as Store@@ -48,13 +48,11 @@ import qualified Control.Applicative as App import qualified Data.Foldable as Fold import qualified Data.Traversable as Trav-import Control.Applicative (liftA2, (<*>), )-import Control.Arrow (arr, (^<<), (&&&), )-import Control.Monad (liftM2, )+import Control.Applicative (liftA2, (<*>))+import Control.Arrow (arr, (^<<), (&&&))+import Control.Monad (liftM2)  import qualified Algebra.Transcendental as Trans--- import qualified Algebra.Field as Field--- import qualified Algebra.Ring as Ring  import NumericPrelude.Numeric import NumericPrelude.Base@@ -85,15 +83,15 @@       fmap Parameter k  -instance (Phi a) => Phi (Parameter a) where-   phis = Class.phisTraversable-   addPhis = Class.addPhisFoldable+instance (Tuple.Phi a) => Tuple.Phi (Parameter a) where+   phi = Tuple.phiTraversable+   addPhi = Tuple.addPhiFoldable -instance Undefined a => Undefined (Parameter a) where-   undefTuple = Class.undefTuplePointed+instance Tuple.Undefined a => Tuple.Undefined (Parameter a) where+   undef = Tuple.undefPointed -instance Class.Zero a => Class.Zero (Parameter a) where-   zeroTuple = Class.zeroTuplePointed+instance Tuple.Zero a => Tuple.Zero (Parameter a) where+   zero = Tuple.zeroPointed  instance (Memory.C a) => Memory.C (Parameter a) where    type Struct (Parameter a) = Memory.Struct a@@ -102,6 +100,9 @@    decompose = Memory.decomposeNewtype Parameter    compose = Memory.composeNewtype (\(Parameter k) -> k) +instance (Storable.C a) => Storable.C (Parameter a) where+   load = Storable.loadNewtype Parameter Parameter+   store = Storable.storeNewtype Parameter (\(Parameter k) -> k)  {- instance LLVM.ValueTuple a => LLVM.ValueTuple (Parameter a) where@@ -111,9 +112,9 @@    tupleDesc = Class.tupleDescFoldable -} -instance (MakeValueTuple a) => MakeValueTuple (Parameter a) where-   type ValueTuple (Parameter a) = Parameter (Class.ValueTuple a)-   valueTupleOf = Class.valueTupleOfFunctor+instance (Tuple.Value a) => Tuple.Value (Parameter a) where+   type ValueOf (Parameter a) = Parameter (Tuple.ValueOf a)+   valueOf = Tuple.valueOfFunctor   instance (Value.Flatten a) => Value.Flatten (Parameter a) where@@ -146,8 +147,7 @@   causalP ::-   (Storable a, MakeValueTuple a, ValueTuple a ~ al,-    Memory.C al, A.PseudoRing al) =>+   (Marshal.C a, Tuple.ValueOf a ~ al, A.PseudoRing al) =>    Param.T p a ->    CausalP.T p (Parameter al) al causalP initial =@@ -183,15 +183,15 @@          (ppFeedback p) (ppCurrent p)  -instance (Phi a) => Phi (ParameterPacked a) where-   phis = Class.phisTraversable-   addPhis = Class.addPhisFoldable+instance (Tuple.Phi a) => Tuple.Phi (ParameterPacked a) where+   phi = Tuple.phiTraversable+   addPhi = Tuple.addPhiFoldable -instance Undefined a => Undefined (ParameterPacked a) where-   undefTuple = Class.undefTuplePointed+instance Tuple.Undefined a => Tuple.Undefined (ParameterPacked a) where+   undef = Tuple.undefPointed -instance Class.Zero a => Class.Zero (ParameterPacked a) where-   zeroTuple = Class.zeroTuplePointed+instance Tuple.Zero a => Tuple.Zero (ParameterPacked a) where+   zero = Tuple.zeroPointed   {-@@ -234,7 +234,11 @@    decompose = Memory.decomposeRecord memory    compose = Memory.composeRecord memory +instance (Storable.C a) => Storable.C (ParameterPacked a) where+   load = Storable.loadApplicative+   store = Storable.storeFoldable + {- instance LLVM.ValueTuple a => LLVM.ValueTuple (ParameterPacked a) where    buildTuple f = Class.buildTupleTraversable (LLVM.buildTuple f)@@ -243,9 +247,9 @@    tupleDesc = Class.tupleDescFoldable -} -instance (MakeValueTuple a) => MakeValueTuple (ParameterPacked a) where-   type ValueTuple (ParameterPacked a) = ParameterPacked (Class.ValueTuple a)-   valueTupleOf = Class.valueTupleOfFunctor+instance (Tuple.Value a) => Tuple.Value (ParameterPacked a) where+   type ValueOf (ParameterPacked a) = ParameterPacked (Tuple.ValueOf a)+   valueOf = Tuple.valueOfFunctor   instance (Value.Flatten a) => Value.Flatten (ParameterPacked a) where@@ -299,23 +303,29 @@ parameterPackedPlain halfLife =    withSizePlain $ \n ->    ParameterPacked-      (Serial.replicate (0.5 ** (fromInteger (TypeNum.integralFromSingleton n) / halfLife)))+      (Serial.replicate_ n (0.5 ** (fromInteger (TypeNum.integerFromSingleton n) / halfLife)))       (Serial.iteratePlain (0.5 ** recip halfLife *) one)  +withSizeValue ::+   (TypeNum.Natural n) =>+   (TypeNum.Singleton n -> f (Serial.Value n a)) ->+   f (Serial.Value n a)+withSizeValue f = f TypeNum.singleton+ causalPackedP ::    (IsArithmetic a, SoV.IntegerConstant a,-    Storable a, MakeValueTuple a, ValueTuple a ~ (Value a),-    Memory.FirstClass a, Memory.Stored a ~ am, IsSized am,-    IsPrimitive a, IsPrimitive am,+    Marshal.C a, Tuple.ValueOf a ~ Value a,+    Marshal.Vector n a, Tuple.VectorValueOf n a ~ Value (LLVM.Vector n a),+    IsPrimitive a,     TypeNum.Positive (n :*: SizeOf a),-    TypeNum.Positive (n :*: SizeOf am),     TypeNum.Positive n) =>    Param.T p a ->    CausalP.T p (ParameterPacked (Serial.Value n a)) (Serial.Value n a) causalPackedP initial =+   withSizeValue $ \n ->    CausalP.loop-      (Serial.replicate ^<< initial)+      (Serial.replicate_ n ^<< initial)       (CausalP.mapSimple $        \(p, s0) -> liftM2 (,)           (A.mul (ppCurrent p) s0)
src/Synthesizer/LLVM/Interpolation.hs view
@@ -26,29 +26,28 @@  import qualified LLVM.Extra.Scalar as Scalar import qualified LLVM.Extra.Arithmetic as A-import qualified LLVM.Extra.Class as Class+import qualified LLVM.Extra.Tuple as Tuple+import qualified LLVM.Extra.Storable as Storable import qualified LLVM.Extra.Memory as Memory-import qualified LLVM.Util.Loop as Loop import qualified LLVM.Core as LLVM -import LLVM.Core (CodeGenFunction, Value, )+import LLVM.Core (CodeGenFunction, Value) -import Foreign.Ptr (Ptr, )-import Data.Word (Word32, )+import Foreign.Ptr (Ptr)+import Data.Word (Word)  import qualified Type.Data.Num.Decimal as TypeNum  import qualified Control.Monad.Trans.State as MS-import Control.Applicative (Applicative, liftA2, pure, (<*>), )-import Data.Traversable (Traversable, traverse, sequenceA, foldMapDefault, )-import Data.Foldable (Foldable, foldMap, )+import Control.Applicative (Applicative, liftA2, pure, (<*>))+import Data.Traversable (Traversable, traverse, sequenceA, foldMapDefault)+import Data.Foldable (Foldable, foldMap)   class (Applicative nodes, Traversable nodes) => C nodes where    margin :: Margin (nodes a) -data Margin nodes =-      Margin { marginNumber, marginOffset :: Int }+data Margin nodes = Margin { marginNumber, marginOffset :: Int }    deriving (Show, Eq)  @@ -107,12 +106,12 @@    writeStop = Serial.writeStopTraversable  -instance (Class.Undefined a) => Class.Undefined (Nodes02 a) where-   undefTuple = Class.undefTuplePointed+instance (Tuple.Undefined a) => Tuple.Undefined (Nodes02 a) where+   undef = Tuple.undefPointed -instance (Loop.Phi a) => Loop.Phi (Nodes02 a) where-   phis = Class.phisTraversable-   addPhis = Class.addPhisFoldable+instance (Tuple.Phi a) => Tuple.Phi (Nodes02 a) where+   phi = Tuple.phiTraversable+   addPhi = Tuple.addPhiFoldable   type Struct02 a = LLVM.Struct (a, (a, ()))@@ -194,12 +193,12 @@    writeStop = Serial.writeStopTraversable  -instance (Class.Undefined a) => Class.Undefined (Nodes13 a) where-   undefTuple = Class.undefTuplePointed+instance (Tuple.Undefined a) => Tuple.Undefined (Nodes13 a) where+   undef = Tuple.undefPointed -instance (Loop.Phi a) => Loop.Phi (Nodes13 a) where-   phis = Class.phisTraversable-   addPhis = Class.addPhisFoldable+instance (Tuple.Phi a) => Tuple.Phi (Nodes13 a) where+   phi = Tuple.phiTraversable+   addPhi = Tuple.addPhiFoldable   type Struct13 a = LLVM.Struct (a, (a, (a, (a, ()))))@@ -236,34 +235,34 @@   loadNodes ::-   (C nodes) =>+   (C nodes, Storable.C am) =>    (Value (Ptr am) -> CodeGenFunction r a) ->-   Value Word32 ->+   Value Int ->    Value (Ptr am) -> CodeGenFunction r (nodes a) loadNodes loadNode step =    MS.evalStateT $ sequenceA $ pure $ loadNext loadNode step  loadNext ::+   (Storable.C am) =>    (Value (Ptr am) -> CodeGenFunction r a) ->-   Value Word32 ->+   Value Int ->    MS.StateT (Value (Ptr am)) (CodeGenFunction r) a loadNext loadNode step =-   MS.StateT $ \ptr ->-      liftA2 (,) (loadNode ptr) (LLVM.getElementPtr ptr (step, ()))+   MS.StateT $ \ptr -> liftA2 (,) (loadNode ptr) (Storable.advancePtr step ptr)    indexNodes ::    (C nodes) =>-   (Value Word32 -> CodeGenFunction r v) ->-   Value Word32 ->-   Value Word32 -> CodeGenFunction r (nodes v)+   (Value Word -> CodeGenFunction r v) ->+   Value Word ->+   Value Word -> CodeGenFunction r (nodes v) indexNodes indexNode step =    MS.evalStateT $ sequenceA $ pure $ indexNext indexNode step  indexNext ::-   (Value Word32 -> CodeGenFunction r v) ->-   Value Word32 ->-   MS.StateT (Value Word32) (CodeGenFunction r) v+   (Value Word -> CodeGenFunction r v) ->+   Value Word ->+   MS.StateT (Value Word) (CodeGenFunction r) v indexNext indexNode step =    MS.StateT $ \i -> liftA2 (,) (indexNode i) (A.add i step)
src/Synthesizer/LLVM/MIDI.hs view
@@ -16,42 +16,40 @@ import qualified Synthesizer.LLVM.MIDI.BendModulation as BM import qualified Synthesizer.LLVM.Frame.SerialVector as Serial -import Synthesizer.LLVM.CausalParameterized.Process (($>), )+import Synthesizer.LLVM.CausalParameterized.Process (($>)) import qualified Synthesizer.LLVM.CausalParameterized.Functional as Func import qualified Synthesizer.LLVM.CausalParameterized.Process as CausalP import qualified Synthesizer.LLVM.Parameterized.SignalPacked as SigPS import qualified Synthesizer.LLVM.Parameterized.Signal as SigP-import qualified Synthesizer.LLVM.Parameter as Param import qualified Synthesizer.LLVM.Wave as Wave +import qualified LLVM.DSL.Parameter as Param+ import qualified LLVM.Extra.ScalarOrVector as SoV import qualified LLVM.Extra.Vector as Vector-import qualified LLVM.Extra.Memory as Memory+import qualified LLVM.Extra.Marshal as Marshal import qualified LLVM.Extra.Arithmetic as A-import qualified LLVM.Extra.Class as Class+import qualified LLVM.Extra.Tuple as Tuple import qualified LLVM.Core as LLVM-import LLVM.Core (IsSized, SizeOf, )+import LLVM.Core (SizeOf)  import qualified Type.Data.Num.Decimal as TypeNum-import Type.Data.Num.Decimal.Number ((:*:), )--import Foreign.Storable (Storable, )+import Type.Data.Num.Decimal.Number ((:*:))  import qualified Algebra.RealField      as RealField import qualified Algebra.Additive       as Additive -import Control.Arrow (second, (<<<), (<<^), )-import Control.Monad ({- liftM, -} liftM2, )+import Control.Arrow (second, (<<<), (<<^))+import Control.Monad ({- liftM, -} liftM2) --- import NumericPrelude.Base import NumericPrelude.Numeric-import Prelude (($), )+import Prelude (($))   {- {-# INLINE piecewiseConstantInit #-} piecewiseConstantInit ::-   (Storable y, Class.MakeValueTuple y, Class.ValueTuple y ~ yl,+   (Storable y, Tuple.Value y, Tuple.ValueOf y ~ yl,     Memory.C yl ym, LLVM.IsSized ym ys) =>    y -> EventListTT.T LazyTime y -> SigP.T p yl piecewiseConstantInit initial evs =@@ -62,7 +60,7 @@  {-# INLINE controllerLinear #-} controllerLinear ::-   (Field.C y, Storable y, Class.MakeValueTuple y, Class.ValueTuple y ~ yl,+   (Field.C y, Storable y, Tuple.Value y, Tuple.ValueOf y ~ yl,     Memory.C yl ym, LLVM.IsSized ym ys) =>    Channel -> Controller ->    (y,y) -> y ->@@ -75,7 +73,7 @@  {-# INLINE controllerExponential #-} controllerExponential ::-   (Trans.C y, Storable y, Class.MakeValueTuple y, Class.ValueTuple y ~ yl,+   (Trans.C y, Storable y, Tuple.Value y, Tuple.ValueOf y ~ yl,     Memory.C yl ym, LLVM.IsSized ym ys) =>    Channel -> Controller ->    (y,y) -> y ->@@ -93,7 +91,7 @@ -} {-# INLINE pitchBend #-} pitchBend ::-   (Trans.C y, Storable y, Class.MakeValueTuple y, Class.ValueTuple y ~ yl,+   (Trans.C y, Storable y, Tuple.Value y, Tuple.ValueOf y ~ yl,     Memory.C yl ym, LLVM.IsSized ym ys) =>    Channel ->    y -> y ->@@ -106,7 +104,7 @@  {-# INLINE channelPressure #-} channelPressure ::-   (Trans.C y, Storable y, Class.MakeValueTuple y, Class.ValueTuple y ~ yl,+   (Trans.C y, Storable y, Tuple.Value y, Tuple.ValueOf y ~ yl,     Memory.C yl ym, LLVM.IsSized ym ys) =>    Channel ->    y -> y ->@@ -122,7 +120,7 @@    (Ring.C a, LLVM.IsConst a,     RealField.C y, Trans.C y,     LLVM.IsConst y, SoV.Fraction y, a ~ SoV.Scalar y, SoV.Replicate y,-    Storable y, Class.MakeValueTuple y (LLVM.Value y), LLVM.IsSized y ys) =>+    Storable y, Tuple.Value y (LLVM.Value y), LLVM.IsSized y ys) =>    Channel ->    Int -> y -> y -> y ->    Filter (SigP.T p (LLVM.Value y))@@ -142,8 +140,8 @@   frequencyFromBendModulation ::-   (Additive.C y, Storable y, Class.MakeValueTuple y, Class.ValueTuple y ~ yl,-    A.PseudoRing yl, A.Fraction yl, A.IntegerConstant yl, Memory.C yl) =>+   (Marshal.C y, Additive.C y, Tuple.ValueOf y ~ yl,+    A.PseudoRing yl, A.Fraction yl, A.IntegerConstant yl) =>    Param.T p y ->    CausalP.T p (BM.T yl) yl frequencyFromBendModulation speed =@@ -153,14 +151,12 @@   frequencyFromBendModulationPacked ::-   (RealField.C a, LLVM.IsConst a, LLVM.IsFloating a,-    Memory.FirstClass a, Memory.Stored a ~ am, IsSized a, IsSized am,-    LLVM.IsPrimitive am,-    Storable a, Class.MakeValueTuple a, Class.ValueTuple a ~ (LLVM.Value a),-    Vector.Real a, SoV.IntegerConstant a,+   (Marshal.C a, Tuple.ValueOf a ~ LLVM.Value a,+    Marshal.Vector n a, Tuple.VectorValueOf n a ~ LLVM.Value (LLVM.Vector n a),+    LLVM.IsPrimitive a, LLVM.IsConst a, LLVM.IsFloating a,+    RealField.C a, Vector.Real a, SoV.IntegerConstant a,     TypeNum.Positive n,-    TypeNum.Positive (n :*: SizeOf a),-    TypeNum.Positive (n :*: SizeOf am)) =>+    TypeNum.Positive (n :*: SizeOf a)) =>    Param.T p a ->    CausalP.T p (BM.T (LLVM.Value a)) (Serial.Value n a) frequencyFromBendModulationPacked speed =
src/Synthesizer/LLVM/MIDI/BendModulation.hs view
@@ -15,18 +15,19 @@ import qualified Synthesizer.LLVM.CausalParameterized.Functional as F  import qualified LLVM.Extra.Vector as Vector-import qualified LLVM.Extra.Class as Class+import qualified LLVM.Extra.Tuple as Tuple+import qualified LLVM.Extra.Storable as Storable+import qualified LLVM.Extra.Marshal as Marshal import qualified LLVM.Extra.Memory as Memory import qualified LLVM.Extra.Control as C-import qualified LLVM.Util.Loop as Loop import qualified LLVM.Core as LLVM -import Control.Applicative (liftA2, )+import Control.Applicative (liftA2) import qualified Type.Data.Num.Decimal as TypeNum  -instance (Class.Zero a) => Class.Zero (BM.T a) where-   zeroTuple = Class.zeroTuplePointed+instance (Tuple.Zero a) => Tuple.Zero (BM.T a) where+   zero = Tuple.zeroPointed  {- instance (LLVM.ValueTuple a) => LLVM.ValueTuple (BM.T a) where@@ -36,8 +37,8 @@    tupleDesc = Class.tupleDescFoldable -} -instance (Class.Undefined a) => Class.Undefined (BM.T a) where-   undefTuple = Class.undefTuplePointed+instance (Tuple.Undefined a) => Tuple.Undefined (BM.T a) where+   undef = Tuple.undefPointed  instance (C.Select a) => C.Select (BM.T a) where    select = C.selectTraversable@@ -47,9 +48,9 @@       LLVM.CmpRet (BM.T a) (BM.T b) where -} -instance Class.MakeValueTuple h => Class.MakeValueTuple (BM.T h) where-   type ValueTuple (BM.T h) = BM.T (Class.ValueTuple h)-   valueTupleOf = Class.valueTupleOfFunctor+instance Tuple.Value h => Tuple.Value (BM.T h) where+   type ValueOf (BM.T h) = BM.T (Tuple.ValueOf h)+   valueOf = Tuple.valueOfFunctor   type Struct a = LLVM.Struct (a, (a, ()))@@ -67,10 +68,17 @@    decompose = Memory.decomposeRecord memory    compose = Memory.composeRecord memory +instance (Marshal.C l) => Marshal.C (BM.T l) where+   pack (BM.Cons bend depth) = Marshal.pack (bend, depth)+   unpack = uncurry BM.Cons . Marshal.unpack -instance (Loop.Phi a) => Loop.Phi (BM.T a) where-   phis = Class.phisTraversable-   addPhis = Class.addPhisFoldable+instance (Storable.C l) => Storable.C (BM.T l) where+   load = Storable.loadApplicative+   store = Storable.storeFoldable++instance (Tuple.Phi a) => Tuple.Phi (BM.T a) where+   phi = Tuple.phiTraversable+   addPhi = Tuple.addPhiFoldable   instance (Vector.Simple v) => Vector.Simple (BM.T v) where
src/Synthesizer/LLVM/Parameter.hs view
@@ -1,319 +1,12 @@-{-# LANGUAGE NoImplicitPrelude #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE Rank2Types #-}-{-# LANGUAGE FlexibleContexts #-} module Synthesizer.LLVM.Parameter (-   T,-   ($#),-   get,-   value,-   with,--   Tuple(..),-   withTuple,-   withTuple1,-   withTuple2,+   Param.T,+   Param.get,+   (Param.$#), -   -- * for implementation of new processes-   word32,+   Param.Tuple(..),+   Param.withTuple,+   Param.withTuple1,+   Param.withTuple2,    ) where -import qualified LLVM.Extra.Class as Class-import qualified LLVM.Extra.Memory as Memory-import Foreign.Storable.Tuple ()-import Foreign.Storable (Storable, )--import qualified Algebra.Transcendental as Trans-import qualified Algebra.Algebraic as Algebraic-import qualified Algebra.Field as Field-import qualified Algebra.Ring as Ring-import qualified Algebra.Additive as Additive--import qualified Control.Category as Cat-import qualified Control.Arrow as Arr-import qualified Control.Applicative as App-import Control.Applicative (pure, liftA2, (<$>), )--import qualified Data.Tuple.HT as TupleHT-import Data.Tuple.HT (mapFst, )-import Data.Word (Word32, )--import NumericPrelude.Numeric-import Prelude (Functor, Monad, fmap, error, (.), ($), const, id, )-import qualified Prelude as P---{- |-This data type is for parameters of parameterized signal generators and causal processes.-It is better than using plain functions of type @p -> a@-since it allows for numeric instances-and we can make explicit,-whether a parameter is constant.--We recommend to use parameters for atomic types.-Although a parameter of type @T p (a,b)@ is possible,-it means that the whole parameter is variable-if only one of the pair elements is variable.-This way you may miss optimizations.--}-data T p a =-   Constant a |-   Variable (p -> a)---get :: T p a -> (p -> a)-get (Constant a) = const a-get (Variable f) = f---{- |-The call @value param v@ requires-that @v@ represents the same value as @valueTupleOf (get param p)@ for some @p@.-However @v@ might be the result of a load operation-and @param@ might be a constant.-In this case it is more efficient to use @valueTupleOf (get param undefined)@-since the constant is translated to an LLVM constant-that allows for certain optimizations.--This is the main function for taking advantage of a constant parameter-in low-level implementations.-For simplicity we do not omit constant parameters in the parameter struct-since this would mean to construct types at runtime and might become ugly.-Instead we just check using 'value' at the according places in LLVM code-whether a parameter is constant-and ignore the parameter from the struct in this case.-In many cases there will be no speed benefit-because the parameter will be loaded to a register anyway.-It can only lead to speed-up if subsequent optimizations-can precompute constant expressions.-Another example is 'drop' where a loop with constant loop count can be generated.-For small loop counts and simple loop bodies the loop might get unrolled.--}-value ::-   (Class.MakeValueTuple tuple, Class.ValueTuple tuple ~ value) =>-   T p tuple -> value -> value-value (Constant a) _ = Class.valueTupleOf a-value (Variable _) v = v---{- |-This function provides specialised variants of 'get' and 'value',-that use the unit type for constants-and thus save space in parameter structures.--}-with ::-   (Storable tuple, Class.MakeValueTuple tuple,-    Class.ValueTuple tuple ~ value, Memory.C value) =>-   T p tuple ->-   (forall parameters.-    (Storable parameters,-     Class.MakeValueTuple parameters,-     Memory.C (Class.ValueTuple parameters)) =>-    (p -> parameters) ->-    (Class.ValueTuple parameters -> value) ->-    a) ->-   a-with (Constant a) f = f (const ()) (\() -> Class.valueTupleOf a)-with (Variable v) f = f v id---word32 :: T p Int -> T p Word32-word32 = fmap fromIntegral---infixl 0 $#--($#) :: (T p a -> b) -> (a -> b)-($#) f a = f (pure a)---{- |-@.@ can be used for fetching a parameter from a super-parameter.--}-instance Cat.Category T where-   id = Variable id-   Constant f . _ = Constant f-   Variable f . Constant a = Constant (f a)-   Variable f . Variable g = Variable (f . g)--{- |-@arr@ is useful for lifting parameter selectors to our parameter type-without relying on the constructor.--}-instance Arr.Arrow T where-   arr = Variable-   first f = Variable (mapFst (get f))----{- |-Useful for splitting @T p (a,b)@ into @T p a@ and @T p b@-using @fmap fst@ and @fmap snd@.--}-instance Functor (T p) where-   fmap f (Constant a) = Constant (f a)-   fmap f (Variable g) = Variable (f . g)--{- |-Useful for combining @T p a@ and @T p b@ to @T p (a,b)@-using @liftA2 (,)@.-However, we do not recommend to do so-because the result parameter can only be constant-if both operands are constant.--}-instance App.Applicative (T p) where-   pure a = Constant a-   Constant f <*> Constant a = Constant (f a)-   f <*> a = Variable (\p -> get f p (get a p))--instance Monad (T p) where-   return = pure-   Constant x >>= f = f x-   Variable x >>= f =-      Variable (\p -> get (f (x p)) p)---instance Additive.C a => Additive.C (T p a) where-   zero = pure zero-   negate = fmap negate-   (+) = liftA2 (+)-   (-) = liftA2 (-)--instance Ring.C a => Ring.C (T p a) where-   one = pure one-   (*) = liftA2 (*)-   x^n = fmap (^n) x-   fromInteger = pure . fromInteger--instance Field.C a => Field.C (T p a) where-   (/) = liftA2 (/)-   recip = fmap recip-   fromRational' = pure . fromRational'--instance Algebraic.C a => Algebraic.C (T p a) where-   x ^/ r = fmap (^/ r) x-   sqrt = fmap sqrt-   root n = fmap (Algebraic.root n)--instance Trans.C a => Trans.C (T p a) where-   pi      = pure   pi-   exp     = fmap   exp-   log     = fmap   log-   logBase = liftA2 logBase-   (**)    = liftA2 (**)-   sin     = fmap   sin-   tan     = fmap   tan-   cos     = fmap   cos-   asin    = fmap   asin-   atan    = fmap   atan-   acos    = fmap   acos-   sinh    = fmap   sinh-   tanh    = fmap   tanh-   cosh    = fmap   cosh-   asinh   = fmap   asinh-   atanh   = fmap   atanh-   acosh   = fmap   acosh---{--Instances for Haskell98 numeric type classes-that are useful when working together with other libraries on fixed types.--}-instance P.Eq a => P.Eq (T p a) where-   (==) = error "Synthesizer.LLVM.Parameter: Num instance requires Eq but we cannot define that"--instance P.Show a => P.Show (T p a) where-   show _ = "Synthesizer.LLVM.Parameter"--instance P.Num a => P.Num (T p a) where-   (+) = liftA2 (P.+)-   (-) = liftA2 (P.-)-   (*) = liftA2 (P.*)-   negate = fmap P.negate-   abs = fmap P.abs-   signum = fmap P.signum-   fromInteger = pure . P.fromInteger--instance P.Fractional a => P.Fractional (T p a) where-   (/) = liftA2 (P./)-   fromRational = pure . P.fromRational--instance P.Floating a => P.Floating (T p a) where-   pi = pure P.pi-   exp = fmap P.exp-   sqrt = fmap P.sqrt-   log = fmap P.log-   (**) = liftA2 (P.**)-   logBase = liftA2 P.logBase-   sin = fmap P.sin-   tan = fmap P.tan-   cos = fmap P.cos-   asin = fmap P.asin-   atan = fmap P.atan-   acos = fmap P.acos-   sinh = fmap P.sinh-   tanh = fmap P.tanh-   cosh = fmap P.cosh-   asinh = fmap P.asinh-   atanh = fmap P.atanh-   acosh = fmap P.acosh----class Tuple tuple where-   type Composed tuple :: *-   type Source tuple :: *-   decompose :: T (Source tuple) (Composed tuple) -> tuple--instance Tuple (T p a) where-   type Composed (T p a) = a-   type Source (T p a) = p-   decompose = id--instance (Tuple a, Tuple b, Source a ~ Source b) => Tuple (a,b) where-   type Composed (a,b) = (Composed a, Composed b)-   type Source (a,b) = Source a-   decompose p = (decompose $ P.fst <$> p, decompose $ P.snd <$> p)--instance-   (Tuple a, Tuple b, Tuple c, Source a ~ Source b, Source b ~ Source c) =>-      Tuple (a,b,c) where-   type Composed (a,b,c) = (Composed a, Composed b, Composed c)-   type Source (a,b,c) = Source a-   decompose p =-      (decompose $ TupleHT.fst3 <$> p,-       decompose $ TupleHT.snd3 <$> p,-       decompose $ TupleHT.thd3 <$> p)--{- |-Provide all elements of a nested tuple as separate parameters.--If you do not use one of the tuple elements,-you will get a type error like-@Couldn't match type `Param.Composed t0' with `Int'@.-The problem is that the type checker cannot infer-that an element is a @Parameter.T@ if it remains unused.--}-withTuple ::-   (Tuple tuple, Source tuple ~ p, Composed tuple ~ p) =>-   (tuple -> f p) -> f p-withTuple f = idFromFunctor $ f . decompose--idFromFunctor :: (T p p -> f p) -> f p-idFromFunctor f = f Cat.id--withTuple1 ::-   (Tuple tuple, Source tuple ~ p, Composed tuple ~ p) =>-   (tuple -> f p a) -> f p a-withTuple1 f = idFromFunctor1 $ f . decompose--idFromFunctor1 :: (T p p -> f p a) -> f p a-idFromFunctor1 f = f Cat.id--withTuple2 ::-   (Tuple tuple, Source tuple ~ p, Composed tuple ~ p) =>-   (tuple -> f p a b) -> f p a b-withTuple2 f = idFromFunctor2 $ f . decompose--idFromFunctor2 :: (T p p -> f p a b) -> f p a b-idFromFunctor2 f = f Cat.id+import qualified LLVM.DSL.Parameter as Param
src/Synthesizer/LLVM/Parameterized/Signal.hs view
@@ -76,16 +76,13 @@ import qualified Synthesizer.LLVM.Plug.Output as POut import qualified Synthesizer.LLVM.Interpolation as Interpolation import qualified Synthesizer.LLVM.ConstantPiece as Const-import qualified Synthesizer.LLVM.Parameter as Param-import Synthesizer.Causal.Class (($*), ($<), )+import Synthesizer.Causal.Class (($*), ($<))  import qualified Synthesizer.LLVM.Frame.Stereo as Stereo import qualified Synthesizer.LLVM.Frame as Frame import qualified Synthesizer.LLVM.Random as Rnd import qualified Synthesizer.LLVM.Wave as Wave-import qualified Synthesizer.LLVM.Execution as Exec import qualified Synthesizer.LLVM.ForeignPtr as ForeignPtr-import qualified Synthesizer.LLVM.Alloc as Alloc  import qualified Synthesizer.LLVM.Storable.ChunkIterator as ChunkIt import qualified Synthesizer.LLVM.Storable.Vector as SVU@@ -98,30 +95,33 @@ import qualified Numeric.NonNegative.Chunky as Chunky import qualified Numeric.NonNegative.Wrapper as NonNeg +import qualified LLVM.DSL.Execution as Exec+import qualified LLVM.DSL.Parameter as Param+ import qualified LLVM.Extra.Arithmetic as A import qualified LLVM.Extra.ScalarOrVector as SoV import qualified LLVM.Extra.MaybeContinuation as MaybeCont import qualified LLVM.Extra.Maybe as Maybe+import qualified LLVM.Extra.Storable as Storable+import qualified LLVM.Extra.Marshal as Marshal import qualified LLVM.Extra.Memory as Memory-import LLVM.Extra.Class (MakeValueTuple, ValueTuple, Undefined, undefTuple, )-import LLVM.Extra.Arithmetic (advanceArrayElementPtr, )-import LLVM.Extra.Control (whileLoop, )+import qualified LLVM.Extra.Tuple as Tuple+import LLVM.Extra.Control (whileLoop)  import qualified LLVM.ExecutionEngine as EE-import qualified LLVM.Util.Loop as Loop import qualified LLVM.Core as LLVM import LLVM.Core           (CodeGenFunction, ret, Value, value, valueOf,            IsSized, IsConst, IsArithmetic, IsFloating,-           CodeGenModule, Function, )+           CodeGenModule, Function)  import qualified Type.Data.Num.Decimal as TypeNum -import Control.Monad.HT ((<=<), )-import Control.Monad (when, )-import Control.Arrow ((^<<), )-import Control.Applicative (Applicative, liftA2, liftA3, pure, (<$>), )-import Control.Functor.HT (void, )+import Control.Monad.HT ((<=<))+import Control.Monad (when)+import Control.Arrow ((^<<))+import Control.Applicative (Applicative, liftA2, liftA3, pure, (<$>))+import Control.Functor.HT (void)  import qualified Algebra.Transcendental as Trans import qualified Algebra.RealField as RealField@@ -130,24 +130,20 @@ import qualified Algebra.Additive as Additive  import Data.Functor.Compose (Compose(Compose))-import Data.Tuple.HT (mapSnd, )-import Data.Word (Word8, Word32, )-import Data.Int (Int32, )-import Foreign.Storable.Tuple ()-import Foreign.Storable (Storable, )-import Foreign.ForeignPtr (touchForeignPtr, withForeignPtr, )-import Foreign.Ptr (Ptr, nullPtr, )-import Control.Exception (bracket, )+import Data.Tuple.HT (mapSnd)+import Data.Word (Word8, Word32, Word)+import Data.Int (Int32)++import Foreign.ForeignPtr (touchForeignPtr)+import Foreign.Ptr (Ptr, nullPtr)+import Control.Exception (bracket) import qualified System.Unsafe as Unsafe -import qualified Synthesizer.LLVM.Debug.Storable as DebugSt-import qualified Synthesizer.LLVM.Debug.Counter as Counter+import qualified LLVM.DSL.Debug.Marshal as DebugSt+import qualified LLVM.DSL.Debug.Counter as Counter  import NumericPrelude.Numeric-import NumericPrelude.Base hiding (and, tail, iterate, map, zip, zipWith, cycle, drop, )---- for debugChunkyMain-import qualified Control.Monad.Trans.Reader as R+import NumericPrelude.Base hiding (and, tail, iterate, map, zip, zipWith, cycle, drop)   reparameterize :: Param.T q p -> T p a -> T q a@@ -176,7 +172,7 @@  drop :: Param.T p Int -> T p a -> T p a drop n (Cons next alloca start stop createIOContext deleteIOContext) =-   Param.with (Param.word32 n) $ \getN valueN -> Cons+   Param.withValue (Param.wordInt n) $ \getN valueN -> Cons    next    alloca    (\(parameter, i0) -> do@@ -203,7 +199,7 @@   cycle ::-   (Loop.Phi a, Undefined a) =>+   (Tuple.Phi a, Tuple.Undefined a) =>    T p a -> T p a cycle (Cons next alloca start stop createIOContext deleteIOContext) =    Cons@@ -236,8 +232,7 @@ interpolateConstant ::    (Memory.C a,     IsFloating b, SoV.IntegerConstant b, LLVM.CmpRet b, LLVM.CmpResult b ~ Bool,-    Storable b, MakeValueTuple b, ValueTuple b ~ (Value b),-    Memory.FirstClass b, IsSized (Memory.Stored b)) =>+    Marshal.C b, Tuple.ValueOf b ~ Value b) =>    Param.T p b -> T p a -> T p a interpolateConstant k sig =    CausalP.toSignal@@ -245,24 +240,21 @@   amplify ::-   (A.PseudoRing al, Storable a,-    MakeValueTuple a, ValueTuple a ~ al, Memory.C al) =>+   (A.PseudoRing al, Marshal.C a, Tuple.ValueOf a ~ al) =>    Param.T p a -> T p al -> T p al amplify =    map Frame.amplifyMono  amplifyStereo ::-   (A.PseudoRing al, Storable a,-    MakeValueTuple a, ValueTuple a ~ al, Memory.C al) =>+   (A.PseudoRing al, Marshal.C a, Tuple.ValueOf a ~ al) =>    Param.T p a -> T p (Stereo.T al) -> T p (Stereo.T al) amplifyStereo =    map Frame.amplifyStereo   mapAccum ::-   (Storable pnh, MakeValueTuple pnh, ValueTuple pnh ~ pnl, Memory.C pnl,-    Storable psh, MakeValueTuple psh, ValueTuple psh ~ psl, Memory.C psl,-    Memory.C s) =>+   (Marshal.C pnh, Tuple.ValueOf pnh ~ pnl,+    Marshal.C psh, Tuple.ValueOf psh ~ psl, Memory.C s) =>    (forall r. pnl -> a -> s -> CodeGenFunction r (b,s)) ->    (forall r. psl -> CodeGenFunction r s) ->    Param.T p pnh ->@@ -272,18 +264,17 @@    CausalP.mapAccum next start n s $* xs  adjacentNodes02 ::-   (Memory.C a, Undefined a) =>+   (Memory.C a, Tuple.Undefined a) =>    T p a -> T p (Interpolation.Nodes02 a) adjacentNodes02 =    tail    .    Sig.mapAccum       (\new old -> return (Interpolation.Nodes02 old new, new))-      (return undefTuple)+      (return Tuple.undef)  adjacentNodes13 ::-   (MakeValueTuple ah, Storable ah, ValueTuple ah ~ a,-    Memory.C a, Undefined a) =>+   (Marshal.C ah, Tuple.ValueOf ah ~ a, Tuple.Undefined a) =>    Param.T p ah -> T p a -> T p (Interpolation.Nodes13 a) adjacentNodes13 yp0 =    tail .@@ -291,7 +282,7 @@    mapAccum       (\() new (x0, x1, x2) ->          return (Interpolation.Nodes13 x0 x1 x2 new, (x1, x2, new)))-      (\y0 -> return (undefTuple, undefTuple, Param.value yp0 y0))+      (\y0 -> return (Tuple.undef, Tuple.undef, Param.valueTuple yp0 y0))       (pure ()) yp0  @@ -300,15 +291,13 @@   exponentialCore ::-   (Storable a, MakeValueTuple a, ValueTuple a ~ al,-    Memory.C al, A.PseudoRing al) =>+   (Marshal.C a, Tuple.ValueOf a ~ al, A.PseudoRing al) =>    Param.T p a -> Param.T p a -> T p al exponentialCore =    iterate A.mul  exponential2 ::-   (Trans.C a, Storable a, MakeValueTuple a, ValueTuple a ~ (Value a),-    Memory.FirstClass a, IsSized (Memory.Stored a),+   (Trans.C a, Marshal.C a, Tuple.ValueOf a ~ Value a,     IsArithmetic a, IsConst a) =>    Param.T p a -> Param.T p a -> T p (Value a) exponential2 halfLife =@@ -316,8 +305,7 @@   exponentialBoundedCore ::-   (Storable a, MakeValueTuple a, ValueTuple a ~ al,-    Memory.C al, A.PseudoRing al, A.Real al) =>+   (Marshal.C a, Tuple.ValueOf a ~ al, A.PseudoRing al, A.Real al) =>    Param.T p a -> Param.T p a -> Param.T p a ->    T p al exponentialBoundedCore bound decay =@@ -332,9 +320,7 @@ The initial value and the bound value must be positive. -} exponentialBounded2 ::-   (Trans.C a, Storable a, MakeValueTuple a, ValueTuple a ~ (Value a),-    Memory.FirstClass a, IsSized (Memory.Stored a),-    SoV.Real a, IsConst a) =>+   (Trans.C a, Marshal.C a, Tuple.ValueOf a ~ Value a, SoV.Real a, IsConst a) =>    Param.T p a -> Param.T p a -> Param.T p a ->    T p (Value a) exponentialBounded2 bound halfLife =@@ -342,17 +328,14 @@   osciCore ::-   (Storable t, MakeValueTuple t, ValueTuple t ~ tl,-    Memory.C tl, A.Fraction tl) =>+   (Marshal.C t, Tuple.ValueOf t ~ tl, A.Fraction tl) =>    Param.T p t -> Param.T p t -> T p tl osciCore phase freq =    iterate A.incPhase freq phase  osci ::-   (Storable t, MakeValueTuple t, ValueTuple t ~ tl,-    Storable c, MakeValueTuple c, ValueTuple c ~ cl,-    Memory.C cl,-    Memory.C tl, A.Fraction tl, A.IntegerConstant tl) =>+   (Marshal.C t, Tuple.ValueOf t ~ tl, A.Fraction tl, A.IntegerConstant tl,+    Marshal.C c, Tuple.ValueOf c ~ cl) =>    (forall r. cl -> tl -> CodeGenFunction r y) ->    Param.T p c ->    Param.T p t -> Param.T p t -> T p y@@ -360,16 +343,15 @@    map wave waveParam $ osciCore phase freq  osciSimple ::-   (Storable t, MakeValueTuple t, ValueTuple t ~ tl,-    Memory.C tl, A.Fraction tl, A.IntegerConstant tl) =>+   (Marshal.C t, Tuple.ValueOf t ~ tl, A.Fraction tl, A.IntegerConstant tl) =>    (forall r. tl -> CodeGenFunction r y) ->    Param.T p t -> Param.T p t -> T p y-osciSimple wave =-   osci (const wave) (return ())+osciSimple wave phase freq =+   Sig.map wave $ osciCore phase freq  osciSaw ::-   (Storable a, MakeValueTuple a, ValueTuple a ~ al,-    Memory.C al, A.PseudoRing al, A.Fraction al, A.IntegerConstant al) =>+   (Marshal.C a, Tuple.ValueOf a ~ al,+    A.PseudoRing al, A.Fraction al, A.IntegerConstant al) =>    Param.T p a -> Param.T p a -> T p al osciSaw =    osciSimple Wave.saw@@ -377,14 +359,12 @@   rampCore ::-   (Storable a, MakeValueTuple a, ValueTuple a ~ al,-    Memory.C al, A.Additive al, A.IntegerConstant al) =>+   (Marshal.C a, Tuple.ValueOf a ~ al, A.Additive al, A.IntegerConstant al) =>    Param.T p a -> Param.T p a -> T p al rampCore = iterate A.add  parabolaCore ::-   (Storable a, MakeValueTuple a, ValueTuple a ~ al,-    Memory.C al, A.Additive al, A.IntegerConstant al) =>+   (Marshal.C a, Tuple.ValueOf a ~ al, A.Additive al, A.IntegerConstant al) =>    Param.T p a -> Param.T p a -> Param.T p a -> T p al parabolaCore d2 d1 start =    CausalP.apply (CausalP.integrate start) $@@ -394,8 +374,8 @@  rampInf, rampSlope,  parabolaFadeInInf, parabolaFadeOutInf ::-   (Field.C a, Storable a, MakeValueTuple a, ValueTuple a ~ al,-    Memory.C al, A.Additive al, A.IntegerConstant al) =>+   (Field.C a,+    Marshal.C a, Tuple.ValueOf a ~ al, A.Additive al, A.IntegerConstant al) =>    Param.T p a -> T p al rampSlope slope  =  rampCore slope Additive.zero rampInf dur  =  rampSlope (recip dur)@@ -429,8 +409,8 @@ ramp,  parabolaFadeIn, parabolaFadeOut,  parabolaFadeInMap, parabolaFadeOutMap ::-   (RealField.C a, Storable a, MakeValueTuple a, ValueTuple a ~ al,-    Memory.C al, A.PseudoRing al, A.IntegerConstant al) =>+   (RealField.C a, Marshal.C a, Tuple.ValueOf a ~ al,+    A.PseudoRing al, A.IntegerConstant al) =>    Param.T p a -> T p al  ramp dur =@@ -474,10 +454,8 @@ towards the normal distribution according to the central limit theorem. -} noise ::-   (Algebraic.C a, IsFloating a, IsConst a,-    LLVM.ShapeOf a ~ LLVM.ScalarShape,-    Memory.C (Value a),-    MakeValueTuple a, ValueTuple a ~ (Value a), Storable a) =>+   (Algebraic.C a, IsFloating a, IsConst a, Marshal.C a,+    Tuple.ValueOf a ~ Value a, LLVM.IsPrimitive a) =>    Param.T p Word32 ->    Param.T p a ->    T p (Value a)@@ -517,7 +495,7 @@ -- * conversion from and to storable vectors  fromStorableVector ::-   (Storable a, MakeValueTuple a, ValueTuple a ~ value, Memory.C value) =>+   (Storable.C a, Tuple.ValueOf a ~ value) =>    Param.T p (SV.Vector a) ->    T p value fromStorableVector selectVec =@@ -525,8 +503,8 @@       (\() () (p0,l0) -> do          cont <- MaybeCont.lift $ A.cmp LLVM.CmpGT l0 A.zero          MaybeCont.withBool cont $ do-            y1 <- Memory.load p0-            p1 <- advanceArrayElementPtr p0+            y1 <- Storable.load p0+            p1 <- Storable.incrementPtr p0             l1 <- A.dec l0             return (y1,(p1,l1)))       (return ())@@ -534,7 +512,7 @@       (\() _ -> return ())       (\p ->          let (fp,ptr,l) = SVU.unsafeToPointers $ Param.get selectVec p-         in  return (fp, (ptr, fromIntegral l :: Word32)))+         in  return (fp, (ptr, fromIntegral l :: Word)))       -- keep the foreign ptr alive       touchForeignPtr @@ -544,16 +522,14 @@ and advances to the next chunk in the sequence. -} fromStorableVectorLazy ::-   (Storable a, MakeValueTuple a, ValueTuple a ~ value, Memory.C value) =>-   Param.T p (SVL.Vector a) ->-   T p value+   (Storable.C a, Tuple.ValueOf a ~ value) =>+   Param.T p (SVL.Vector a) -> T p value fromStorableVectorLazy = SigPriv.flattenChunks . storableVectorChunks  storableVectorChunks ::-   (Storable a, MakeValueTuple a, ValueTuple a ~ value, Memory.C value,-    Memory.Struct value ~ struct) =>+   (Storable.C a, Tuple.ValueOf a ~ value) =>    Param.T p (SVL.Vector a) ->-   T p (Value (Ptr struct), Value Word32)+   T p (Value (Ptr a), Value Word) storableVectorChunks sig =    Cons       (SigPriv.storableVectorNextChunk@@ -569,7 +545,7 @@   piecewiseConstant ::-   (Storable a, MakeValueTuple a, ValueTuple a ~ value, Memory.C value) =>+   (Marshal.C a, Tuple.ValueOf a ~ value) =>    Param.T p (EventList.T NonNeg.Int a) ->    T p value piecewiseConstant =@@ -608,15 +584,15 @@   foreign import ccall safe "dynamic" derefFillPtr ::-   Exec.Importer (Ptr param -> Word32 -> Ptr a -> IO Word32)+   Exec.Importer (LLVM.Ptr param -> Word -> Ptr a -> IO Word)   moduleFill ::-   (Memory.C value, Memory.Struct value ~ struct,+   (Storable.C a, Tuple.ValueOf a ~ value,     Memory.C parameters, Memory.Struct parameters ~ paramStruct,-    Loop.Phi state, Undefined state) =>+    Tuple.Phi state, Tuple.Undefined state) =>    (forall r z.-    (Loop.Phi z) =>+    (Tuple.Phi z) =>     context -> local -> state -> MaybeCont.T r z (value, state)) ->    (forall r. CodeGenFunction r local) ->    (forall r.@@ -624,29 +600,33 @@    (forall r.     context -> state -> CodeGenFunction r ()) ->    CodeGenModule-      (Function (Ptr paramStruct -> Word32 -> Ptr struct -> IO Word32))+      (Function (LLVM.Ptr paramStruct -> Word -> Ptr a -> IO Word)) moduleFill next alloca start stop =    Exec.createLLVMFunction "fillsignalblock" $    \paramPtr size bPtr -> do       param <- Memory.load paramPtr       (c,s) <- start param       local <- alloca-      (pos,se) <- MaybeCont.arrayLoop size bPtr s $ \ ptri s0 -> do+      (pos,se) <- Storable.arrayLoopMaybeCont size bPtr s $ \ ptri s0 -> do          (y,s1) <- next c local s0-         MaybeCont.lift $ Memory.store y ptri+         MaybeCont.lift $ Storable.store y ptri          return s1       Maybe.for se $ stop c       ret pos ++declareMallocBytes :: LLVM.TFunction (Ptr Word8 -> IO (Ptr a))+declareMallocBytes = LLVM.newNamedFunction LLVM.ExternalLinkage "malloc"+ debugMain ::-   forall parameters struct paramStruct.-   (Storable parameters,-    LLVM.IsType struct,+   forall parameters a paramStruct.+   (Marshal.C parameters,+    Storable.C a,     LLVM.IsType paramStruct, IsSized paramStruct) =>    CodeGenModule-      (Function (Ptr paramStruct -> Word32 -> Ptr struct -> IO Word32)) ->+      (Function (LLVM.Ptr paramStruct -> Word -> Ptr a -> IO Word)) ->    parameters ->-   IO (Function (Word32 -> Ptr (Ptr Word8) -> IO Word32))+   IO (Function (Word -> Ptr (Ptr Word8) -> IO Word)) debugMain sigModule params = do    paramArray <-       DebugSt.withConstArray params (\arr -> do@@ -658,35 +638,36 @@     mainFunc <- LLVM.defineModule m (do       LLVM.setTarget LLVM.hostTriple-      mallocBytes <- LLVM.newNamedFunction LLVM.ExternalLinkage "malloc" ::-         LLVM.TFunction (Ptr Word8 -> IO (Ptr struct))+      mallocBytes <- declareMallocBytes       fill <- sigModule       Exec.createLLVMFunction "main" $ \ _argc _argv -> do          paramPtr <- paramArray-         let chunkSize = LLVM.valueOf 100000+         let chunkSize = 100000              basePtr = LLVM.valueOf nullPtr          buffer <-             LLVM.call mallocBytes =<<             LLVM.bitcast =<<-            LLVM.getElementPtr basePtr (chunkSize, ())+            Storable.advancePtr+               (LLVM.valueOf chunkSize) (basePtr :: LLVM.Value (Ptr a))          _done <--            LLVM.call fill paramPtr chunkSize (asTypeOf buffer basePtr)-         ret (A.zero :: LLVM.Value Word32))+            LLVM.call fill paramPtr+               (LLVM.valueOf $ fromIntegral chunkSize)+               (asTypeOf buffer basePtr)+         ret (A.zero :: LLVM.Value Word)) -   Counter.with Exec.counter $ R.ReaderT $ \cnt -> do-      LLVM.writeBitcodeToFile ("main" ++ Counter.format 3 cnt ++ ".bc") m+   Exec.dumper "main" >>= \writeBitcodeToFile -> writeBitcodeToFile "" m     return mainFunc   run ::-   (Storable a, MakeValueTuple a, ValueTuple a ~ value, Memory.C value) =>+   (Storable.C a, Tuple.ValueOf a ~ value) =>    T p value ->    IO (Int -> p -> SV.Vector a) run (Cons next alloca start stop createIOContext deleteIOContext) =    do -- this compiles once and is much faster than simpleFunction       let modul = moduleFill next alloca start stop-      fill <- Exec.compileModule $ createFunction derefFillPtr modul+      fill <- Exec.compile "signal" $ createFunction derefFillPtr modul        return $ \len p ->          Unsafe.performIO $@@ -695,36 +676,39 @@             when False $ void $ debugMain modul params              SVB.createAndTrim len $ \ ptr ->-               Alloc.with params $ \paramPtr ->-               fmap fromIntegral $-                  fill (Memory.castTuplePtr paramPtr)-                     (fromIntegral len) (Memory.castTuplePtr ptr)+               Marshal.with params $ \paramPtr ->+               fmap fromIntegral $ fill paramPtr (fromIntegral len) ptr  {- | This is not really a function, see 'renderChunky'. -} render ::-   (Storable a, MakeValueTuple a, ValueTuple a ~ value, Memory.C value) =>+   (Storable.C a, Tuple.ValueOf a ~ value) =>    T p value -> Int -> p -> SV.Vector a render gen = Unsafe.performIO $ run gen   foreign import ccall safe "dynamic" derefStartPtr ::-   Exec.Importer (Ptr b -> IO (Ptr a))+   Exec.Importer (LLVM.Ptr b -> IO (LLVM.Ptr a))  foreign import ccall safe "dynamic" derefStopPtr ::-   Exec.Importer (Ptr a -> IO ())+   Exec.Importer (LLVM.Ptr a -> IO ())  foreign import ccall safe "dynamic" derefChunkPtr ::-   Exec.Importer (Ptr contextStateStruct -> Word32 -> Ptr struct -> IO Word32)+   Exec.Importer (LLVM.Ptr contextStateStruct -> Word -> Ptr a -> IO Word) +foreign import ccall safe "dynamic" derefChunkPluggedPtr ::+   Exec.Importer+      (LLVM.Ptr contextStateStruct -> Word -> LLVM.Ptr struct -> IO Word) + moduleStart ::    (Memory.C parameters, Memory.Struct parameters ~ paramStruct,     Memory.C context, Memory.C state,     Memory.Struct (context, Maybe.T state) ~ contextStateStruct) =>    (forall r. parameters -> CodeGenFunction r (context, state)) ->-   CodeGenModule (Function (Ptr paramStruct -> IO (Ptr contextStateStruct)))+   CodeGenModule (Function+      (LLVM.Ptr paramStruct -> IO (LLVM.Ptr contextStateStruct))) moduleStart start =    Exec.createLLVMFunction "startsignal" $    \paramPtr -> do@@ -737,7 +721,7 @@    (Memory.C context, Memory.C state,     Memory.Struct (context, Maybe.T state) ~ contextStateStruct) =>    (forall r. context -> state -> CodeGenFunction r ()) ->-   CodeGenModule (Function (Ptr contextStateStruct -> IO ()))+   CodeGenModule (Function (LLVM.Ptr contextStateStruct -> IO ())) moduleStop stop =    Exec.createLLVMFunction "stopsignal" $    \contextStatePtr -> do@@ -747,15 +731,16 @@       ret ()  moduleNext ::-   (Memory.C value, Memory.Struct value ~ struct,+   (Storable.C a, Tuple.ValueOf a ~ value,     Memory.C context, Memory.C state,-    Memory.Struct (context, Maybe.T state) ~ contextStateStruct) =>+    Memory.Struct (context, Maybe.T state) ~ contextStateStruct,+    Tuple.Phi state, Tuple.Undefined state) =>    (forall r z.-    (Loop.Phi z) =>+    (Tuple.Phi z) =>     context -> local -> state -> MaybeCont.T r z (value, state)) ->    (forall r. CodeGenFunction r local) ->    CodeGenModule-      (Function (Ptr contextStateStruct -> Word32 -> Ptr struct -> IO Word32))+      (Function (LLVM.Ptr contextStateStruct -> Word -> Ptr a -> IO Word)) moduleNext next alloca =    Exec.createLLVMFunction "fillsignal" $    \contextStatePtr loopLen ptr -> do@@ -763,22 +748,21 @@       local <- alloca       (pos,msExit) <-          Maybe.run msInit (return (A.zero, Maybe.nothing)) $ \sInit ->-            MaybeCont.arrayLoop loopLen ptr sInit $ \ ptri s0 -> do+            Storable.arrayLoopMaybeCont loopLen ptr sInit $ \ptri s0 -> do          (y,s1) <- next context local s0-         MaybeCont.lift $ Memory.store y ptri+         MaybeCont.lift $ Storable.store y ptri          return s1       sptr <- LLVM.getElementPtr0 contextStatePtr (TypeNum.d1, ())       Memory.store msExit sptr       ret pos - moduleNextPlugged ::    (Memory.C context, Memory.C state,     Memory.Struct (context, Maybe.T state) ~ contextStateStruct,-    Undefined stateOut, Loop.Phi stateOut,+    Tuple.Undefined stateOut, Tuple.Phi stateOut,     Memory.C paramValueOut, Memory.Struct paramValueOut ~ paramStructOut) =>    (forall r z.-    (Loop.Phi z) =>+    (Tuple.Phi z) =>     context -> local -> state -> MaybeCont.T r z (value, state)) ->    (forall r. CodeGenFunction r local) ->    (forall r.@@ -789,7 +773,8 @@     LLVM.CodeGenFunction r stateOut) ->    CodeGenModule       (Function-         (Ptr contextStateStruct -> Word32 -> Ptr paramStructOut -> IO Word32))+         (LLVM.Ptr contextStateStruct -> Word ->+          LLVM.Ptr paramStructOut -> IO Word)) moduleNextPlugged next alloca nextOut startOut =    Exec.createLLVMFunction "fillsignal" $    \contextStatePtr loopLen outPtr -> do@@ -809,18 +794,18 @@       ret pos  debugChunkyMain ::-   forall parameters struct paramStruct contextStateStruct.-   (Storable parameters,-    LLVM.IsType struct,+   forall parameters a paramStruct contextStateStruct.+   (Marshal.C parameters,+    Storable.C a,     LLVM.IsType contextStateStruct,     LLVM.IsType paramStruct, IsSized paramStruct) =>    CodeGenModule-      (Function (Ptr paramStruct -> IO (Ptr contextStateStruct)),-       Function (Ptr contextStateStruct -> IO ()),-       Function (Ptr contextStateStruct ->-                 Word32 -> Ptr struct -> IO Word32)) ->+      (Function (LLVM.Ptr paramStruct -> IO (LLVM.Ptr contextStateStruct)),+       Function (LLVM.Ptr contextStateStruct -> IO ()),+       Function (LLVM.Ptr contextStateStruct ->+                 Word -> Ptr a -> IO Word)) ->    parameters ->-   IO (Function (Word32 -> Ptr (Ptr Word8) -> IO Word32))+   IO (Function (Word -> Ptr (Ptr Word8) -> IO Word)) debugChunkyMain sigModule params = do {- This does not work, since we cannot add (Mul n D32 s) constraint@@ -841,24 +826,25 @@     mainFunc <- LLVM.defineModule m (do       LLVM.setTarget LLVM.hostTriple-      mallocBytes <- LLVM.newNamedFunction LLVM.ExternalLinkage "malloc" ::-         LLVM.TFunction (Ptr Word8 -> IO (Ptr struct))+      mallocBytes <- declareMallocBytes       (start, stop, fill) <- sigModule       Exec.createLLVMFunction "main" $ \ _argc _argv -> do          contextState <- LLVM.call start =<< paramArray-         let chunkSize = LLVM.valueOf 100000+         let chunkSize = 100000              basePtr = LLVM.valueOf nullPtr          buffer <-             LLVM.call mallocBytes =<<             LLVM.bitcast =<<-            LLVM.getElementPtr basePtr (chunkSize, ())+            Storable.advancePtr+               (LLVM.valueOf chunkSize) (basePtr :: LLVM.Value (Ptr a))          _done <--            LLVM.call fill contextState chunkSize (asTypeOf buffer basePtr)+            LLVM.call fill contextState+               (LLVM.valueOf $ fromIntegral chunkSize)+               (asTypeOf buffer basePtr)          _ <- LLVM.call stop contextState-         ret (A.zero :: LLVM.Value Word32))+         ret (A.zero :: LLVM.Value Word)) -   Counter.with Exec.counter $ R.ReaderT $ \cnt -> do-      LLVM.writeBitcodeToFile ("main" ++ Counter.format 3 cnt ++ ".bc") m+   Exec.dumper "main-chunky" >>= \writeBitcodeToFile -> writeBitcodeToFile "" m     return mainFunc @@ -870,7 +856,7 @@ this means that the signal is shortened. -} runChunkyPattern, _runChunkyPattern ::-   (Storable a, MakeValueTuple a, ValueTuple a ~ value, Memory.C value) =>+   (Storable.C a, Tuple.ValueOf a ~ value) =>    T p value ->    IO (SVP.LazySize -> p -> SVL.Vector a) _runChunkyPattern =@@ -885,7 +871,7 @@    let nextF = moduleNext next alloca     (startFunc, stopFunc, fill) <--      Exec.compileModule $+      Exec.compile "signal-pattern" $       liftA3 (,,)          (createFunction derefStartPtr startF)          (createFinalizer derefStopPtr stopF)@@ -899,7 +885,8 @@          putStr "nextParam: "          DebugSt.format nextParam >>= putStrLn -}-         when False $ Counter.with DebugSt.dumpCounter $ do+         when False $+            Counter.next DebugSt.dumpCounter >>=             DebugSt.dump "param" param           when False $ void $@@ -914,11 +901,10 @@                    [] -> return []                    SVL.ChunkSize size : rest -> do                       v <--                         withForeignPtr statePtr $ \sptr ->+                         ForeignPtr.with statePtr $ \sptr ->                          SVB.createAndTrim size $                          fmap fromIntegral .-                         fill sptr (fromIntegral size) .-                         Memory.castTuplePtr+                         fill sptr (fromIntegral size)                       touchForeignPtr ioContextPtr                       (if SV.length v > 0                          then fmap (v:)@@ -937,11 +923,11 @@       (POut.Cons nextOut startOut createOut deleteOut) = do     (startFunc, stopFunc, fill) <--      Exec.compileModule $+      Exec.compile "signal-plugged" $       liftA3 (,,)          (createFunction derefStartPtr $ moduleStart start)          (createFinalizer derefStopPtr $ moduleStop stop)-         (createFunction derefChunkPtr $+         (createFunction derefChunkPluggedPtr $           moduleNextPlugged next alloca nextOut startOut)     return $@@ -959,11 +945,9 @@                       (contextOut,paramOut) <- createOut maximumSize                       actualSize <-                          fmap fromIntegral $-                         Alloc.with paramOut $ \outptr ->-                         withForeignPtr statePtr $ \sptr ->-                         fill sptr-                            (fromIntegral maximumSize)-                            (Memory.castTuplePtr outptr)+                         Marshal.with paramOut $ \outptr ->+                         ForeignPtr.with statePtr $ \sptr ->+                         fill sptr (fromIntegral maximumSize) outptr                       when (fromIntegral actualSize > maximumSize) $                          error $ "Parametrized.Signal: " ++                                  "output size " ++ show actualSize ++@@ -979,7 +963,7 @@          go (Chunky.toChunks lazysize)  runChunky, _runChunky ::-   (Storable a, MakeValueTuple a, ValueTuple a ~ value, Memory.C value) =>+   (Storable.C a, Tuple.ValueOf a ~ value) =>    T p value ->    IO (SVL.ChunkSize -> p -> SVL.Vector a) runChunky sig =@@ -1009,7 +993,7 @@ and I assume that you use this package exclusively for performance reasons. -} renderChunky ::-   (Storable a, MakeValueTuple a, ValueTuple a ~ value, Memory.C value) =>+   (Storable.C a, Tuple.ValueOf a ~ value) =>    SVL.ChunkSize -> T p value ->    p -> SVL.Vector a renderChunky size gen =
src/Synthesizer/LLVM/Parameterized/SignalPacked.hs view
@@ -35,44 +35,44 @@    noiseCore, noiseCoreAlt,    ) where -import Synthesizer.LLVM.Parameterized.Signal (T, )+import Synthesizer.LLVM.Parameterized.Signal (T) import qualified Synthesizer.LLVM.Simple.SignalPacked as SigS import qualified Synthesizer.LLVM.Parameterized.Signal as Sig-import qualified Synthesizer.LLVM.Parameter as Param import qualified Synthesizer.LLVM.Frame.SerialVector as Serial- import qualified Synthesizer.LLVM.Random as Rnd++import qualified LLVM.DSL.Parameter as Param++import qualified LLVM.Extra.Marshal as Marshal import qualified LLVM.Extra.Memory as Memory import qualified LLVM.Extra.ScalarOrVector as SoV import qualified LLVM.Extra.Vector as Vector import qualified LLVM.Extra.Arithmetic as A-import LLVM.Extra.Class (MakeValueTuple, ValueTuple, )+import qualified LLVM.Extra.Tuple as Tuple  import qualified Type.Data.Num.Decimal as TypeNum-import Type.Data.Num.Decimal ((:*:), )+import Type.Data.Num.Decimal ((:*:))  import qualified LLVM.Core as LLVM import LLVM.Core-          (CodeGenFunction, Value,-           IsSized, IsConst, IsArithmetic, IsFloating,-           IsPrimitive, Vector, SizeOf, )+         (CodeGenFunction, Value,+          IsConst, IsArithmetic, IsFloating, IsPrimitive, Vector, SizeOf) -import Control.Monad.HT ((<=<), )+import Control.Monad.HT ((<=<)) -- we can also use <$> for parameters-import Control.Arrow ((^<<), )-import Control.Applicative (liftA2, )+import Control.Arrow ((^<<))+import Control.Applicative (liftA2)  import qualified Algebra.Transcendental as Trans import qualified Algebra.Algebraic as Algebraic import qualified Algebra.RealField as RealField import qualified Algebra.Ring as Ring -import Data.Word (Word32, )-import Data.Int (Int32, )-import Foreign.Storable (Storable, )+import Data.Word (Word32)+import Data.Int (Int32)  import NumericPrelude.Numeric as NP-import NumericPrelude.Base hiding (and, iterate, map, zip, zipWith, )+import NumericPrelude.Base hiding (and, iterate, map, zip, zipWith)   @@ -84,89 +84,79 @@  withSizeRing ::    (Ring.C b, TypeNum.Positive n) =>-   (b -> T p (Serial.Value n a)) ->+   (TypeNum.Singleton n -> b -> T p (Serial.Value n a)) ->    T p (Serial.Value n a) withSizeRing f =-   withSize $ f . fromInteger . TypeNum.integerFromSingleton+   withSize $ \n -> f n $ fromInteger $ TypeNum.integerFromSingleton n   constant ::-   (Storable a, MakeValueTuple a, ValueTuple a ~ (Value a),-    IsConst a,-    Memory.FirstClass a, Memory.Stored a ~ am,-    IsPrimitive a,-    IsPrimitive am, IsSized am, SizeOf am ~ amsize,-    TypeNum.Positive (n :*: amsize),+   (Marshal.Vector n a, Tuple.ValueOf a ~ Value a, IsConst a,+    Tuple.VectorValueOf n a ~ Value (Vector n a),+    IsPrimitive a, SizeOf a ~ asize,+    TypeNum.Positive (n :*: asize),     TypeNum.Positive n) =>    Param.T p a -> T p (Serial.Value n a) constant x =-   Sig.constant (Serial.replicate ^<< x)+   withSize $ \n -> Sig.constant (Serial.replicate_ n ^<< x)   exponential2 ::-   (Trans.C a, Storable a, MakeValueTuple a, ValueTuple a ~ (Value a),+   (Trans.C a, Marshal.Vector n a, Tuple.ValueOf a ~ Value a,+    Tuple.VectorValueOf n a ~ Value (Vector n a),     IsArithmetic a, IsConst a,-    Memory.FirstClass a, Memory.Stored a ~ am,-    IsPrimitive a,  IsSized a, SizeOf a ~ as,-    IsPrimitive am, IsSized am, SizeOf am ~ amsize,-    TypeNum.Positive (n :*: as),-    TypeNum.Positive (n :*: amsize),+    IsPrimitive a, SizeOf a ~ asize,+    TypeNum.Positive (n :*: asize),     TypeNum.Positive n) =>    Param.T p a -> Param.T p a -> T p (Serial.Value n a)-exponential2 halfLife start = withSizeRing $ \n ->+exponential2 halfLife start = withSizeRing $ \sn n ->    Sig.exponentialCore-      (Serial.replicate ^<< 0.5 ** (n / halfLife))+      (Serial.replicate_ sn ^<< 0.5 ** (n / halfLife))       (liftA2          (\h -> Serial.iteratePlain (0.5 ** recip h *))          halfLife start)  exponentialBounded2 ::-   (Trans.C a, Storable a, MakeValueTuple a, ValueTuple a ~ (Value a),+   (Trans.C a, Marshal.Vector n a, Tuple.ValueOf a ~ Value a,+    Tuple.VectorValueOf n a ~ Value (Vector n a),     Vector.Real a, IsConst a,-    Memory.FirstClass a, Memory.Stored a ~ am,-    IsPrimitive a,  IsSized a, SizeOf a ~ as,-    IsPrimitive am, IsSized am, SizeOf am ~ amsize,+    IsPrimitive a, SizeOf a ~ as,     TypeNum.Positive (n :*: as),-    TypeNum.Positive (n :*: amsize),     TypeNum.Positive n) =>    Param.T p a -> Param.T p a -> Param.T p a ->    T p (Serial.Value n a)-exponentialBounded2 bound halfLife start = withSizeRing $ \n ->+exponentialBounded2 bound halfLife start = withSizeRing $ \sn n ->    Sig.exponentialBoundedCore-      (fmap (Serial.replicate) bound)-      (Serial.replicate ^<< 0.5 ** (n / halfLife))+      (fmap (Serial.replicate_ sn) bound)+      (Serial.replicate_ sn ^<< 0.5 ** (n / halfLife))       (liftA2          (\h -> Serial.iteratePlain (0.5 ** recip h *))          halfLife start)   osciCore ::-   (Storable t, MakeValueTuple t, ValueTuple t ~ (Value t),-    Memory.FirstClass t, Memory.Stored t ~ tm,-    IsPrimitive t,  IsSized t, SizeOf t ~ tsize,-    IsPrimitive tm, IsSized tm, SizeOf tm ~ tmsize,+   (Marshal.Vector n t, Tuple.ValueOf t ~ Value t,+    Tuple.VectorValueOf n t ~ Value (Vector n t),+    IsPrimitive t, SizeOf t ~ tsize,     TypeNum.Positive (n :*: tsize),-    TypeNum.Positive (n :*: tmsize),     Vector.Real t, IsFloating t, RealField.C t, IsConst t,     TypeNum.Positive n) =>    Param.T p t -> Param.T p t -> T p (Serial.Value n t)-osciCore phase freq = withSizeRing $ \n ->+osciCore phase freq = withSizeRing $ \sn n ->    Sig.osciCore       (liftA2          (\f -> Serial.iteratePlain (fraction . (f +)))          freq phase)       (fmap-         (\f -> Serial.replicate (fraction (n * f)))+         (\f -> Serial.replicate_ sn (fraction (n * f)))          freq)  osci ::-   (Storable t, MakeValueTuple t, ValueTuple t ~ (Value t),-    Storable c, MakeValueTuple c, ValueTuple c ~ cl,-    Memory.FirstClass t, Memory.Stored t ~ tm,-    IsPrimitive t,  IsSized t, SizeOf t ~ tsize,-    IsPrimitive tm, IsSized tm, SizeOf tm ~ tmsize,+   (Marshal.Vector n t, Tuple.ValueOf t ~ Value t,+    Marshal.C c, Tuple.ValueOf c ~ cl,+    Tuple.VectorValueOf n t ~ Value (Vector n t),+    IsPrimitive t, SizeOf t ~ tsize,     TypeNum.Positive (n :*: tsize),-    TypeNum.Positive (n :*: tmsize),     Memory.C cl,     Vector.Real t, IsFloating t, RealField.C t, IsConst t,     TypeNum.Positive n) =>@@ -178,12 +168,10 @@    osciCore phase freq  osciSimple ::-   (Storable t, MakeValueTuple t, ValueTuple t ~ (Value t),-    Memory.FirstClass t, Memory.Stored t ~ tm,-    IsPrimitive t,  IsSized t, SizeOf t ~ tsize,-    IsPrimitive tm, IsSized tm, SizeOf tm ~ tmsize,+   (Marshal.Vector n t, Tuple.ValueOf t ~ Value t,+    Tuple.VectorValueOf n t ~ Value (Vector n t),+    IsPrimitive t, SizeOf t ~ tsize,     TypeNum.Positive (n :*: tsize),-    TypeNum.Positive (n :*: tmsize),     Vector.Real t, IsFloating t, RealField.C t, IsConst t,     TypeNum.Positive n) =>    (forall r. Serial.Value n t -> CodeGenFunction r y) ->@@ -194,27 +182,25 @@  rampInf, rampSlope,  parabolaFadeInInf, parabolaFadeOutInf ::-   (RealField.C a, Storable a, MakeValueTuple a, ValueTuple a ~ (Value a),-    Memory.FirstClass a, Memory.Stored a ~ am,-    IsPrimitive a,  IsSized a, SizeOf a ~ as,-    IsPrimitive am, IsSized am, SizeOf am ~ amsize,+   (RealField.C a, Marshal.Vector n a, Tuple.ValueOf a ~ Value a,+    Tuple.VectorValueOf n a ~ Value (Vector n a),+    IsPrimitive a, SizeOf a ~ as,     TypeNum.Positive (n :*: as),-    TypeNum.Positive (n :*: amsize),     IsArithmetic a, SoV.IntegerConstant a,     TypeNum.Positive n) =>    Param.T p a -> T p (Serial.Value n a)-rampSlope slope = withSizeRing $ \n ->+rampSlope slope = withSizeRing $ \sn n ->    Sig.rampCore-      (fmap (\s -> Serial.replicate (n * s)) slope)+      (fmap (\s -> Serial.replicate_ sn (n * s)) slope)       (fmap (\s -> Serial.iteratePlain (s +) 0) slope) rampInf dur = rampSlope (recip dur) -parabolaFadeInInf dur = withSizeRing $ \n ->+parabolaFadeInInf dur = withSizeRing $ \sn n ->    Sig.parabolaCore       (fmap          (\dr ->             let d = n / dr-            in  Serial.replicate (-2*d*d)) dur)+            in  Serial.replicate_ sn (-2*d*d)) dur)       (fmap          (\dr ->             let d = n / dr@@ -225,12 +211,12 @@             Serial.mapPlain (\t -> t*(2-t)) $ Serial.iteratePlain (recip dr +) 0)          dur) -parabolaFadeOutInf dur = withSizeRing $ \n ->+parabolaFadeOutInf dur = withSizeRing $ \sn n ->    Sig.parabolaCore       (fmap          (\dr ->             let d = n / dr-            in  Serial.replicate (-2*d*d)) dur)+            in  Serial.replicate_ sn (-2*d*d)) dur)       (fmap          (\dr ->             let d = n / dr@@ -249,23 +235,22 @@    (Algebraic.C a, IsFloating a, SoV.IntegerConstant a,     TypeNum.Positive n,     TypeNum.Positive (n :*: TypeNum.D32),-    Memory.FirstClass a, Memory.Stored a ~ am,-    IsPrimitive a,  IsSized a, SizeOf a ~ as,-    IsPrimitive am, IsSized am, SizeOf am ~ amsize,+    IsPrimitive a, SizeOf a ~ as,     TypeNum.Positive (n :*: as),-    TypeNum.Positive (n :*: amsize),-    MakeValueTuple a, ValueTuple a ~ (Value a), Storable a) =>+    Marshal.Vector n a, Tuple.VectorValueOf n a ~ Value (Vector n a),+    Tuple.ValueOf a ~ Value a) =>    Param.T p Word32 ->    Param.T p a ->    T p (Serial.Value n a) noise seed rate =+   withSize $ \n ->    let m2 = div Rnd.modulus 2    in  Sig.map           (\r y ->              A.mul r               =<< flip A.sub (A.fromInteger' $ m2+1)               =<< int31tofp y)-          (Serial.replicate ^<< sqrt (3 * rate) / return (fromInteger m2)) $+          (Serial.replicate_ n ^<< sqrt (3 * rate) / return (fromInteger m2)) $        noiseCore seed  {-
src/Synthesizer/LLVM/Parameterized/SignalPrivate.hs view
@@ -1,40 +1,36 @@ {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE Rank2Types #-} module Synthesizer.LLVM.Parameterized.SignalPrivate where  import qualified Synthesizer.LLVM.Simple.SignalPrivate as Sig-import qualified Synthesizer.LLVM.Parameter as Param+import qualified LLVM.Extra.Tuple as Tuple import qualified LLVM.Extra.MaybeContinuation as MaybeCont import qualified LLVM.Extra.Either as Either import qualified LLVM.Extra.Maybe as Maybe+import qualified LLVM.Extra.Marshal as Marshal import qualified LLVM.Extra.Memory as Memory import qualified LLVM.Extra.Arithmetic as A +import qualified LLVM.DSL.Parameter as Param import qualified LLVM.Core as LLVM-import LLVM.Extra.Class (MakeValueTuple, ValueTuple, Undefined, )-import LLVM.Core (CodeGenFunction, )-import LLVM.Util.Loop (Phi, )--import Control.Arrow ((&&&), )-import Control.Monad (liftM, liftM2, )-import Control.Applicative (Applicative, pure, (<*>), )+import LLVM.Core (CodeGenFunction) -import Foreign.Storable.Tuple ()-import Foreign.Storable (Storable, )-import Foreign.Ptr (Ptr, )+import Control.Arrow ((&&&))+import Control.Monad (liftM, liftM2)+import Control.Applicative (Applicative, pure, (<*>)) -import Data.Monoid (Monoid, mempty, mappend, )-import Data.Semigroup (Semigroup, (<>), )+import Data.Tuple.Strict (zipPair)+import Data.Monoid (Monoid, mempty, mappend)+import Data.Semigroup (Semigroup, (<>))  import qualified Number.Ratio as Ratio import qualified Algebra.Field as Field import qualified Algebra.Ring as Ring import qualified Algebra.Additive as Additive -import NumericPrelude.Base hiding (and, iterate, map, zip, zipWith, )+import NumericPrelude.Base hiding (and, iterate, map, zip, zipWith)  import qualified Prelude as P @@ -68,21 +64,17 @@ -} data T p a =    forall context state local ioContext parameters.-      (Storable parameters,-       MakeValueTuple parameters,-       Memory.C (ValueTuple parameters),-       Memory.C context,-       Memory.C state) =>+      (Marshal.C parameters, Memory.C context, Memory.C state) =>    Cons       (forall r c.-       (Phi c) =>+       (Tuple.Phi c) =>        context -> local -> state -> MaybeCont.T r c (a, state))           -- compute next value       (forall r.        CodeGenFunction r local)           -- allocate temporary variables before a loop       (forall r.-       ValueTuple parameters ->+       Tuple.ValueOf parameters ->        CodeGenFunction r (context, state))           -- allocate initial state       (forall r.@@ -138,7 +130,7 @@    (paramB -> m (contextB, stateB)) ->    (paramA, paramB) -> m ((contextA, contextB), (stateA, stateB)) combineStart startA startB (paramA, paramB) =-   liftM2 Sig.zipPair (startA paramA) (startB paramB)+   liftM2 zipPair (startA paramA) (startB paramB)  combineStop ::    Monad m =>@@ -154,7 +146,7 @@    (p -> m (ioContextB, contextB)) ->    p -> m ((ioContextA, ioContextB), (contextA, contextB)) combineCreate createIOContextA createIOContextB p =-   liftM2 Sig.zipPair (createIOContextA p) (createIOContextB p)+   liftM2 zipPair (createIOContextA p) (createIOContextB p)  combineDelete ::    (Monad m) =>@@ -165,20 +157,17 @@   simple ::-   (Storable parameters,-    MakeValueTuple parameters,-    Memory.C (ValueTuple parameters),-    Memory.C context,-    Memory.C state) =>+   (Marshal.C parameters, Tuple.ValueOf parameters ~ paramTuple,+    Memory.C context, Memory.C state) =>    (forall r c.-    (Phi c) =>+    (Tuple.Phi c) =>     context -> state -> MaybeCont.T r c (al, state)) ->    (forall r.-    ValueTuple parameters ->+    paramTuple ->     CodeGenFunction r (context, state)) ->    Param.T p parameters -> T p al simple f start param =-   Param.with param $ \getParam valueParam ->+   Param.withValue param $ \getParam valueParam ->    Cons       (\context () state -> f context state)       (return ())@@ -188,10 +177,7 @@       (const $ return ())  -constant ::-   (Storable a, MakeValueTuple a, ValueTuple a ~ al,-    Memory.C al) =>-   Param.T p a -> T p al+constant :: (Marshal.C a, Tuple.ValueOf a ~ al) => Param.T p a -> T p al constant =    simple       (\pl () -> return (pl, ()))@@ -199,7 +185,7 @@   map ::-   (Storable ph, MakeValueTuple ph, ValueTuple ph ~ pl, Memory.C pl) =>+   (Marshal.C ph, Tuple.ValueOf ph ~ pl) =>    (forall r. pl -> a -> CodeGenFunction r b) ->    Param.T p ph ->    T p a -> T p b@@ -214,7 +200,7 @@   zipWith ::-   (Storable ph, MakeValueTuple ph, ValueTuple ph ~ pl, Memory.C pl) =>+   (Marshal.C ph, Tuple.ValueOf ph ~ pl) =>    (forall r. pl -> a -> b -> CodeGenFunction r c) ->    Param.T p ph ->    T p a -> T p b -> T p c@@ -301,7 +287,7 @@ {- | For restrictions see 'Sig.append'. -}-append :: (Phi a, Undefined a) => T p a -> T p a -> T p a+append :: (Tuple.Phi a, Tuple.Undefined a) => T p a -> T p a -> T p a append       (Cons nextA allocaA startA stopA createIOContextA deleteIOContextA)       (Cons nextB allocaB startB stopB createIOContextB deleteIOContextB) =@@ -331,26 +317,25 @@       (combineCreate createIOContextA createIOContextB)       (combineDelete deleteIOContextA deleteIOContextB) -instance (Phi a, Undefined a) => Semigroup (T p a) where+instance (Tuple.Phi a, Tuple.Undefined a) => Semigroup (T p a) where    (<>) = append -instance (Phi a, Undefined a) => Monoid (T p a) where+instance (Tuple.Phi a, Tuple.Undefined a) => Monoid (T p a) where    mempty = Sig.empty    mappend = append   iterate ::-   (Storable ph, MakeValueTuple ph, ValueTuple ph ~ pl, Memory.C pl,-    Storable a,  MakeValueTuple a, ValueTuple a ~ al, Memory.C al) =>-   (forall r. pl -> al -> CodeGenFunction r al) ->-   Param.T p ph ->-   Param.T p a -> T p al+   (Marshal.C c, Tuple.ValueOf c ~ cl,+    Marshal.C a, Tuple.ValueOf a ~ al) =>+   (forall r. cl -> al -> CodeGenFunction r al) ->+   Param.T p c -> Param.T p a -> T p al iterate f param initial = simple    (\pl al0 -> MaybeCont.lift $ fmap (\al1 -> (al0,al1)) (f pl al0))    return    (param &&& initial) -malloc :: (LLVM.IsSized a) => T p (LLVM.Value (Ptr a))+malloc :: (LLVM.IsSized a) => T p (LLVM.Value (LLVM.Ptr a)) malloc =    Cons       (\ptr () () -> return (ptr, ()))
src/Synthesizer/LLVM/Plug/Input.hs view
@@ -21,23 +21,18 @@  import qualified Synthesizer.LLVM.ConstantPiece as Const +import qualified LLVM.Extra.Storable as Storable+import qualified LLVM.Extra.Marshal as Marshal import qualified LLVM.Extra.Memory as Memory import qualified LLVM.Extra.Arithmetic as A-import qualified LLVM.Extra.Class as Class+import qualified LLVM.Extra.Tuple as Tuple import qualified LLVM.Extra.Control as C  import qualified LLVM.Core as LLVM-import LLVM.Extra.Class (MakeValueTuple, ValueTuple, )  import qualified Type.Data.Num.Decimal as TypeNum import Type.Base.Proxy (Proxy) -import Control.Applicative (liftA2, )--import qualified Data.Map as Map--import Data.Tuple.HT (mapFst, mapPair, swap, )- import qualified Synthesizer.MIDI.PiecewiseConstant.ControllerSet as PCS import qualified Synthesizer.Generic.Signal as SigG import qualified Data.EventList.Relative.BodyTime as EventListBT@@ -52,11 +47,16 @@ import qualified Foreign.Marshal.Array as Array import qualified Foreign.Marshal.Alloc as Alloc import qualified Foreign.ForeignPtr as FPtr-import Foreign.Storable (Storable, pokeElemOff, )+import Foreign.Storable (pokeElemOff) -import Data.Word (Word32, )+import Control.Applicative (liftA2) +import qualified Data.Map as Map +import Data.Tuple.Strict (mapFst, mapPair, swap, zipPair)+import Data.Word (Word)++ {- This datatype does not provide an early exit option, e.g. by Maybe.T, since we warrant that the driver function will always@@ -66,17 +66,14 @@ -} data T a b =    forall state ioContext parameters.-      (Storable parameters,-       MakeValueTuple parameters,-       Memory.C (ValueTuple parameters),-       Memory.C state) =>+      (Marshal.C parameters, Memory.C state) =>    Cons       (forall r.-       ValueTuple parameters ->+       Tuple.ValueOf parameters ->        state -> LLVM.CodeGenFunction r (b, state))           -- compute next value       (forall r.-       ValueTuple parameters ->+       Tuple.ValueOf parameters ->        LLVM.CodeGenFunction r state)           -- initial state       (a -> IO (ioContext, parameters))@@ -108,10 +105,8 @@    type Element SigG.LazySize = ()    deflt = lazySize -instance-   (Storable a, MakeValueTuple a, Memory.C (Class.ValueTuple a)) =>-      Default (SV.Vector a) where-   type Element (SV.Vector a) = Class.ValueTuple a+instance (Storable.C a) => Default (SV.Vector a) where+   type Element (SV.Vector a) = Tuple.ValueOf a    deflt = storableVector  @@ -122,9 +117,9 @@ see the versioning history for an according hack. -} instance-   (Storable a, MakeValueTuple a, Memory.C (ValueTuple a)) =>+   (Storable.C a, Memory.C (Tuple.ValueOf a)) =>       Default (EventListBT.T NonNegW.Int a) where-   type Element (EventListBT.T NonNegW.Int a) = ValueTuple a+   type Element (EventListBT.T NonNegW.Int a) = Tuple.ValueOf a    deflt = piecewiseConstant  @@ -137,18 +132,18 @@ split :: T a c -> T b d -> T (Zip.T a b) (c,d) split (Cons nextA startA createA deleteA)       (Cons nextB startB createB deleteB) = Cons-   (\(parameterA, parameterB) (sa0,sb0) -> do-      (a,sa1) <- nextA parameterA sa0-      (b,sb1) <- nextB parameterB sb0-      return ((a,b), (sa1,sb1)))+   (\(parameterA, parameterB) (sa,sb) ->+      liftA2 zipPair+         (nextA parameterA sa)+         (nextB parameterB sb))    (\(parameterA, parameterB) ->       liftA2 (,)          (startA parameterA)          (startB parameterB))-   (\(Zip.Cons a b) -> do-      (ca,paramA) <- createA a-      (cb,paramB) <- createB b-      return ((ca,cb), (paramA, paramB)))+   (\(Zip.Cons a b) ->+      liftA2 zipPair+         (createA a)+         (createB b))    (\(ca,cb) ->       deleteA ca >>       deleteB cb)@@ -168,14 +163,10 @@       (const $ return ())  storableVector ::-   (Storable a, MakeValueTuple a, ValueTuple a ~ value, Memory.C value) =>-   T (SV.Vector a) value+   (Storable.C a, Tuple.ValueOf a ~ value) => T (SV.Vector a) value storableVector =    Cons-      (\ _ p ->-         liftA2 (,)-            (Memory.load p)-            (A.advanceArrayElementPtr p))+      (\ _ p -> liftA2 (,) (Storable.load p) (Storable.incrementPtr p))       return       (\vec ->          let (fp,ptr,_l) = SVU.unsafeToPointers vec@@ -189,15 +180,14 @@ but here we do not accept early exit. -} piecewiseConstant ::-   (Storable a, MakeValueTuple a, ValueTuple a ~ value,-    Memory.C value) =>+   (Storable.C a, Tuple.ValueOf a ~ value, Memory.C value) =>    T (EventListBT.T NonNegW.Int a) value piecewiseConstant =    expandConstantPieces $    rmap (uncurry Zip.Cons .          mapPair             (SV.pack .-               map ((fromIntegral :: Int -> Word32) . NonNegW.toNumber),+               map ((fromIntegral :: Int -> Word) . NonNegW.toNumber),              SV.pack) .          swap . unzip . EventListBT.toPairList) $    fmap (uncurry Const.Cons) $@@ -210,12 +200,12 @@       (Const.Cons length1 y1, s1) <-          C.whileLoopShared state0             (\(Const.Cons len _y, s) ->-               (A.cmp LLVM.CmpEQ len Class.zeroTuple,+               (A.cmp LLVM.CmpEQ len Tuple.zero,                 next param s))       length2 <- A.dec length1       return (y1, (Const.Cons length2 y1, s1)))    (\param ->-      fmap ((,) (Const.Cons Class.zeroTuple Class.undefTuple)) $+      fmap ((,) (Const.Cons Tuple.zero Tuple.undef)) $       start param)    create delete @@ -225,9 +215,8 @@ in order to forbid writing to the array. -} controllerSet ::-   (TypeNum.Natural n,-    Storable a, MakeValueTuple a, ValueTuple a ~ LLVM.Value a,-    Memory.FirstClass a, LLVM.IsSized a, LLVM.IsSized (Memory.Stored a)) =>+   (TypeNum.Natural n, Storable.C a,+    LLVM.Storable a, Tuple.ValueOf a ~ LLVM.Value a, LLVM.IsSized a) =>    Proxy n -> T (PCS.T Int a) (LLVM.Value (LLVM.Array n a)) controllerSet pn =    controllerSetFromSV pn $@@ -235,21 +224,19 @@  controllerSetFromSV ::    (TypeNum.Natural n,-    Storable a, MakeValueTuple a, ValueTuple a ~ LLVM.Value a,-    Memory.FirstClass a, LLVM.IsSized a, LLVM.IsSized (Memory.Stored a)) =>+    LLVM.Storable a, Tuple.ValueOf a ~ LLVM.Value a, LLVM.IsSized a) =>    Proxy n ->-   T (Zip.T (SV.Vector Word32) (Zip.T (SV.Vector Word32) (SV.Vector a)))-     (LLVM.Value Word32, (LLVM.Value Word32, LLVM.Value a)) ->+   T (Zip.T (SV.Vector Word) (Zip.T (SV.Vector Word) (SV.Vector a)))+     (LLVM.Value Word, (LLVM.Value Word, LLVM.Value a)) ->    T (PCS.T Int a) (LLVM.Value (LLVM.Array n a)) controllerSetFromSV pn (Cons next start create delete) = Cons    (\((arrPtr, _), param) state0 -> do       (length2, s2) <-          C.whileLoopShared state0             (\(len0, s0) ->-               (A.cmp LLVM.CmpEQ len0 Class.zeroTuple,+               (A.cmp LLVM.CmpEQ len0 Tuple.zero,                 do ((len1, (i,a)), s1) <- next param s0-                   LLVM.store a =<<-                      LLVM.getElementPtr arrPtr (i, ())+                   LLVM.store a =<< LLVM.getElementPtr arrPtr (i, ())                    return (len1, s1)))       length3 <- A.dec length2       arr <- LLVM.load =<< LLVM.bitcast arrPtr@@ -269,8 +256,8 @@                       uncurry Zip.Cons . mapPair (SV.pack, SV.pack). unzip) .                    unzip .                    map (\((i,a),len) ->-                      (fromIntegral len :: Word32,-                       (fromIntegral i :: Word32, a))) .+                      (fromIntegral len :: Word,+                       (fromIntegral i :: Word, a))) .                    EventListBT.toPairList $                    bt) @@ -284,12 +271,12 @@              return                ((arr, context),-                ((arr, fromIntegral initialTime :: Word32), param)))+                ((LLVM.fromPtr arr, fromIntegral initialTime :: Word), param)))             {-             It would be more elegant,             if we could pass Arrays around just like Vectors. -            return (context, ((sampleArray (\i -> maybe Class.undefTuple Class.valueTupleOf $ Map.lookup i (PCS.initial pcs)), time), param)))+            return (context, ((sampleArray (\i -> maybe Tuple.undef Tuple.valueOf $ Map.lookup i (PCS.initial pcs)), time), param)))             -}          (EventListTT.flatten (PCS.stream pcs)))    (\(arr, context) ->
src/Synthesizer/LLVM/Plug/Output.hs view
@@ -4,43 +4,46 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE UndecidableInstances #-}-module Synthesizer.LLVM.Plug.Output where+module Synthesizer.LLVM.Plug.Output (+   T(..),+   Default(..),+   split,+   storableVector,+   ) where  import qualified Synthesizer.Zip as Zip +import qualified LLVM.Extra.Storable as Storable+import qualified LLVM.Extra.Marshal as Marshal import qualified LLVM.Extra.Memory as Memory-import qualified LLVM.Extra.Class as Class-import qualified LLVM.Extra.Arithmetic as A+import qualified LLVM.Extra.Tuple as Tuple  import qualified LLVM.Core as LLVM -import Control.Monad (liftM2, )+import Control.Monad (liftM2)  import qualified Synthesizer.LLVM.Storable.Vector as SVU import qualified Data.StorableVector as SV import qualified Data.StorableVector.Base as SVB  import qualified Foreign.ForeignPtr as FPtr-import Foreign.Storable.Tuple ()-import Foreign.Storable (Storable, ) +import Data.Tuple.Strict (zipPair)+ import NumericPrelude.Numeric-import NumericPrelude.Base hiding (and, iterate, map, zip, zipWith, take, takeWhile, )+import NumericPrelude.Base hiding (and, iterate, map, zip, zipWith, take, takeWhile)   data T a b =    forall state ioContext parameters.-      (Storable parameters,-       Class.MakeValueTuple parameters,-       Memory.C (Class.ValueTuple parameters),-       Memory.C state) =>+      (Marshal.C parameters, Memory.C state) =>    Cons       (forall r.-       Class.ValueTuple parameters ->+       Tuple.ValueOf parameters ->        a -> state -> LLVM.CodeGenFunction r state)           -- compute next value       (forall r.-       Class.ValueTuple parameters ->+       Tuple.ValueOf parameters ->        LLVM.CodeGenFunction r state)           -- initial state       (Int -> IO (ioContext, parameters))@@ -67,28 +70,26 @@    type Element (Zip.T c d) = (Element c, Element d)    deflt = split deflt deflt -instance-   (Storable a, Class.MakeValueTuple a, Memory.C (Class.ValueTuple a)) =>-      Default (SV.Vector a) where-   type Element (SV.Vector a) = Class.ValueTuple a+instance (Storable.C a) => Default (SV.Vector a) where+   type Element (SV.Vector a) = Tuple.ValueOf a    deflt = storableVector   split :: T a c -> T b d -> T (a,b) (Zip.T c d) split (Cons nextA startA createA deleteA)       (Cons nextB startB createB deleteB) = Cons-   (\(parameterA, parameterB) (a,b) (sa0,sb0) -> do-      sa1 <- nextA parameterA a sa0-      sb1 <- nextB parameterB b sb0-      return (sa1,sb1))+   (\(parameterA, parameterB) (a,b) (sa,sb) ->+      liftM2 (,)+         (nextA parameterA a sa)+         (nextB parameterB b sb))    (\(parameterA, parameterB) ->       liftM2 (,)          (startA parameterA)          (startB parameterB))-   (\len -> do-      (ca,paramA) <- createA len-      (cb,paramB) <- createB len-      return ((ca,cb), (paramA, paramB)))+   (\len ->+      liftM2 zipPair+         (createA len)+         (createB len))    (\len (ca,cb) ->       liftM2 Zip.Cons          (deleteA len ca)@@ -96,12 +97,9 @@   storableVector ::-   (Class.MakeValueTuple a, value ~ Class.ValueTuple a,-    Memory.C value, Storable a) =>-   T value (SV.Vector a)+   (Storable.C a, Tuple.ValueOf a ~ value) => T value (SV.Vector a) storableVector = Cons-   (\ _ a p ->-      Memory.store a p >> A.advanceArrayElementPtr p)+   (const Storable.storeNext)    return    (\len -> do       vec <- SVB.create len (const $ return ())
src/Synthesizer/LLVM/Random.hs view
@@ -19,10 +19,10 @@ import qualified Type.Data.Num.Decimal as TypeNum  import qualified Data.NonEmpty.Class as NonEmptyC-import Data.Function.HT (nest, )+import Data.Function.HT (nest) -import Data.Int (Int32, )-import Data.Word (Word32, Word64, )+import Data.Int (Int32)+import Data.Word (Word32, Word64)   factor :: Integral a => a
src/Synthesizer/LLVM/RingBuffer.hs view
@@ -5,16 +5,14 @@ import qualified LLVM.Extra.Memory as Memory import qualified LLVM.Extra.Control as C import qualified LLVM.Extra.Arithmetic as A-import qualified LLVM.Extra.Class as Class+import qualified LLVM.Extra.Tuple as Tuple  import qualified LLVM.Core as LLVM-import LLVM.Core (CodeGenFunction, Value, )+import LLVM.Core (CodeGenFunction, Value) -import Data.Word (Word32, )-import Foreign.Storable.Tuple ()-import Foreign.Ptr (Ptr, )+import Data.Word (Word) -import Prelude hiding (length, )+import Prelude hiding (length)   {-@@ -27,12 +25,14 @@ -} data T a =    Cons {-      buffer :: Value (Ptr (Memory.Struct a)),-      length :: Value Word32,-      current :: Value Word32,-      oldest_ :: Value Word32+      buffer :: Value (MemoryPtr a),+      length :: Value Word,+      current :: Value Word,+      oldest_ :: Value Word    } +type MemoryPtr a = LLVM.Ptr (Memory.Struct a)+ {- | This function does not check for range violations. If the ring buffer was generated by @track initial time@,@@ -40,9 +40,7 @@ Index zero refers to the current sample and index @time@ refers to the oldest one. -}-index ::-   (Memory.C a) =>-   Value Word32 -> T a -> CodeGenFunction r a+index :: (Memory.C a) => Value Word -> T a -> CodeGenFunction r a index i rb = do    k <- flip A.irem (length rb) =<< A.add (current rb) i    Memory.load =<< LLVM.getElementPtr (buffer rb) (k, ())@@ -52,26 +50,21 @@ For the result of @track initial time@ this is equivalent to @index time@ but more efficient. -}-oldest ::-   (Memory.C a) =>-   T a -> CodeGenFunction r a+oldest :: (Memory.C a) => T a -> CodeGenFunction r a oldest rb =    Memory.load =<< LLVM.getElementPtr (buffer rb) (oldest_ rb, ())  -trackConstCreate ::-   (p -> t) ->-   p -> IO ((), t)-trackConstCreate getTime p =-   return ((), getTime p)+trackConstCreate :: (p -> t) -> p -> IO ((), t)+trackConstCreate getTime p = return ((), getTime p)   trackNext ::-   (Memory.C al, Memory.Struct al ~ am) =>-   (tl -> Value Word32) ->-   (tl, Value (Ptr am)) -> () ->-   al -> Value Word32 ->-   Maybe.T r z (T al, Value Word32)+   (Memory.C al) =>+   (tl -> Value Word) ->+   (tl, Value (MemoryPtr al)) -> () ->+   al -> Value Word ->+   Maybe.T r z (T al, Value Word) trackNext valueTime (size,ptr) () a remain0 = Maybe.lift $ do    Memory.store a =<< LLVM.getElementPtr ptr (remain0, ())    cont <- A.cmp LLVM.CmpGT remain0 A.zero@@ -81,10 +74,10 @@    return (Cons ptr size1 remain0 remain1, remain1)  trackStart ::-   (Memory.C al, Memory.Struct al ~ am) =>-   (tl -> Value Word32) ->+   (Memory.C al) =>+   (tl -> Value Word) ->    (al, tl) ->-   CodeGenFunction r ((tl, Value (Ptr am)), Value Word32)+   CodeGenFunction r ((tl, Value (MemoryPtr al)), Value Word) trackStart valueTime (initial, size) = do    let size0 = valueTime size    size1 <- A.inc size0@@ -96,14 +89,13 @@  trackStop ::    (LLVM.IsType am) =>-   (tl, Value (Ptr am)) ->-   Value Word32 ->+   (tl, Value (LLVM.Ptr am)) ->+   Value Word ->    CodeGenFunction r () trackStop (_size,ptr) _remain = LLVM.free ptr  trackCreate ::-   (Class.MakeValueTuple a, Class.ValueTuple a ~ al,-    Memory.C al, Memory.Struct al ~ am) =>+   (Tuple.Value a) =>    (p -> a) ->    (p -> t) ->    p ->
src/Synthesizer/LLVM/Server/CausalPacked/Instrument.hs view
@@ -33,9 +33,9 @@    ) where  import qualified Synthesizer.LLVM.Server.Parameter as ParamS-import Synthesizer.LLVM.Server.Packed.Instrument (stereoNoise, )+import Synthesizer.LLVM.Server.Packed.Instrument (stereoNoise) import Synthesizer.LLVM.Server.CommonPacked-import Synthesizer.LLVM.Server.Common hiding (Instrument, )+import Synthesizer.LLVM.Server.Common hiding (Instrument) import Synthesizer.LLVM.Server.Parameter          (Number(Number), VectorTime(VectorTime), Signal(Signal)) @@ -45,8 +45,8 @@ import qualified Synthesizer.CausalIO.Gate as Gate import qualified Synthesizer.CausalIO.Process as PIO -import Synthesizer.LLVM.CausalParameterized.Process (($<), )-import Synthesizer.LLVM.CausalParameterized.Functional (($&), (&|&), )+import Synthesizer.LLVM.CausalParameterized.Process (($<))+import Synthesizer.LLVM.CausalParameterized.Functional (($&), (&|&)) import qualified Synthesizer.LLVM.Filter.Universal as UniFilter import qualified Synthesizer.LLVM.Filter.Allpass as Allpass import qualified Synthesizer.LLVM.Filter.Moog as Moog@@ -62,11 +62,10 @@ import qualified Synthesizer.LLVM.CausalParameterized.Process as CausalP import qualified Synthesizer.LLVM.Parameterized.SignalPacked as SigPS import qualified Synthesizer.LLVM.Parameterized.Signal as SigP-import qualified Synthesizer.LLVM.Parameter as Param import qualified Synthesizer.LLVM.Interpolation as Interpolation import qualified Synthesizer.LLVM.Wave as WaveL import qualified Synthesizer.LLVM.Simple.Value as Value-import Synthesizer.LLVM.Simple.Value ((%>), (%<=), )+import Synthesizer.LLVM.Simple.Value ((%>), (%<=))  import qualified Synthesizer.LLVM.MIDI.BendModulation as BM import qualified Synthesizer.LLVM.MIDI as MIDIL@@ -79,23 +78,24 @@ import qualified Data.StorableVector.Lazy as SVL import qualified Data.StorableVector as SV +import qualified LLVM.DSL.Parameter as Param import qualified LLVM.Core as LLVM  import qualified Type.Data.Num.Decimal as TypeNum  import qualified Control.Monad.HT as M-import Control.Arrow (Arrow, arr, first, second, (&&&), (<<^), (^<<), )-import Control.Category (id, (.), )-import Control.Monad (liftM2, liftM3, liftM4, (<=<), )-import Control.Applicative (pure, liftA2, liftA3, )+import Control.Arrow (Arrow, arr, first, second, (&&&), (<<^), (^<<))+import Control.Category (id, (.))+import Control.Monad (liftM2, liftM3, liftM4, (<=<))+import Control.Applicative (pure, liftA2, liftA3)  import qualified Data.Traversable as Trav-import Data.Monoid (mappend, )+import Data.Monoid (mappend)  import qualified Number.DimensionTerm as DN  import NumericPrelude.Numeric-import NumericPrelude.Base hiding (id, (.), )+import NumericPrelude.Base hiding (id, (.))   type Instrument a sig = SampleRate a -> MIO.Instrument a sig
src/Synthesizer/LLVM/Server/CausalPacked/InstrumentPlug.hs view
@@ -16,17 +16,17 @@           WithEnvelopeControl, StereoChunk,           pingControlledEnvelope,           stringControlledEnvelope,-          reorderEnvelopeControl, )+          reorderEnvelopeControl) import Synthesizer.LLVM.Server.CommonPacked (-          Param, VectorValue, )+          Param, VectorValue) import Synthesizer.LLVM.Server.Common (           SampleRate, Real,           frequencyConst, timeConst,-          number, transposeModulation, )+          number, transposeModulation)  import qualified Synthesizer.CausalIO.Process as PIO -import Synthesizer.LLVM.CausalParameterized.FunctionalPlug (($&), (&|&), )+import Synthesizer.LLVM.CausalParameterized.FunctionalPlug (($&), (&|&)) import qualified Synthesizer.LLVM.Frame.Stereo as Stereo import qualified Synthesizer.LLVM.Frame.SerialVector as Serial import qualified Synthesizer.LLVM.CausalParameterized.Helix as Helix@@ -35,7 +35,6 @@ import qualified Synthesizer.LLVM.CausalParameterized.Process as CausalP import qualified Synthesizer.LLVM.Parameterized.SignalPacked as SigPS import qualified Synthesizer.LLVM.Parameterized.Signal as SigP-import qualified Synthesizer.LLVM.Parameter as Param import qualified Synthesizer.LLVM.Interpolation as Interpolation import qualified Synthesizer.LLVM.Wave as WaveL @@ -43,14 +42,15 @@ import qualified Synthesizer.LLVM.MIDI as MIDIL import qualified Synthesizer.Zip as Zip +import qualified LLVM.DSL.Parameter as Param import qualified LLVM.Core as LLVM  import qualified Data.Traversable as Trav-import Control.Category (id, (.), )-import Control.Applicative (liftA2, )+import Control.Category (id, (.))+import Control.Applicative (liftA2)  import NumericPrelude.Numeric-import NumericPrelude.Base hiding (id, (.), )+import NumericPrelude.Base hiding (id, (.))   type FuncP pp pl = FP.T pp (SampleRate Real, pl)
src/Synthesizer/LLVM/Server/CausalPacked/Speech.hs view
@@ -21,18 +21,18 @@ import Synthesizer.LLVM.Server.CausalPacked.Instrument           (StereoChunk, Control, Frequency, frequencyControl,            WithEnvelopeControl, zipEnvelope,-           stringControlledEnvelope, pingControlledEnvelope, )-import Synthesizer.LLVM.Server.CommonPacked (VectorValue, )+           stringControlledEnvelope, pingControlledEnvelope)+import Synthesizer.LLVM.Server.CommonPacked (VectorValue) import Synthesizer.LLVM.Server.Common-          (SampleRate(SampleRate), Real, parameter, noiseReference, frequency, )+          (SampleRate(SampleRate), Real, parameter, noiseReference, frequency) import qualified Synthesizer.LLVM.Server.SampledSound as Sample  import qualified Synthesizer.MIDI.CausalIO.Process as MIO import qualified Synthesizer.CausalIO.Gate as Gate import qualified Synthesizer.CausalIO.Process as PIO -import Synthesizer.LLVM.CausalParameterized.Process (($<), ($>), ($*), )-import Synthesizer.LLVM.CausalParameterized.FunctionalPlug (($&), (&|&), )+import Synthesizer.LLVM.CausalParameterized.Process (($<), ($>), ($*))+import Synthesizer.LLVM.CausalParameterized.FunctionalPlug (($&), (&|&)) import qualified Synthesizer.LLVM.Frame.Stereo as Stereo import qualified Synthesizer.LLVM.Frame.SerialVector as Serial import qualified Synthesizer.LLVM.Filter.NonRecursive as FiltNR@@ -60,16 +60,16 @@ import qualified LLVM.Core as LLVM  import qualified System.Path as Path-import System.Path ((</>), (<.>), )+import System.Path ((</>), (<.>)) -import Control.Arrow (arr, second, (^<<), (***), )-import Control.Category ((.), )-import Control.Applicative (pure, liftA, liftA3, (<$>), (<*>), )+import Control.Arrow (arr, second, (^<<), (***))+import Control.Category ((.))+import Control.Applicative (pure, liftA, liftA3, (<$>), (<*>)) -import Data.Traversable (Traversable, traverse, forM, )+import Data.Traversable (Traversable, traverse, forM)  import NumericPrelude.Numeric-import NumericPrelude.Base hiding ((.), )+import NumericPrelude.Base hiding ((.))   {-
src/Synthesizer/LLVM/Server/CausalPacked/SpeechExplore.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE NoImplicitPrelude #-} module Main where -import Synthesizer.LLVM.Server.Common (Real, )+import Synthesizer.LLVM.Server.Common (Real)  import qualified Synthesizer.LLVM.Server.SampledSound as Sample import qualified Sound.Sox.Write as SoxWrite@@ -16,7 +16,7 @@ import qualified Synthesizer.LLVM.Parameterized.Signal as SigP import qualified Synthesizer.LLVM.Filter.FirstOrder as Filt1 import qualified Synthesizer.LLVM.Filter.NonRecursive as FiltNR-import Synthesizer.LLVM.Causal.Process (($*), ($<), ($<#), )+import Synthesizer.LLVM.Causal.Process (($*), ($<), ($<#))  import qualified Synthesizer.Plain.Filter.Recursive.Universal as UniFilter import qualified Synthesizer.Plain.Filter.Recursive.FirstOrder as FirstOrder@@ -30,34 +30,34 @@ import qualified Synthesizer.Causal.Filter.NonRecursive as FiltNRC import qualified Synthesizer.Causal.Process as Causal import qualified Synthesizer.State.Signal as SigS-import Synthesizer.Piecewise ((#|-), (-|#), (#|), (|#), )+import Synthesizer.Piecewise ((#|-), (-|#), (#|), (|#))  import qualified Data.StorableVector.Lazy as SVL import qualified Data.StorableVector as SV -import Control.Arrow (arr, (<<<), (^<<), )-import Control.Category ((.), id, )-import Control.Applicative ((<$>), )+import Control.Arrow (arr, (<<<), (^<<))+import Control.Category ((.), id)+import Control.Applicative ((<$>)) -import Control.Functor.HT (void, )+import Control.Functor.HT (void)  import qualified Data.List.HT as ListHT import qualified Data.List as List-import Data.Foldable (forM_, )-import Data.Maybe.HT (toMaybe, )-import Data.Maybe (catMaybes, )-import Data.Tuple.HT (mapSnd, )-import Data.Ord.HT (comparing, )-import Data.Monoid (mempty, mappend, )+import Data.Foldable (forM_)+import Data.Maybe.HT (toMaybe)+import Data.Maybe (catMaybes)+import Data.Tuple.HT (mapSnd)+import Data.Ord.HT (comparing)+import Data.Monoid (mempty, mappend)  import qualified System.Path.PartClass as PathClass import qualified System.Path as Path-import System.Path ((</>), (<.>), )+import System.Path ((</>), (<.>))  import qualified Number.Complex as Complex  import NumericPrelude.Numeric-import NumericPrelude.Base hiding (id, (.), )+import NumericPrelude.Base hiding (id, (.))   sampleRateInt :: Int
src/Synthesizer/LLVM/Server/Common.hs view
@@ -25,22 +25,20 @@ import qualified Synthesizer.LLVM.MIDI.BendModulation as BM  import qualified Synthesizer.LLVM.Parameterized.Signal as SigP-import qualified Synthesizer.LLVM.Parameter as Param+import qualified LLVM.DSL.Parameter as Param -import qualified LLVM.Extra.Memory as Memory-import qualified LLVM.Extra.Class as Class+import qualified LLVM.Extra.Marshal as Marshal+import qualified LLVM.Extra.Tuple as Tuple  import qualified Synthesizer.Storable.Signal as SigSt  import qualified Data.EventList.Relative.TimeTime as EventListTT -import qualified Numeric.NonNegative.Class   as NonNeg--import Foreign.Storable (Storable, )+import qualified Numeric.NonNegative.Class as NonNeg -import Control.Arrow (arr, (^<<), )+import Control.Arrow (arr, (^<<)) -import Prelude hiding (Real, )+import Prelude hiding (Real)   @@ -113,9 +111,7 @@   piecewiseConstant ::-   (Storable a,-    Class.MakeValueTuple a, Class.ValueTuple a ~ al,-    Memory.C al) =>+   (Marshal.C a, Tuple.ValueOf a ~ al) =>    Param.T p (PC.T a) -> SigP.T p al piecewiseConstant pc =    SigP.piecewiseConstant
src/Synthesizer/LLVM/Server/CommonPacked.hs view
@@ -17,10 +17,10 @@  import qualified Type.Data.Num.Decimal as TypeNum -import Control.Arrow (arr, )+import Control.Arrow (arr) -import NumericPrelude.Numeric ((+), (-), (*), )-import Prelude hiding (Real, (+), (-), (*), )+import NumericPrelude.Numeric ((+), (-), (*))+import Prelude hiding (Real, (+), (-), (*))   sumNested :: (Additive.C a) => [a] -> a
src/Synthesizer/LLVM/Server/Packed/Instrument.hs view
@@ -13,6 +13,9 @@   instruments:+   use a greymap picture as source of waveforms+   mix of detuned noisy-waverforms, try different and uniform waveforms+   mix of sawtooth, where every sawtooth is modulated with red noise    mix of sine with harmonics where every harmonic is modulated differently    Flute: sine + filtered noise    Drum with various parameters@@ -128,7 +131,7 @@ import qualified Synthesizer.MIDI.PiecewiseConstant as PC import qualified Synthesizer.MIDI.EventList as Ev -import Synthesizer.MIDI.Storable (chunkSizesFromLazyTime, )+import Synthesizer.MIDI.Storable (chunkSizesFromLazyTime)  import qualified Synthesizer.LLVM.Frame.Stereo as Stereo import qualified Synthesizer.LLVM.Filter.Universal as UniFilterL@@ -142,15 +145,16 @@ import qualified Synthesizer.LLVM.Parameterized.SignalPacked as SigPS import qualified Synthesizer.LLVM.Parameterized.Signal as SigP import qualified Synthesizer.LLVM.Simple.Signal as Sig-import qualified Synthesizer.LLVM.Parameter as Param import qualified Synthesizer.LLVM.Storable.Signal as SigStL import qualified Synthesizer.LLVM.Frame as Frame import qualified Synthesizer.LLVM.Frame.SerialVector as Serial import qualified Synthesizer.LLVM.Wave as WaveL-import Synthesizer.LLVM.CausalParameterized.Process (($<), ($>), ($*), )-import Synthesizer.LLVM.CausalParameterized.Functional (($&), (&|&), )-import Synthesizer.LLVM.Parameter (($#), )+import Synthesizer.LLVM.CausalParameterized.Process (($<), ($>), ($*))+import Synthesizer.LLVM.CausalParameterized.Functional (($&), (&|&)) +import qualified LLVM.DSL.Parameter as Param+import LLVM.DSL.Parameter (($#))+ import qualified LLVM.Extra.Arithmetic as A import qualified LLVM.Core as LLVM import qualified Type.Data.Num.Decimal as TypeNum@@ -163,24 +167,20 @@ import qualified Synthesizer.Plain.Filter.Recursive.Universal as UniFilter  import qualified Control.Monad.HT as M-import Control.Arrow ((<<<), (^<<), (<<^), (&&&), (***), arr, first, second, )-import Control.Category (id, )-import Control.Applicative (liftA2, liftA3, )-import Data.Traversable (traverse, )+import Control.Arrow ((<<<), (^<<), (<<^), (&&&), (***), arr, first, second)+import Control.Category (id)+import Control.Applicative (liftA2, liftA3)+import Data.Traversable (traverse) import qualified Data.Traversable as Trav -import Data.Tuple.HT (fst3, snd3, thd3, )+import Data.Tuple.HT (fst3, snd3, thd3) -{--import qualified Numeric.NonNegative.Class   as NonNeg-import qualified Numeric.NonNegative.Wrapper as NonNegW--} import qualified Numeric.NonNegative.Chunky as NonNegChunky  import qualified Algebra.Additive as Additive -import NumericPrelude.Numeric (zero, one, round, (^?), (+), (-), (*), )-import Prelude hiding (Real, round, break, id, (+), (-), (*), )+import NumericPrelude.Numeric (zero, one, round, (^?), (+), (-), (*))+import Prelude hiding (Real, round, break, id, (+), (-), (*))   @@ -229,7 +229,7 @@ frequencyFromBendModulation :: {-    (Storable a,-    Class.MakeValueTuple a, ValueTuple a ~ (Value a)) =>+    Tuple.Value a, ValueTuple a ~ (Value a)) => -}    Param p Real ->    Param p (PC.T (BM.T Real)) ->@@ -255,7 +255,7 @@    Param.T p (PC.T Real) -> SigP.T p VectorValue {-    (Storable a,-    Class.MakeValueTuple a, Class.ValueTuple a ~ al,+    Tuple.Value a, Tuple.ValueOf a ~ al,     Memory.C al am,     LLVM.IsSized am as) =>    Param.T p (PC.T a) -> SigP.T p (Serial.Value n al)
src/Synthesizer/LLVM/Server/Parameter.hs view
@@ -9,16 +9,16 @@ import Synthesizer.LLVM.Server.Common (Param, Real, SampleRate(SampleRate))  import qualified Synthesizer.PiecewiseConstant.Signal as PC-import qualified Synthesizer.LLVM.Parameter as Param- import qualified Synthesizer.Storable.Signal as SigSt +import qualified LLVM.DSL.Parameter as Param+ import qualified Control.Category as Cat-import Control.Applicative ((<$>), )+import Control.Applicative ((<$>))  import qualified Data.Tuple.HT as TupleHT -import Prelude hiding (Real, )+import Prelude hiding (Real)   class Tuple tuple where
src/Synthesizer/LLVM/Server/SampledSound.hs view
@@ -1,23 +1,23 @@ module Synthesizer.LLVM.Server.SampledSound where -import Synthesizer.LLVM.Server.Common (Real, )+import Synthesizer.LLVM.Server.Common (Real)  import qualified Sound.Sox.Read          as SoxRead import qualified Sound.Sox.Option.Format as SoxOption-import Control.Exception (bracket, )+import Control.Exception (bracket)  import qualified Synthesizer.Storable.Signal      as SigSt import qualified Data.StorableVector.Lazy         as SVL  import qualified System.Path.PartClass as PathClass import qualified System.Path as Path-import System.Path ((</>), )+import System.Path ((</>)) -import Data.Tuple.HT (mapPair, )+import Data.Tuple.HT (mapPair)  import qualified Number.DimensionTerm as DN -import Prelude hiding (Real, length, )+import Prelude hiding (Real, length)
src/Synthesizer/LLVM/Server/SampledSoundAnalysis.hs view
@@ -5,7 +5,7 @@ import qualified Synthesizer.LLVM.Server.Default as Default import qualified Synthesizer.LLVM.Server.SampledSound as Sample -import Synthesizer.LLVM.Server.Common (Real, )+import Synthesizer.LLVM.Server.Common (Real)  import qualified Graphics.Gnuplot.Advanced as Plot import qualified Graphics.Gnuplot.Plot.TwoDimensional as Plot2D@@ -21,18 +21,18 @@ import qualified System.Path as Path  import qualified Data.Foldable as Fold-import Control.Functor.HT (void, )-import Control.Monad (when, )-import Data.Tuple.HT (snd3, )-import Data.Monoid ((<>), )-import Data.Ord.HT (comparing, )+import Control.Functor.HT (void)+import Control.Monad (when)+import Data.Tuple.HT (snd3)+import Data.Monoid ((<>))+import Data.Ord.HT (comparing)  import qualified Number.Complex as Complex import qualified Algebra.Field as Field import qualified Algebra.Additive as Additive  import NumericPrelude.Numeric-import NumericPrelude.Base hiding (id, )+import NumericPrelude.Base hiding (id) import Prelude ()  {-
src/Synthesizer/LLVM/Server/Scalar/Instrument.hs view
@@ -18,21 +18,21 @@ import qualified Synthesizer.LLVM.Parameterized.Signal as SigP import qualified Synthesizer.LLVM.Storable.Signal as SigStL import qualified Synthesizer.LLVM.Wave as WaveL-import Synthesizer.LLVM.CausalParameterized.Process (($<), ($>), ($*), )+import Synthesizer.LLVM.CausalParameterized.Process (($<), ($>), ($*))  import qualified LLVM.Core as LLVM  import qualified Synthesizer.MIDI.EventList as Ev-import Synthesizer.MIDI.Storable (chunkSizesFromLazyTime, )+import Synthesizer.MIDI.Storable (chunkSizesFromLazyTime)  import qualified Synthesizer.Storable.Signal      as SigSt import qualified Data.StorableVector.Lazy.Pattern as SigStV -import Control.Arrow ((^<<), arr, )-import Control.Applicative (liftA, liftA2, )+import Control.Arrow ((^<<), arr)+import Control.Applicative (liftA, liftA2) -import NumericPrelude.Numeric (zero, round, (+), )-import Prelude hiding (Real, round, break, (+), )+import NumericPrelude.Numeric (zero, round, (+))+import Prelude hiding (Real, round, break, (+))   pingSig :: SigP.T (SampleRate Real, (Real, Real)) (LLVM.Value Real)
src/Synthesizer/LLVM/Simple/Signal.hs view
@@ -40,7 +40,6 @@ import qualified Synthesizer.LLVM.Frame.Stereo as Stereo import qualified Synthesizer.LLVM.Frame as Frame import qualified Synthesizer.LLVM.Wave as Wave-import qualified Synthesizer.LLVM.Execution as Exec import qualified Synthesizer.LLVM.ForeignPtr as ForeignPtr  import qualified Synthesizer.LLVM.Storable.ChunkIterator as ChunkIt@@ -49,37 +48,36 @@ import qualified Data.StorableVector as SV import qualified Data.StorableVector.Base as SVB +import qualified LLVM.DSL.Execution as Exec++import qualified LLVM.Extra.Storable as Storable import qualified LLVM.Extra.Memory as Memory import qualified LLVM.Extra.ScalarOrVector as SoV import qualified LLVM.Extra.MaybeContinuation as MaybeCont import qualified LLVM.Extra.Maybe as Maybe import qualified LLVM.Extra.Arithmetic as A-import LLVM.Extra.Arithmetic (advanceArrayElementPtr, )-import LLVM.Extra.Class (Undefined, MakeValueTuple, ValueTuple, valueTupleOf, )+import qualified LLVM.Extra.Tuple as Tuple  import qualified LLVM.Core as LLVM-import LLVM.Util.Loop (Phi, ) import LLVM.Core           (CodeGenFunction, ret, Value, valueOf,-           IsSized, IsConst, IsArithmetic)+           IsFirstClass, IsSized, IsConst, IsArithmetic) -import Control.Monad (liftM2, )-import Control.Applicative (pure, liftA2, liftA3, (<$>), )+import Control.Monad (liftM2)+import Control.Applicative (pure, liftA2, liftA3, (<$>)) -import Data.Monoid (Monoid, mappend, )+import Data.Monoid (Monoid, mappend)  import qualified Algebra.Transcendental as Trans  import qualified System.Unsafe as Unsafe-import Foreign.Storable.Tuple ()-import Foreign.Storable (Storable, )-import Foreign.ForeignPtr (touchForeignPtr, withForeignPtr, )-import Foreign.Ptr (Ptr, )-import Data.Word (Word32, )-import Control.Exception (bracket, )+import Foreign.ForeignPtr (touchForeignPtr)+import Foreign.Ptr (Ptr)+import Data.Word (Word)+import Control.Exception (bracket)  import NumericPrelude.Numeric-import NumericPrelude.Base hiding (and, iterate, map, zip, zipWith, takeWhile, )+import NumericPrelude.Base hiding (and, iterate, map, zip, zipWith, takeWhile)   constant :: (C signal, IsConst a) => a -> signal (Value a)@@ -117,7 +115,7 @@ -} mixExt ::    (C signal, Monoid (signal (Value Bool, a)),-    A.Additive a, Phi a, Undefined a) =>+    A.Additive a, Tuple.Phi a, Tuple.Undefined a) =>    signal a -> signal a -> signal a mixExt xs ys =    let ext zs =@@ -176,8 +174,7 @@   iterate ::-   (C signal,-    Memory.FirstClass a, Memory.Stored a ~ am, IsSized am, IsConst a) =>+   (C signal, IsFirstClass a, IsSized a, IsConst a) =>    (forall r. Value a -> CodeGenFunction r (Value a)) ->    Value a -> signal (Value a) iterate f initial =@@ -186,17 +183,14 @@       (return initial)  exponential2 ::-   (C signal, Trans.C a, IsArithmetic a,-    Memory.FirstClass a, Memory.Stored a ~ am, IsSized am, IsConst a) =>+   (C signal, Trans.C a, IsArithmetic a, IsSized a, IsConst a) =>    a -> a -> signal (Value a) exponential2 halfLife =    iterate (\y -> A.mul y (valueOf (0.5 ** recip halfLife))) . valueOf   osciPlain ::-   (C signal,-    Memory.FirstClass t, Memory.Stored t ~ tm, IsSized tm,-    SoV.Fraction t, IsConst t) =>+   (C signal, SoV.Fraction t, IsSized t, IsConst t) =>    (forall r. Value t -> CodeGenFunction r y) ->    Value t -> Value t -> signal y osciPlain wave phase freq =@@ -205,42 +199,35 @@    phase  osci ::-   (C signal,-    Memory.FirstClass t, Memory.Stored t ~ tm, IsSized tm,-    SoV.Fraction t, IsConst t) =>+   (C signal, SoV.Fraction t, IsSized t, IsConst t) =>    (forall r. Value t -> CodeGenFunction r y) ->    t -> t -> signal y osci wave phase freq =    osciPlain wave (valueOf phase) (valueOf freq)  osciSaw ::-   (C signal,-    SoV.IntegerConstant a,-    Memory.FirstClass a, Memory.Stored a ~ am, IsSized am,-    SoV.Fraction a, IsConst a) =>+   (C signal, SoV.IntegerConstant a, SoV.Fraction a, IsSized a, IsConst a) =>    a -> a -> signal (Value a) osciSaw = osci Wave.saw    fromStorableVector ::-   (Storable a, MakeValueTuple a, ValueTuple a ~ value, Memory.C value) =>-   SV.Vector a ->-   T value+   (Storable.C a, Tuple.ValueOf a ~ value) => SV.Vector a -> T value fromStorableVector xs =    let (fp,ptr,l) = SVU.unsafeToPointers xs    in  Cons           (\_ () (p0,l0) -> do              cont <- MaybeCont.lift $ A.cmp LLVM.CmpGT l0 A.zero              MaybeCont.withBool cont $ do-                y1 <- Memory.load p0-                p1 <- advanceArrayElementPtr p0+                y1 <- Storable.load p0+                p1 <- Storable.incrementPtr p0                 l1 <- A.dec l0                 return (y1,(p1,l1)))           (return ())           (const $ return              (valueOf ptr,-              valueOf (fromIntegral l :: Word32)))+              valueOf (fromIntegral l :: Word)))           -- keep the foreign ptr alive           (return (fp, ()))           touchForeignPtr@@ -251,16 +238,11 @@ and advances to the next chunk in the sequence. -} fromStorableVectorLazy ::-   (Storable a, MakeValueTuple a, ValueTuple a ~ value, Memory.C value) =>-   SVL.Vector a ->-   T value+   (Storable.C a, Tuple.ValueOf a ~ value) => SVL.Vector a -> T value fromStorableVectorLazy = flattenChunks . storableVectorChunks  storableVectorChunks ::-   (Storable a, MakeValueTuple a, ValueTuple a ~ value, Memory.C value,-    Memory.Struct value ~ struct) =>-   SVL.Vector a ->-   T (Value (Ptr struct), Value Word32)+   (Storable.C a) => SVL.Vector a -> T (Value (Ptr a), Value Word) storableVectorChunks sig =    Cons       (storableVectorNextChunk "Simple.Signal.fromStorableVectorLazy.nextChunk")@@ -271,24 +253,25 @@   foreign import ccall safe "dynamic" derefFillPtr ::-   Exec.Importer (Word32 -> Ptr struct -> IO Word32)+   Exec.Importer (Word -> Ptr struct -> IO Word)   compile ::-   (Memory.C value, Memory.Struct value ~ struct,-    Memory.C state, Memory.Struct state ~ stateStruct) =>-   (forall r z. (Phi z) => local -> state -> MaybeCont.T r z (value, state)) ->+   (Storable.C a, Tuple.ValueOf a ~ value, Memory.C state) =>+   (forall r z.+    (Tuple.Phi z) => local -> state -> MaybeCont.T r z (value, state)) ->    (forall r. CodeGenFunction r local) ->    (forall r. CodeGenFunction r state) ->-   IO (Word32 -> Ptr struct -> IO Word32)+   IO (Word -> Ptr a -> IO Word) compile next alloca start =-   Exec.compileModule $+   Exec.compile "signal" $       Exec.createFunction derefFillPtr "fillsignalblock" $ \ size bPtr -> do          s <- start          local <- alloca-         (pos,_) <- MaybeCont.arrayLoop size bPtr s $ \ ptri s0 -> do+         (pos,_) <-+               Storable.arrayLoopMaybeCont size bPtr s $ \ ptri s0 -> do             (y,s1) <- next local s0-            MaybeCont.lift $ Memory.store y ptri+            MaybeCont.lift $ Storable.store y ptri             return s1          ret pos @@ -300,7 +283,7 @@ The parameter order is consistent with that of @Parameterized.Signal.render@. -} render ::-   (Storable a, MakeValueTuple a, ValueTuple a ~ value, Memory.C value) =>+   (Storable.C a, Tuple.ValueOf a ~ value, Memory.C value) =>    T value -> Int -> SV.Vector a render (Cons next alloca start createIOContext deleteIOContext) len =    Unsafe.performIO $@@ -308,35 +291,33 @@    SVB.createAndTrim len $ \ ptr ->       do fill <-             compile-               (next $ valueTupleOf params) alloca (start $ valueTupleOf params)-         fmap (fromIntegral :: Word32 -> Int) $-            fill (fromIntegral len) (Memory.castTuplePtr ptr)+               (next $ Tuple.valueOf params) alloca (start $ Tuple.valueOf params)+         fmap (fromIntegral :: Word -> Int) $ fill (fromIntegral len) ptr   foreign import ccall safe "dynamic" derefStartPtr ::-   Exec.Importer (IO (Ptr a))+   Exec.Importer (IO (LLVM.Ptr a))  foreign import ccall safe "dynamic" derefStopPtr ::-   Exec.Importer (Ptr a -> IO ())+   Exec.Importer (LLVM.Ptr a -> IO ())  foreign import ccall safe "dynamic" derefChunkPtr ::-   Exec.Importer (Ptr stateStruct -> Word32 -> Ptr struct -> IO Word32)+   Exec.Importer (LLVM.Ptr stateStruct -> Word -> Ptr struct -> IO Word)   compileChunky ::-   (Memory.C value, Memory.Struct value ~ struct,+   (Storable.C a, Tuple.ValueOf a ~ value,     Memory.C state, Memory.Struct state ~ stateStruct) =>    (forall r z.-    (Phi z) =>+    (Tuple.Phi z) =>     local -> state -> MaybeCont.T r z (value, state)) ->    (forall r. CodeGenFunction r local) ->-   (forall r.-    CodeGenFunction r state) ->-   IO (IO (Ptr stateStruct),+   (forall r. CodeGenFunction r state) ->+   IO (IO (LLVM.Ptr stateStruct),        Exec.Finalizer stateStruct,-       Ptr stateStruct -> Word32 -> Ptr struct -> IO Word32)+       LLVM.Ptr stateStruct -> Word -> Ptr a -> IO Word) compileChunky next alloca start =-   Exec.compileModule $+   Exec.compile "signal-chunky" $       liftA3 (,,)          (Exec.createFunction derefStartPtr "startsignal" $           do@@ -357,24 +338,25 @@           \ sptr loopLen ptr -> do              sInit <- Memory.load sptr              local <- alloca-             (pos,sExit) <- MaybeCont.arrayLoop loopLen ptr sInit $-              \ ptri s0 -> do+             (pos,sExit) <-+                Storable.arrayLoopMaybeCont loopLen ptr sInit $+                   \ ptri s0 -> do                 (y,s1) <- next local s0-                MaybeCont.lift $ Memory.store y ptri+                MaybeCont.lift $ Storable.store y ptri                 return s1              Memory.store (Maybe.fromJust sExit) sptr              ret pos)   runChunky ::-   (Storable a, MakeValueTuple a, ValueTuple a ~ value, Memory.C value) =>+   (Storable.C a, Tuple.ValueOf a ~ value) =>    T value -> SVL.ChunkSize -> IO (SVL.Vector a) runChunky (Cons next alloca start createIOContext deleteIOContext)       (SVL.ChunkSize size) = do    (ioContext, params) <- createIOContext    (startFunc, stopFunc, fill) <-       compileChunky-         (next $ valueTupleOf params) alloca (start $ valueTupleOf params)+         (next $ Tuple.valueOf params) alloca (start $ Tuple.valueOf params)     statePtr <- ForeignPtr.newInit stopFunc startFunc    ioContextPtr <- ForeignPtr.newAux (deleteIOContext ioContext)@@ -382,11 +364,10 @@    let go =          Unsafe.interleaveIO $ do             v <--               withForeignPtr statePtr $ \sptr ->+               ForeignPtr.with statePtr $ \sptr ->                SVB.createAndTrim size $-               fmap (fromIntegral :: Word32 -> Int) .-               fill sptr (fromIntegral size) .-               Memory.castTuplePtr+               fmap (fromIntegral :: Word -> Int) .+               fill sptr (fromIntegral size)             touchForeignPtr ioContextPtr             (if SV.length v > 0                then fmap (v:)@@ -397,7 +378,7 @@    fmap SVL.fromChunks go  renderChunky ::-   (Storable a, MakeValueTuple a, ValueTuple a ~ value, Memory.C value) =>+   (Storable.C a, Tuple.ValueOf a ~ value) =>    SVL.ChunkSize -> T value -> SVL.Vector a renderChunky size sig =    Unsafe.performIO (runChunky sig size)
src/Synthesizer/LLVM/Simple/SignalPacked.hs view
@@ -2,7 +2,7 @@ {-# LANGUAGE TypeFamilies #-} module Synthesizer.LLVM.Simple.SignalPacked where -import Synthesizer.LLVM.Simple.SignalPrivate (Core(Core), alter, )+import Synthesizer.LLVM.Simple.SignalPrivate (Core(Core), alter) import qualified Synthesizer.LLVM.Simple.Signal as Sig import qualified Synthesizer.LLVM.Frame.SerialVector as Serial @@ -10,19 +10,19 @@ import qualified LLVM.Extra.MaybeContinuation as Maybe import qualified LLVM.Extra.Control as U import qualified LLVM.Extra.Arithmetic as A-import LLVM.Extra.Class (undefTuple, )+import qualified LLVM.Extra.Tuple as Tuple  import qualified LLVM.Core as LLVM-import LLVM.Core (valueOf, )+import LLVM.Core (valueOf)  import qualified Control.Monad.Trans.Class as MT import qualified Control.Monad.Trans.State as MS-import Control.Monad (replicateM, )+import Control.Monad (replicateM) -import Data.Word (Word32, )+import Data.Word (Word)  import NumericPrelude.Numeric as NP-import NumericPrelude.Base hiding (and, iterate, map, zip, zipWith, )+import NumericPrelude.Base hiding (and, iterate, map, zip, zipWith)   @@ -44,7 +44,7 @@          U.whileLoop             (valueOf True,              (wInit,-              valueOf $ (fromIntegral $ Serial.sizeOfIterator wInit :: Word32),+              valueOf $ (fromIntegral $ Serial.sizeOfIterator wInit :: Word),               s))             (\(cont,(_w0,i0,_s0)) ->                A.and cont =<<@@ -74,7 +74,7 @@       (v2,_,s2) <-          Maybe.fromBool $          U.whileLoop-            (valueOf True, (undefTuple, A.zero, s))+            (valueOf True, (Tuple.undef, A.zero, s))             (\(cont,(v0,i0,_s0)) ->                A.and cont =<<                   A.cmp LLVM.CmpLT i0@@ -120,7 +120,7 @@ unpackRotate = alter (\(Core next start stop) -> Core    (\context (i0,r0,s0) -> do       endOfVector <--         Maybe.lift $ A.cmp LLVM.CmpEQ i0 (valueOf (0::Word32))+         Maybe.lift $ A.cmp LLVM.CmpEQ i0 (valueOf (0::Word))       (i2,r2,s2) <-          Maybe.fromBool $          U.ifThen endOfVector (valueOf True, (i0,r0,s0)) $ do@@ -131,7 +131,7 @@          (a,r3) <- Serial.readNext r2          i3 <- A.dec i2          return (a, (i3,r3,s2)))-   (fmap (\s -> (A.zero, undefTuple, s)) . start)+   (fmap (\s -> (A.zero, Tuple.undef, s)) . start)    (\(_,_,state) -> stop state))  @@ -160,7 +160,7 @@          return (a, (i3,v2,s2)))    (\p -> do       s <- start p-      let v = undefTuple+      let v = Tuple.undef       return (valueOf $ fromIntegral $ Serial.size v, v, s))    stop) -}
src/Synthesizer/LLVM/Simple/SignalPrivate.hs view
@@ -7,36 +7,37 @@  import qualified Synthesizer.LLVM.Storable.ChunkIterator as ChunkIt +import qualified LLVM.Extra.Storable as Storable+import qualified LLVM.Extra.Marshal as Marshal import qualified LLVM.Extra.Memory as Memory import qualified LLVM.Extra.MaybeContinuation as MaybeCont import qualified LLVM.Extra.Either as Either import qualified LLVM.Extra.Maybe as Maybe import qualified LLVM.Extra.Arithmetic as A-import LLVM.Extra.Control (ifThen, )-import LLVM.Extra.Class (MakeValueTuple, ValueTuple, Undefined, )+import qualified LLVM.Extra.Tuple as Tuple+import LLVM.Extra.Control (ifThen) +import qualified LLVM.Util.Proxy as LP import qualified LLVM.Core as LLVM-import LLVM.Util.Loop (Phi, )-import LLVM.Core (CodeGenFunction, Value, valueOf, )+import LLVM.Core (CodeGenFunction, Value, valueOf) -import Control.Monad (liftM2, )-import Control.Applicative (Applicative, pure, liftA2, (<*>), (<$>), )+import Control.Monad (liftM2)+import Control.Applicative (Applicative, pure, liftA2, (<*>), (<$>)) -import Foreign.Storable.Tuple ()-import Foreign.Storable (Storable, )-import Foreign.StablePtr (StablePtr, )-import Foreign.Ptr (Ptr, nullPtr, )+import Foreign.StablePtr (StablePtr)+import Foreign.Ptr (Ptr, nullPtr) -import Data.Monoid (Monoid, mempty, mappend, )-import Data.Semigroup (Semigroup, (<>), )-import Data.Word (Word32, )+import Data.Tuple.Strict (zipPair)+import Data.Monoid (Monoid, mempty, mappend)+import Data.Semigroup (Semigroup, (<>))+import Data.Word (Word)  import qualified Number.Ratio as Ratio import qualified Algebra.Field as Field import qualified Algebra.Ring as Ring import qualified Algebra.Additive as Additive -import NumericPrelude.Base hiding (and, iterate, map, zip, zipWith, )+import NumericPrelude.Base hiding (and, iterate, map, zip, zipWith)  import qualified Prelude as P @@ -64,20 +65,17 @@ -} data T a =    forall state local ioContext parameters.-      (Storable parameters,-       MakeValueTuple parameters,-       Memory.C (ValueTuple parameters),-       Memory.C state) =>+      (Marshal.C parameters, Memory.C state) =>       Cons (forall r c.-            (Phi c) =>-            ValueTuple parameters -> local ->+            (Tuple.Phi c) =>+            Tuple.ValueOf parameters -> local ->             state -> MaybeCont.T r c (a, state))                -- compute next value            (forall r.             CodeGenFunction r local)                -- allocate temporary variables before a loop            (forall r.-            ValueTuple parameters ->+            Tuple.ValueOf parameters ->             CodeGenFunction r state)                -- initial state            (IO (ioContext, parameters))@@ -93,7 +91,7 @@    forall state.       (Memory.C state) =>       Core (forall r c.-            (Phi c) =>+            (Tuple.Phi c) =>             context ->             state -> MaybeCont.T r c (a, state))                -- compute next value@@ -161,9 +159,6 @@ zipWith f a b  =  map (uncurry f) $ liftA2 (,) a b  -zipPair :: (a,b) -> (c,d) -> ((a,c),(b,d))-zipPair (a,b) (c,d) = ((a,c),(b,d))- zip :: T a -> T b -> T (a,b) zip (Cons nextA allocaA startA createIOContextA deleteIOContextA)     (Cons nextB allocaB startB createIOContextB deleteIOContextB) =@@ -260,7 +255,7 @@ have been executed so far. This in turn might be difficult in connection with the garbage collector. -}-append :: (Phi a, Undefined a) => T a -> T a -> T a+append :: (Tuple.Phi a, Tuple.Undefined a) => T a -> T a -> T a append       (Cons nextA allocaA startA createIOContextA deleteIOContextA)       (Cons nextB allocaB startB createIOContextB deleteIOContextB) =@@ -287,21 +282,20 @@       (combineCreate createIOContextA createIOContextB)       (combineDelete deleteIOContextA deleteIOContextB) -instance (Phi a, Undefined a) => Semigroup (T a) where+instance (Tuple.Phi a, Tuple.Undefined a) => Semigroup (T a) where    (<>) = append -instance (Phi a, Undefined a) => Monoid (T a) where+instance (Tuple.Phi a, Tuple.Undefined a) => Monoid (T a) where    mempty = empty    mappend = append    storableVectorNextChunk ::-   (Phi c, MakeValueTuple a, ValueTuple a ~ value,-    Memory.C value, Memory.Struct value ~ struct) =>+   (Tuple.Phi c, Storable.C a) =>    String ->-   Value (StablePtr (ChunkIt.T a)) -> Value (Ptr Word32) -> () ->-   MaybeCont.T r c ((Value (Ptr struct), Value Word32), ())+   Value (StablePtr (ChunkIt.T a)) -> Value (LLVM.Ptr Word) -> () ->+   MaybeCont.T r c ((Value (Ptr a), Value Word), ()) storableVectorNextChunk callbackName stable lenPtr () =    MaybeCont.fromBool $ do       nextChunkFn <- LLVM.staticNamedFunction callbackName ChunkIt.nextCallBack@@ -313,8 +307,8 @@       return (valid, ((buffer,len), ()))  flattenChunks ::-   (C signal, Memory.C value, Memory.Struct value ~ struct) =>-   signal (Value (Ptr struct), Value Word32) -> signal value+   (C signal, Storable.C a, Tuple.ValueOf a ~ value) =>+   signal (Value (Ptr a), Value Word) -> signal value flattenChunks = alter $ \(Core next start stop) ->    Core       (\context ((buffer0,length0), state0) -> do@@ -324,16 +318,23 @@                (valueOf True, ((buffer0,length0), state0))                (MaybeCont.toBool $ next context state0)          MaybeCont.lift $ do-            x <- Memory.load buffer1-            buffer2 <- A.advanceArrayElementPtr buffer1+            x <- Storable.load buffer1+            buffer2 <- Storable.incrementPtr buffer1             length2 <- A.dec length1             return (x, ((buffer2,length2), state1)))       (\p -> (,) (valueOf nullPtr, A.zero) <$> start p)       (stop . snd) -alloca :: (C signal, LLVM.IsSized a) => signal (LLVM.Value (Ptr a))+alloca :: (C signal, LLVM.IsSized a) => signal (LLVM.Value (LLVM.Ptr a)) alloca =    simpleAlloca       (\ptr () -> return (ptr, ()))       LLVM.alloca       (return ())+++proxyFromElement :: f a -> LP.Proxy a+proxyFromElement _ = LP.Proxy++proxyFromElement2 :: f (g a) -> LP.Proxy a+proxyFromElement2 _ = LP.Proxy
src/Synthesizer/LLVM/Simple/Value.hs view
@@ -26,9 +26,9 @@  import qualified LLVM.Extra.Control as C import qualified LLVM.Extra.Arithmetic as A+import qualified LLVM.Extra.Tuple as Tuple -import LLVM.Util.Loop (Phi, )-import LLVM.Core (CodeGenFunction, )+import LLVM.Core (CodeGenFunction) import qualified LLVM.Core as LLVM  import qualified Synthesizer.Basic.Phase as Phase@@ -36,9 +36,9 @@ import qualified Data.Vault.Lazy as Vault import qualified Control.Monad.Trans.Class as MT import qualified Control.Monad.Trans.State as MS-import Control.Monad (liftM2, liftM3, )-import Control.Applicative (Applicative, pure, (<*>), )-import Control.Functor.HT (unzip, unzip3, )+import Control.Monad (liftM2, liftM3)+import Control.Applicative (Applicative, pure, (<*>))+import Control.Functor.HT (unzip, unzip3)  import qualified Synthesizer.LLVM.Frame.Stereo as Stereo @@ -63,8 +63,8 @@ import qualified System.Unsafe as Unsafe  import qualified Prelude as P-import NumericPrelude.Numeric hiding (pi, sqrt, fromRational', fraction, )-import NumericPrelude.Base hiding (min, max, unzip, unzip3, not, )+import NumericPrelude.Numeric hiding (pi, sqrt, fromRational', fraction)+import NumericPrelude.Base hiding (min, max, unzip, unzip3, not)   {-@@ -319,7 +319,7 @@ Cf. '(??)' -} (?) ::-   (Flatten value, Registers value ~ a, Phi a) =>+   (Flatten value, Registers value ~ a, Tuple.Phi a) =>    T (LLVM.Value Bool) -> (value, value) -> value c ? (t, f) =    unfoldCode $ consUnique $ do
src/Synthesizer/LLVM/Simple/Vanilla.hs view
@@ -3,19 +3,19 @@ module Synthesizer.LLVM.Simple.Vanilla where  import qualified Synthesizer.LLVM.Simple.Signal as Sig-import qualified LLVM.Extra.Memory as Memory import qualified Synthesizer.LLVM.Simple.Value as Value-import qualified LLVM.Extra.ScalarOrVector as SoV-import qualified LLVM.Extra.MaybeContinuation as Maybe  import qualified Synthesizer.Basic.Phase as Phase import qualified Synthesizer.Basic.Wave  as Wave -import LLVM.Core (IsArithmetic, IsConst, IsFirstClass, IsSized, Value, )+import qualified LLVM.Extra.MaybeContinuation as Maybe+import qualified LLVM.Extra.ScalarOrVector as SoV+import qualified LLVM.Extra.Memory as Memory+import LLVM.Core (IsArithmetic, IsConst, IsFirstClass, IsSized, Value)  import qualified Algebra.RealRing as RealRing -import NumericPrelude.Base hiding (and, iterate, map, zipWith, )+import NumericPrelude.Base hiding (and, iterate, map, zipWith)   iterateVal ::@@ -52,8 +52,7 @@  osciReg ::    (RealRing.C tv, tv ~ Value.T (Value t),-    Memory.FirstClass t, Memory.Stored t ~ tm, IsSized t, IsSized tm,-    SoV.Fraction t, IsConst t,+    SoV.Fraction t, IsConst t, IsSized t,     IsFirstClass y) =>    Wave.T (Value.T (Value t)) (Value.T (Value y)) ->    Value t -> Value t -> Sig.T (Value y)@@ -64,8 +63,7 @@  osciVal ::    (RealRing.C tv, tv ~ Value.T (Value t),-    Memory.FirstClass t, Memory.Stored t ~ tm, IsSized t, IsSized tm,-    SoV.Fraction t, IsConst t) =>+    SoV.Fraction t, IsConst t, IsSized t) =>    Wave.T (Value.T (Value t)) y ->    Value.T (Value t) -> Value.T (Value t) -> Sig.T y osciVal wave phase freq =
src/Synthesizer/LLVM/Storable/ChunkIterator.hs view
@@ -6,40 +6,34 @@ import qualified Data.StorableVector.Lazy as SVL import qualified Data.StorableVector.Base as SVB -import qualified LLVM.Extra.Memory as Memory-import qualified LLVM.Extra.Class as Class+import qualified LLVM.Extra.Storable as Storable+import qualified LLVM.Core as LLVM -import Data.Word (Word32, )-import Foreign.Storable (Storable, poke, )-import Foreign.Ptr (FunPtr, Ptr, nullPtr, )+import Data.Word (Word)+import Foreign.Storable (poke)+import Foreign.Ptr (FunPtr, Ptr, nullPtr) -import Control.Monad (liftM2, )+import Control.Monad (liftM2) -import Foreign.StablePtr (StablePtr, newStablePtr, freeStablePtr, deRefStablePtr, )-import Data.IORef (IORef, newIORef, readIORef, writeIORef, )+import Foreign.StablePtr (StablePtr, newStablePtr, freeStablePtr, deRefStablePtr)+import Data.IORef (IORef, newIORef, readIORef, writeIORef)   {- FFI declarations must not have constraints. Thus we put them in the iterator datatype. -}-data T a =-   (Storable a, Class.MakeValueTuple a, Memory.C (Class.ValueTuple a)) =>-      Cons (IORef [SVB.Vector a]) (IORef (SVB.Vector a))--type MemoryPtr a = Ptr (Memory.Struct (Class.ValueTuple a))+data T a = (Storable.C a) => Cons (IORef [SVB.Vector a]) (IORef (SVB.Vector a))   foreign import ccall "&nextChunk"-   nextCallBack :: FunPtr (StablePtr (T a) -> Ptr Word32 -> IO (MemoryPtr a))+   nextCallBack :: FunPtr (StablePtr (T a) -> LLVM.Ptr Word -> IO (Ptr a))  foreign export ccall "nextChunk"-   next :: StablePtr (T a) -> Ptr Word32 -> IO (MemoryPtr a)+   next :: StablePtr (T a) -> Ptr Word -> IO (Ptr a)  -new ::-   (Storable a, Class.MakeValueTuple a, Memory.C (Class.ValueTuple a)) =>-   SVL.Vector a -> IO (StablePtr (T a))+new :: (Storable.C a) => SVL.Vector a -> IO (StablePtr (T a)) new sig =    newStablePtr =<<    liftM2 Cons@@ -49,7 +43,7 @@ dispose :: StablePtr (T a) -> IO () dispose = freeStablePtr -next :: StablePtr (T a) -> Ptr Word32 -> IO (MemoryPtr a)+next :: StablePtr (T a) -> Ptr Word -> IO (Ptr a) next stable lenPtr =    deRefStablePtr stable >>= \state ->    case state of@@ -63,6 +57,4 @@                writeIORef chunkRef x >>                writeIORef listRef xs >>                SVB.withStartPtr x-                  (\p l ->-                     poke lenPtr (fromIntegral l) >>-                     return (Memory.castTuplePtr p))+                  (\p l -> poke lenPtr (fromIntegral l) >> return p)
src/Synthesizer/LLVM/Storable/LazySizeIterator.hs view
@@ -5,11 +5,11 @@ import qualified Data.StorableVector.Lazy.Pattern as SVP import qualified Data.StorableVector.Lazy as SVL -import Data.Word (Word32, )+import Data.Word (Word) -import Foreign.StablePtr (StablePtr, newStablePtr, freeStablePtr, deRefStablePtr, )-import Foreign.Ptr (FunPtr, )-import Data.IORef (IORef, newIORef, readIORef, writeIORef, )+import Foreign.StablePtr (StablePtr, newStablePtr, freeStablePtr, deRefStablePtr)+import Foreign.Ptr (FunPtr)+import Data.IORef (IORef, newIORef, readIORef, writeIORef) import qualified Data.List.HT as ListHT  @@ -19,28 +19,24 @@ For problems about Storable constraint, see ChunkIterator. -} foreign import ccall "&nextSize"-   nextCallBack ::-      FunPtr (StablePtr T -> IO Word32)+   nextCallBack :: FunPtr (StablePtr T -> IO Word)  foreign export ccall "nextSize"-   next :: StablePtr T -> IO Word32+   next :: StablePtr T -> IO Word  -new ::-   SVP.LazySize -> IO (StablePtr T)+new :: SVP.LazySize -> IO (StablePtr T) new ls =    newStablePtr . Cons =<< newIORef (Chunky.toChunks (Chunky.normalize ls)) -dispose ::-   StablePtr T -> IO ()+dispose :: StablePtr T -> IO () dispose = freeStablePtr  {- | Zero pieces are filtered out. If 'next' returns 0 then the end of the lazy size is reached. -}-next ::-   StablePtr T -> IO Word32+next :: StablePtr T -> IO Word next stable =    deRefStablePtr stable >>= \state ->    case state of
src/Synthesizer/LLVM/Storable/Process.hs view
@@ -24,15 +24,15 @@ import qualified Number.NonNegative as NonNeg  import qualified LLVM.Extra.Arithmetic as A-import qualified LLVM.Extra.Memory as Memory+import qualified LLVM.Extra.Storable as Storable+import qualified LLVM.Extra.Tuple as Tuple import qualified LLVM.Core as LLVM-import LLVM.Extra.Class (MakeValueTuple, ValueTuple, )+ import qualified Type.Data.Num.Decimal as TypeNum  import qualified Control.Arrow as Arr import qualified Data.Foldable as Fold-import Foreign.Storable (Storable, )-import Foreign.Marshal.Array (advancePtr, )+import Foreign.Marshal.Array (advancePtr)  import qualified System.Unsafe as Unsafe @@ -49,9 +49,7 @@ must fit into the length of the event list. -} makeArranger ::-   (Storable a, A.Additive value,-    MakeValueTuple a, ValueTuple a ~ value, Memory.C value,-    Arr.Arrow arrow) =>+   (Arr.Arrow arrow, Storable.C a, Tuple.ValueOf a ~ value, A.Additive value) =>    IO (arrow           (EventListTT.T NonNeg.Int (SV.Vector a))           (SV.Vector a))@@ -81,7 +79,7 @@   continuePacked ::-   (CutG.Transform a, Storable b, LLVM.IsPrimitive b, TypeNum.Positive n) =>+   (CutG.Transform a, Storable.C b, LLVM.IsPrimitive b, TypeNum.Positive n) =>    PIO.T a (SV.Vector (Serial.Plain n b)) ->    (b -> PIO.T a (SV.Vector (Serial.Plain n b))) ->    PIO.T a (SV.Vector (Serial.Plain n b))
src/Synthesizer/LLVM/Storable/Signal.hs view
@@ -19,8 +19,6 @@ import qualified Synthesizer.LLVM.Parameterized.Signal as SigP import qualified Synthesizer.LLVM.Parameterized.SignalPacked as SigPS -import qualified Synthesizer.LLVM.Execution as Exec- import qualified Synthesizer.LLVM.Frame.SerialVector as Serial import qualified Synthesizer.LLVM.Frame.Stereo as Stereo import qualified Synthesizer.LLVM.Frame.StereoInterleaved as StereoVector@@ -34,27 +32,28 @@ import qualified Data.EventList.Absolute.TimeBody  as AbsEventList import qualified Number.NonNegative as NonNeg +import qualified LLVM.DSL.Execution as Exec++import qualified LLVM.Extra.Storable as Storable import qualified LLVM.Extra.Memory as Memory import qualified LLVM.Extra.Arithmetic as A-import LLVM.Extra.Arithmetic (advanceArrayElementPtr, )-import LLVM.Extra.Control (arrayLoop, )-import LLVM.Extra.Class (MakeValueTuple, ValueTuple, )+import qualified LLVM.Extra.Tuple as Tuple  import qualified LLVM.Core as LLVM-import LLVM.Core (IsPrimitive, ret, getElementPtr, )+import LLVM.Core (IsPrimitive, ret)  import qualified Type.Data.Num.Decimal as TypeNum  import qualified Control.Category as Cat  import qualified Data.List.HT as ListHT-import Data.Word (Word32, )-import Data.Int (Int32, )-import Foreign.Ptr (Ptr, )-import Foreign.ForeignPtr (castForeignPtr, )-import Foreign.Storable (Storable, )-import Foreign.Marshal.Array (advancePtr, )+import Data.Word (Word) +import Foreign.Ptr (Ptr)+import Foreign.ForeignPtr (castForeignPtr)+import Foreign.Storable (Storable)+import Foreign.Marshal.Array (advancePtr)+ import qualified System.Unsafe as Unsafe  import NumericPrelude.Numeric@@ -70,7 +69,7 @@ It would also need copying since the source data may not be aligned properly. -} unpackStrict ::-   (Storable a, IsPrimitive a, TypeNum.Positive n) =>+   (Storable.C a, IsPrimitive a, TypeNum.Positive n) =>    SV.Vector (Serial.Plain n a) -> SV.Vector a unpackStrict v =    let getDim ::@@ -82,14 +81,14 @@    in  SVB.SV (castForeignPtr fptr) (s*d) (l*d)  unpack ::-   (Storable a, IsPrimitive a, TypeNum.Positive n) =>+   (Storable.C a, IsPrimitive a, TypeNum.Positive n) =>    SVL.Vector (Serial.Plain n a) -> SVL.Vector a unpack =    SVL.fromChunks . map unpackStrict . SVL.chunks   unpackStereoStrict ::-   (Storable a, IsPrimitive a, TypeNum.Positive n) =>+   (Storable.C a, IsPrimitive a, TypeNum.Positive n) =>    SV.Vector (StereoVector.T n a) -> SV.Vector (Stereo.T a) unpackStereoStrict v =    let getDim ::@@ -101,7 +100,7 @@    in  SVB.SV (castForeignPtr fptr) (s*d) (l*d)  unpackStereo ::-   (Storable a, IsPrimitive a, TypeNum.Positive n) =>+   (Storable.C a, IsPrimitive a, TypeNum.Positive n) =>    SVL.Vector (StereoVector.T n a) -> SVL.Vector (Stereo.T a) unpackStereo =    SVL.fromChunks . map unpackStereoStrict . SVL.chunks@@ -117,13 +116,13 @@ makeUnpackGenericStrict ::    (Serial.C vv, n ~ Serial.Size vv, va ~ Serial.Element vv,     Memory.C (Serial.ReadIt vv),-    Storable a, MakeValueTuple a, ValueTuple a ~ va, Memory.C va,-    Storable v, MakeValueTuple v, ValueTuple v ~ vv, Memory.C vv) =>+    Storable.C a, Tuple.ValueOf a ~ va,+    Storable.C v, Tuple.ValueOf v ~ vv) =>    IO (SV.Vector v -> SV.Vector a) makeUnpackGenericStrict =    let vectorSize ::           (Serial.C vl, n ~ Serial.Size vl, al ~ Serial.Element vl,-           Storable v, MakeValueTuple v, ValueTuple v ~ vl) =>+           Storable.C v, Tuple.ValueOf v ~ vl) =>           SV.Vector v -> TypeNum.Singleton n        vectorSize _ = TypeNum.singleton    in  fmap (\f v -> f (TypeNum.integralFromSingleton (vectorSize v) * SV.length v) v) $@@ -132,8 +131,8 @@ makeUnpackGeneric ::    (Serial.C vv, n ~ Serial.Size vv, va ~ Serial.Element vv,     Memory.C (Serial.ReadIt vv),-    Storable a, MakeValueTuple a, ValueTuple a ~ va, Memory.C va,-    Storable v, MakeValueTuple v, ValueTuple v ~ vv, Memory.C vv) =>+    Storable.C a, Tuple.ValueOf a ~ va,+    Storable.C v, Tuple.ValueOf v ~ vv) =>    IO (SVL.Vector v -> SVL.Vector a) makeUnpackGeneric =    fmap (\f -> SVL.fromChunks . map f . SVL.chunks) $@@ -141,28 +140,27 @@   makeReverser ::-   (Storable a, MakeValueTuple a, ValueTuple a ~ value, Memory.C value) =>+   (Storable.C a, Tuple.ValueOf a ~ value) =>    (value -> LLVM.CodeGenFunction () value) ->-   IO (Word32 -> Ptr a -> Ptr a -> IO ())+   IO (Word -> Ptr a -> Ptr a -> IO ()) --   (Memory.C a struct, Serial.C a) =>---   IO (Word32 -> Ptr struct -> Ptr struct -> IO ())+--   IO (Word -> Ptr struct -> Ptr struct -> IO ()) makeReverser rev =-   fmap (\f len srcPtr dstPtr ->-      f len (Memory.castTuplePtr srcPtr) (Memory.castTuplePtr dstPtr)) $-   Exec.compileModule $+   Exec.compile "reverse" $    Exec.createFunction derefMixPtr "reverse" $ \ size ptrA ptrB -> do-      ptrAEnd <- getElementPtr ptrA (size, ())-      _ <- arrayLoop size ptrB ptrAEnd $ \ ptrBi ptrAj0 -> do-         ptrAj1 <- getElementPtr ptrAj0 (-1 :: Int32, ())-         flip Memory.store ptrBi+      sizeInt <- LLVM.bitcast size+      ptrAEnd <- Storable.advancePtr sizeInt ptrA+      _ <- Storable.arrayLoop size ptrB ptrAEnd $ \ ptrBi ptrAj0 -> do+         ptrAj1 <- Storable.decrementPtr ptrAj0+         flip Storable.store ptrBi             =<< rev-            =<< Memory.load ptrAj1+            =<< Storable.load ptrAj1          return ptrAj1       ret ()  makeReversePackedStrict ::-   (Storable v, Serial.C vv, n ~ Serial.Size vv, va ~ Serial.Element vv,-    MakeValueTuple v, ValueTuple v ~ vv, Memory.C vv) =>+   (Serial.C vv, n ~ Serial.Size vv, va ~ Serial.Element vv,+    Storable.C v, Tuple.ValueOf v ~ vv) =>    IO (SV.Vector v -> SV.Vector v) makeReversePackedStrict = do    rev <- makeReverser Serial.reverse@@ -173,8 +171,8 @@       rev (fromIntegral len) ptrA ptrB  makeReversePacked ::-   (Storable v, Serial.C vv, n ~ Serial.Size vv, va ~ Serial.Element vv,-    MakeValueTuple v, ValueTuple v ~ vv, Memory.C vv) =>+   (Serial.C vv, n ~ Serial.Size vv, va ~ Serial.Element vv,+    Storable.C v, Tuple.ValueOf v ~ vv) =>    IO (SVL.Vector v -> SVL.Vector v) makeReversePacked =    fmap (\f -> SVL.fromChunks . reverse . map f . SVL.chunks) $@@ -205,7 +203,7 @@       (\body l -> SVL.append body (y l)) x  continuePacked ::-   (TypeNum.Positive n, Storable a, IsPrimitive a) =>+   (TypeNum.Positive n, Storable.C a, IsPrimitive a) =>    SVL.Vector (Serial.Plain n a) ->    (a -> SVL.Vector (Serial.Plain n a)) ->    SVL.Vector (Serial.Plain n a)@@ -233,7 +231,7 @@ continuePackedGeneric :: {-    (Storable v, Serial.C v, n ~ Serial.Size v, a ~ Serial.Element v,-    MakeValueTuple v, ValueTuple v ~ vv, Memory.C vv) =>+    Tuple.Value v, Tuple.ValueOf v ~ vv, Memory.C vv) => -}    (Storable v, Storable a) =>    (SV.Vector v -> SV.Vector a) ->@@ -266,47 +264,43 @@   foreign import ccall safe "dynamic" derefFillPtr ::-   Exec.Importer (Word32 -> Ptr a -> IO ())+   Exec.Importer (Word -> Ptr a -> IO ())  {- | 'fillBuffer' is not only more general than filling with zeros, it also simplifies type inference. -} fillBuffer ::-   (MakeValueTuple a, ValueTuple a ~ value, Memory.C value) =>-   value -> IO (Word32 -> Ptr a -> IO ())+   (Storable.C a, Tuple.ValueOf a ~ value) =>+   value -> IO (Word -> Ptr a -> IO ()) fillBuffer x =-   fmap (\f len ptr -> f len (Memory.castTuplePtr ptr)) $-   Exec.compileModule $+   Exec.compile "constant" $    Exec.createFunction derefFillPtr "constantfill" $ \ size ptr -> do-      arrayLoop size ptr () $ \ ptri () -> do-         Memory.store x ptri-         return ()+      Storable.arrayLoop size ptr () $ \ ptri () -> Storable.store x ptri       ret ()   foreign import ccall safe "dynamic" derefMixPtr ::-   Exec.Importer (Word32 -> Ptr a -> Ptr a -> IO ())+   Exec.Importer (Word -> Ptr a -> Ptr a -> IO ())  makeMixer ::-   (Storable a, MakeValueTuple a, ValueTuple a ~ value, Memory.C value) =>+   (Storable.C a, Tuple.ValueOf a ~ value) =>    (value -> value -> LLVM.CodeGenFunction () value) ->-   IO (Word32 -> Ptr a -> Ptr a -> IO ())+   IO (Word -> Ptr a -> Ptr a -> IO ()) makeMixer add =-   fmap (\f len srcPtr dstPtr ->-      f len (Memory.castTuplePtr srcPtr) (Memory.castTuplePtr dstPtr)) $-   Exec.compileModule $+   Exec.compile "mixer" $    Exec.createFunction derefMixPtr "mix" $ \ size srcPtr dstPtr -> do-      _ <- arrayLoop size srcPtr dstPtr $ \ srcPtri dstPtri -> do-         y <- Memory.load srcPtri-         Memory.modify (add y) dstPtri-         advanceArrayElementPtr dstPtri+      _ <-+         Storable.arrayLoop2 size srcPtr dstPtr () $+            \srcPtri dstPtri () -> do+         y <- Storable.load srcPtri+         Storable.modify (add y) dstPtri       ret ()   addToBuffer ::    (Storable a) =>-   (Word32 -> Ptr a -> Ptr a -> IO ()) ->+   (Word -> Ptr a -> Ptr a -> IO ()) ->    Int -> Ptr a -> Int -> SVL.Vector a -> IO (Int, SVL.Vector a) addToBuffer addChunkToBuffer len v start xs =    let (now,future) = SVL.splitAt (len - start) xs@@ -322,8 +316,7 @@ Same algorithm as in Synthesizer.Storable.Cut.arrangeEquidist -} makeArranger ::-   (Storable a, A.Additive value,-    MakeValueTuple a, ValueTuple a ~ value, Memory.C value) =>+   (Storable.C a, Tuple.ValueOf a ~ value, A.Additive value) =>    IO (SVL.ChunkSize ->        EventList.T NonNeg.Int (SVL.Vector a) ->        SVL.Vector a)@@ -365,8 +358,7 @@ -} {-# DEPRECATED arrange "better use makeArranger" #-} arrange ::-   (Storable a, A.Additive value,-    MakeValueTuple a, ValueTuple a ~ value, Memory.C value) =>+   (Storable.C a, Tuple.ValueOf a ~ value, A.Additive value) =>       SVL.ChunkSize    -> EventList.T NonNeg.Int (SVL.Vector a)          {-^ A list of pairs: (relative start time, signal part),
src/Synthesizer/LLVM/Storable/Vector.hs view
@@ -1,25 +1,18 @@ {-# LANGUAGE TypeFamilies #-} module Synthesizer.LLVM.Storable.Vector where -import qualified LLVM.Extra.Memory as Memory-import LLVM.Extra.Class (MakeValueTuple, ValueTuple, )+import qualified LLVM.Extra.Storable as Storable  import qualified Data.StorableVector as SV import qualified Data.StorableVector.Base as SVB -import Foreign.Storable (Storable, )-import Foreign.Marshal.Array (advancePtr, )-import Foreign.ForeignPtr (ForeignPtr, )-import Foreign.Ptr (Ptr, )+import Foreign.Marshal.Array (advancePtr)+import Foreign.ForeignPtr (ForeignPtr)+import Foreign.Ptr (Ptr) import qualified System.Unsafe as Unsafe  -unsafeToPointers ::-   (Storable a, MakeValueTuple a, ValueTuple a ~ value, Memory.C value) =>-   SV.Vector a ->-   (ForeignPtr a, Ptr (Memory.Struct value), Int)+unsafeToPointers :: (Storable.C a) => SV.Vector a -> (ForeignPtr a, Ptr a, Int) unsafeToPointers v =    let (fp,s,l) = SVB.toForeignPtr v-   in  (fp,-        Memory.castTuplePtr $ Unsafe.foreignPtrToPtr fp `advancePtr` s,-        l)+   in  (fp, Unsafe.foreignPtrToPtr fp `advancePtr` s, l)
src/Synthesizer/LLVM/Wave.hs view
@@ -6,13 +6,13 @@  import qualified LLVM.Extra.Arithmetic as A -import LLVM.Core (CodeGenFunction, )+import LLVM.Core (CodeGenFunction)  import qualified Control.Monad.HT as M-import Control.Monad.HT ((<=<), )+import Control.Monad.HT ((<=<))  import NumericPrelude.Numeric-import NumericPrelude.Base hiding (replicate, )+import NumericPrelude.Base hiding (replicate)
synthesizer-llvm.cabal view
@@ -1,6 +1,6 @@ Cabal-Version:  2.2 Name:           synthesizer-llvm-Version:        0.8.3+Version:        0.9 License:        GPL-3.0-only License-File:   LICENSE Author:         Henning Thielemann <haskell@henning-thielemann.de>@@ -58,7 +58,7 @@   default:     False  Source-Repository this-  Tag:         0.8.3+  Tag:         0.9   Type:        darcs   Location:    http://code.haskell.org/synthesizer/llvm/ @@ -69,15 +69,15 @@  Library   Build-Depends:-    llvm-extra >=0.9 && <0.10,-    llvm-tf >=9.0 && <9.2,+    llvm-dsl >=0.0 && <0.1,+    llvm-extra >=0.10 && <0.11,+    llvm-tf >=9.0 && <9.3,     tfp >=1.0 && <1.1,     vault >=0.3 && <0.4,     synthesizer-core >=0.8 && <0.9,     synthesizer-midi >=0.6 && <0.7,     midi >=0.2.1 && <0.3,     storable-record >=0.0.3 && <0.1,-    storable-tuple >=0.0.2 && <0.1,     sox >=0.2 && <0.3,     storablevector >=0.2.6 && <0.3,     unsafe >=0.0 && <0.1,@@ -90,7 +90,7 @@     containers >=0.1 && <0.7,     transformers >=0.2 && <0.6,     semigroups >=0.1 && <1.0,-    utility-ht >=0.0.14 && <0.1+    utility-ht >=0.0.15 && <0.1    Build-Depends:     -- base-4 needed for Control.Category@@ -181,18 +181,11 @@     Synthesizer.LLVM.Parameterized.SignalPrivate     Synthesizer.LLVM.Causal.ProcessPrivate     Synthesizer.LLVM.CausalParameterized.ProcessPrivate-    Synthesizer.LLVM.Debug.Counter-    Synthesizer.LLVM.Debug.StablePtr-    Synthesizer.LLVM.Debug.Storable-    -- may be moved to llvm-extra-    Synthesizer.LLVM.Execution-    -- shall be removed when Foreign.Marshal.Alloc is fixed-    Synthesizer.LLVM.Alloc     -- experimental     Synthesizer.LLVM.Simple.Vanilla     -- Synthesizer.LLVM.Parameterized.Value -Library synthesizer-llvm-server+Library server   If flag(buildExamples)     Build-Depends:       synthesizer-llvm,@@ -229,7 +222,7 @@ Executable synthi-llvm-example   If flag(buildExamples)     Build-Depends:-      synthesizer-llvm-server,+      server,       synthesizer-llvm,        llvm-extra,@@ -275,8 +268,6 @@       synthesizer-core,       synthesizer-midi,       midi,-      storable-record,-      storable-tuple,       sox,       storablevector,       numeric-prelude,@@ -313,7 +304,7 @@ Executable synthi-llvm-alsa   If flag(buildExamples) && flag(alsa)     Build-Depends:-      synthesizer-llvm-server,+      server,       synthesizer-llvm,        llvm-tf,@@ -365,7 +356,7 @@ Executable synthi-llvm-jack   If flag(buildExamples) && flag(jack)     Build-Depends:-      synthesizer-llvm-server,+      server,       synthesizer-llvm,        jack >=0.7 && <0.8,@@ -403,7 +394,7 @@ Executable synthi-llvm-render   If flag(buildExamples)     Build-Depends:-      synthesizer-llvm-server,+      server,       synthesizer-llvm,        sox,@@ -437,7 +428,7 @@   If flag(buildExamples)     Build-Depends:       gnuplot >=0.5 && <0.6,-      synthesizer-llvm-server,+      server,       synthesizer-llvm,       synthesizer-core,       midi,
testsuite/Test/Main.hs view
@@ -7,7 +7,7 @@  import qualified LLVM.Core as LLVM -import Data.Tuple.HT (mapFst, )+import Data.Tuple.HT (mapFst)   prefix :: String -> [(String, IO ())] -> [(String, IO ())]
testsuite/Test/Synthesizer/LLVM/Filter.hs view
@@ -26,52 +26,51 @@ import qualified Synthesizer.LLVM.Parameterized.SignalPacked as SigPS import qualified Synthesizer.LLVM.Parameterized.Signal as SigP import qualified Synthesizer.LLVM.Simple.Signal as Sig-import Synthesizer.LLVM.CausalParameterized.Process (($<), ($*), )-import Synthesizer.LLVM.Parameter (($#), )+import Synthesizer.LLVM.CausalParameterized.Process (($<), ($*))+import Synthesizer.LLVM.Parameter (($#))  import Synthesizer.Plain.Filter.Recursive (Pole(Pole))--- import qualified Synthesizer.Storable.Signal as SigSt import qualified Synthesizer.Interpolation.Module as Ip import qualified Synthesizer.Causal.Interpolation as InterpC import qualified Synthesizer.Causal.Filter.NonRecursive as FiltC import qualified Synthesizer.Causal.Displacement as DispC import qualified Synthesizer.Causal.Process as CausalS-import qualified Synthesizer.Basic.Wave as WaveCore import qualified Synthesizer.State.Displacement as DispS import qualified Synthesizer.State.Oscillator as OsciS import qualified Synthesizer.State.Signal as SigS+import qualified Synthesizer.Basic.Wave as WaveCore import qualified Synthesizer.Basic.Phase as Phase  import qualified Data.StorableVector.Lazy as SVL  import qualified Test.Synthesizer.LLVM.Generator as Gen import Test.Synthesizer.LLVM.Generator-   (checkWithParam, arg, pair, withGenArgs, )+   (checkWithParam, arg, pair, withGenArgs) import Test.Synthesizer.LLVM.Utility    (checkSimilarity, checkSimilarityState,     CheckSimilarity, CheckSimilarityState,-    randomStorableVector, checkSimilarityPacked, )+    randomStorableVector, checkSimilarityPacked)  import qualified Control.Category as Cat-import Control.Category ((<<<), )-import Control.Arrow ((&&&), (^<<), (<<^), )-import Control.Applicative (liftA2, (<$>), )+import Control.Category ((<<<))+import Control.Arrow ((&&&), (^<<), (<<^))+import Control.Applicative (liftA2, (<$>))  import qualified LLVM.Extra.Arithmetic as A import qualified LLVM.Extra.Memory as Memory  import qualified LLVM.Core as LLVM-import LLVM.Core (Value, )+import LLVM.Core (Value)  import qualified Type.Data.Num.Decimal as TypeNum-import Type.Data.Num.Decimal (D4, )-import Type.Base.Proxy (Proxy, )+import Type.Data.Num.Decimal (D4)+import Type.Base.Proxy (Proxy)  import qualified Number.Complex as Complex import qualified Synthesizer.LLVM.Frame.Stereo as Stereo  import qualified System.Random as Rnd-import Data.Word (Word32, )+import Data.Word (Word32)  import qualified Test.QuickCheck as QC
testsuite/Test/Synthesizer/LLVM/Generator.hs view
@@ -3,16 +3,16 @@ import qualified Synthesizer.LLVM.Parameter as Param import qualified Synthesizer.LLVM.CausalParameterized.Functional as F -import Data.StorableVector.Lazy (ChunkSize, )+import Data.StorableVector.Lazy (ChunkSize) -import System.Random (Random, )+import System.Random (Random) -import Control.Category (id, )-import Control.Applicative (liftA2, liftA3, )+import Control.Category (id)+import Control.Applicative (liftA2, liftA3)  import qualified Test.QuickCheck as QC -import Prelude hiding (id, )+import Prelude hiding (id)   data T f p a = Cons (QC.Gen p) (F.PrepareArguments f p a)
testsuite/Test/Synthesizer/LLVM/Helix.hs view
@@ -10,28 +10,28 @@ import qualified Synthesizer.LLVM.Parameterized.Signal as SigP import qualified Synthesizer.LLVM.Parameter as Param import qualified Synthesizer.LLVM.Interpolation as Interpolation-import Synthesizer.LLVM.CausalParameterized.Functional (($&), (&|&), )-import Synthesizer.LLVM.CausalParameterized.Process (($*), )-import Synthesizer.LLVM.Parameter (($#), )+import Synthesizer.LLVM.CausalParameterized.Functional (($&), (&|&))+import Synthesizer.LLVM.CausalParameterized.Process (($*))+import Synthesizer.LLVM.Parameter (($#))  import qualified Data.StorableVector.Lazy as SVL import qualified Data.StorableVector as SV-import Data.StorableVector.Lazy (ChunkSize, )+import Data.StorableVector.Lazy (ChunkSize) -import Test.Synthesizer.LLVM.Generator (withPreparedArgs, checkWithParam, )+import Test.Synthesizer.LLVM.Generator (withPreparedArgs, checkWithParam) import Test.Synthesizer.LLVM.Utility           (CheckSimilarity, checkSimilarity,-           genRandomVectorParam, randomSignal, )+           genRandomVectorParam, randomSignal) -import Control.Arrow (arr, )-import Control.Applicative (pure, liftA2, )+import Control.Arrow (arr)+import Control.Applicative (pure, liftA2) -import LLVM.Core (Value, )+import LLVM.Core (Value) -import Foreign.Storable (Storable, )+import Foreign.Storable (Storable)  import qualified System.Random as Rnd-import Data.Word (Word32, )+import Data.Word (Word32)  -- import qualified Graphics.Gnuplot.Simple as Gnuplot import qualified Test.QuickCheck as QC
testsuite/Test/Synthesizer/LLVM/Packed.hs view
@@ -3,15 +3,15 @@  import qualified Test.Synthesizer.LLVM.Generator as Gen import Test.Synthesizer.LLVM.Generator-   (Test, checkWithParam, arg, pair, withGenArgs, )+   (Test, checkWithParam, arg, pair, withGenArgs) import Test.Synthesizer.LLVM.Utility    (checkSimilarity, checkEquality,-    CheckSimilarity, CheckEquality, checkSimilarityPacked, )+    CheckSimilarity, CheckEquality, checkSimilarityPacked)  import qualified Synthesizer.LLVM.Wave as Wave import qualified Synthesizer.LLVM.Parameter as Param -import Type.Data.Num.Decimal (D4, )+import Type.Data.Num.Decimal (D4) import qualified Type.Data.Num.Decimal as TypeNum  import qualified Synthesizer.LLVM.Frame.SerialVector as Serial@@ -19,19 +19,19 @@ import qualified Synthesizer.LLVM.Parameterized.SignalPacked as SigPS import qualified Synthesizer.LLVM.Parameterized.Signal as SigP import qualified Synthesizer.LLVM.CausalParameterized.Process as CausalP-import Synthesizer.LLVM.CausalParameterized.Process (($*), )+import Synthesizer.LLVM.CausalParameterized.Process (($*))  import qualified Synthesizer.LLVM.Storable.Signal as SigStL import qualified Data.StorableVector.Lazy as SVL-import Data.StorableVector.Lazy (ChunkSize, )+import Data.StorableVector.Lazy (ChunkSize) -import Control.Arrow (arr, (<<<), )-import Control.Applicative ((<$>), )+import Control.Arrow (arr, (<<<))+import Control.Applicative ((<$>)) -import Data.Word (Word32, )+import Data.Word (Word32)  import qualified Test.QuickCheck as QC-import Test.QuickCheck (quickCheck, )+import Test.QuickCheck (quickCheck)  import NumericPrelude.Numeric import NumericPrelude.Base
testsuite/Test/Synthesizer/LLVM/RingBufferForward.hs view
@@ -6,28 +6,28 @@ import qualified Synthesizer.LLVM.CausalParameterized.RingBufferForward as RingBuffer import qualified Synthesizer.LLVM.CausalParameterized.Process as CausalP import qualified Synthesizer.LLVM.Parameterized.Signal as SigP-import Synthesizer.LLVM.CausalParameterized.Process (($*), )+import Synthesizer.LLVM.CausalParameterized.Process (($*))  import qualified Data.StorableVector.Lazy as SVL  import qualified Test.Synthesizer.LLVM.Generator as Gen import Test.Synthesizer.LLVM.Generator-         (Test, checkWithParam, arg, pair, triple, withGenArgs, )+         (Test, checkWithParam, arg, pair, triple, withGenArgs) import Test.Synthesizer.LLVM.Utility          (CheckEquality, CheckEquality2, checkEquality, checkEquality2,-          genRandomVectorParam, randomSignal, )+          genRandomVectorParam, randomSignal) -import Control.Applicative (pure, )+import Control.Applicative (pure)  import qualified LLVM.Extra.Arithmetic as A  import qualified LLVM.Core as LLVM-import LLVM.Core (Value, )+import LLVM.Core (Value) -import Foreign.Storable (Storable, )+import Foreign.Storable (Storable)  import qualified System.Random as Rnd-import Data.Word (Word32, )+import Data.Word (Word, Word32)  import NumericPrelude.Numeric import NumericPrelude.Base@@ -70,11 +70,11 @@      let noise = SigP.noise seed 1      in checkEquality limitFloat           (SigP.drop n noise)-          (CausalP.map RingBuffer.index (fmap (fromIntegral :: Int -> Word32) n) $*+          (CausalP.map RingBuffer.index (fmap (fromIntegral :: Int -> Word) n) $*            RingBuffer.track (fmap succ n) noise) -randomSkips :: Param.T p (Int, Rnd.StdGen) -> SigP.T p (Value Word32)-randomSkips = randomSignal (0,10::Word32)+randomSkips :: Param.T p (Int, Rnd.StdGen) -> SigP.T p (Value Word)+randomSkips = randomSignal (0,10::Word)  trackSkip :: Test ((Int, Rnd.StdGen), Word32) EquFloat trackSkip =@@ -87,7 +87,7 @@           (CausalP.mapSimple (RingBuffer.index A.one) $*            (RingBuffer.trackSkip 1 noise $* skips)) -trackSkip1 :: Test (Word32, Word32) EquFloat+trackSkip1 :: Test (Word, Word32) EquFloat trackSkip1 =    let bufferSize :: Int        bufferSize = 1000@@ -104,7 +104,7 @@                    (RingBuffer.trackSkip (pure bufferSize) noise $* 1))  trackSkipHold ::-   Test ((Int, Rnd.StdGen), Word32, Word32) (CheckEquality2 Bool Float)+   Test ((Int, Rnd.StdGen), Word, Word32) (CheckEquality2 Bool Float) trackSkipHold =    let bufferSize = 1000    in  withGenArgs
testsuite/Test/Synthesizer/LLVM/Utility.hs view
@@ -11,21 +11,21 @@ import qualified Synthesizer.State.Signal as SigS import qualified Synthesizer.Zip as Zip -import Control.Monad (liftM, liftM2, )-import Control.Applicative ((<$>), )+import Control.Monad (liftM, liftM2)+import Control.Applicative ((<$>))  import qualified Data.StorableVector.Lazy as SVL import qualified Data.StorableVector as SV-import Data.StorableVector.Lazy (ChunkSize, )-import Foreign.Storable (Storable, )+import Data.StorableVector.Lazy (ChunkSize)+import Foreign.Storable (Storable) -import qualified LLVM.Extra.Memory as Memory-import qualified LLVM.Extra.Class as Class+import qualified LLVM.Extra.Storable as Storable+import qualified LLVM.Extra.Tuple as Tuple import qualified LLVM.Core as LLVM  import qualified Type.Data.Num.Decimal as TypeNum -import System.Random (Random, randomRs, StdGen, mkStdGen, )+import System.Random (Random, randomRs, StdGen, mkStdGen)  import Data.Tuple.HT (mapPair) @@ -55,23 +55,22 @@    SVL.cycle $ SVL.fromChunks [randomStorableVector range param]  randomSignal ::-   (Class.MakeValueTuple a, Class.ValueTuple a ~ al, Memory.C al,-    Storable a, Random a) =>+   (Storable.C a, Tuple.ValueOf a ~ al, Random a) =>    (a, a) -> Param.T p (Int, StdGen) -> SigP.T p al randomSignal range p =    SigP.fromStorableVectorLazy (randomStorableVectorLoop range <$> p)   render ::-   (Storable a, Class.MakeValueTuple a, Class.ValueTuple a ~ al, Memory.C al) =>+   (Storable.C a, Tuple.ValueOf a ~ al) =>    (SVL.Vector a -> sig) ->    SigP.T p al -> IO (ChunkSize -> p -> sig) render limit sig =    fmap (\func chunkSize -> limit . func chunkSize) $ SigP.runChunky sig  render2 ::-   (Storable a, Class.MakeValueTuple a, Class.ValueTuple a ~ al, Memory.C al) =>-   (Storable b, Class.MakeValueTuple b, Class.ValueTuple b ~ bl, Memory.C bl) =>+   (Storable.C a, Tuple.ValueOf a ~ al) =>+   (Storable.C b, Tuple.ValueOf b ~ bl) =>    ((SVL.Vector a, SVL.Vector b) -> sig) ->    SigP.T p (al, bl) -> IO (ChunkSize -> p -> sig) render2 limit sig =@@ -95,9 +94,7 @@  {-# INLINE checkSimilarityState #-} checkSimilarityState ::-   (RealRing.C a, Storable a,-    Class.MakeValueTuple a, Class.ValueTuple a ~ av,-    Memory.C av) =>+   (RealRing.C a, Storable.C a, Tuple.ValueOf a ~ av) =>    a ->    (SVL.Vector a -> SVL.Vector a) ->    SigP.T p av ->@@ -124,9 +121,8 @@  {-# INLINE checkSimilarity #-} checkSimilarity ::-   (RealRing.C b, Storable b,-    Storable a,-    Class.MakeValueTuple a, Class.ValueTuple a ~ av, Memory.C av) =>+   (RealRing.C b, Storable.C b,+    Storable.C a, Tuple.ValueOf a ~ av) =>    b ->    (SVL.Vector a -> SVL.Vector b) ->    SigP.T p av -> SigP.T p av ->@@ -162,9 +158,7 @@    property (CheckEqualityGen x y) = QC.property (x==y)  checkEquality ::-   (Eq a, Storable a,-    Class.MakeValueTuple a, Class.ValueTuple a ~ av,-    Memory.C av) =>+   (Eq a, Storable.C a, Tuple.ValueOf a ~ av) =>    (SVL.Vector a -> SVL.Vector a) ->    SigP.T p av -> SigP.T p av ->    IO (ChunkSize -> p -> CheckEquality a)@@ -176,10 +170,8 @@       (render limit gen1)  checkEquality2 ::-   (Eq a, Storable a,-    Class.MakeValueTuple a, Class.ValueTuple a ~ al, Memory.C al) =>-   (Eq b, Storable b,-    Class.MakeValueTuple b, Class.ValueTuple b ~ bl, Memory.C bl) =>+   (Eq a, Storable.C a, Tuple.ValueOf a ~ al) =>+   (Eq b, Storable.C b, Tuple.ValueOf b ~ bl) =>    (SVL.Vector a -> SVL.Vector a) ->    (SVL.Vector b -> SVL.Vector b) ->    SigP.T p (al,bl) -> SigP.T p (al,bl) ->