diff --git a/alsa/Synthesizer/LLVM/Server/CausalPacked/Run.hs b/alsa/Synthesizer/LLVM/Server/CausalPacked/Run.hs --- a/alsa/Synthesizer/LLVM/Server/CausalPacked/Run.hs +++ b/alsa/Synthesizer/LLVM/Server/CausalPacked/Run.hs @@ -172,13 +172,13 @@ formant = do opt <- Option.get proc <- - Arrange.keyboardDetuneFMCore (arr Stereo.multiValue) + Arrange.keyboardDetuneFMCore (arr Stereo.niceValue) (Option.sampleDirectory opt) form <- Speech.filterFormant mix <- CausalRender.run Causal.mix interleave <- CausalRender.run - (Causal.map StereoInt.interleave <<^ Stereo.unMultiValue) + (Causal.map StereoInt.interleave <<^ Stereo.unNiceValue) playFromEvents opt $ \ sampleRate -> arr SigStL.unpackStereoStrict diff --git a/alsa/Synthesizer/LLVM/Server/CausalPacked/Test.hs b/alsa/Synthesizer/LLVM/Server/CausalPacked/Test.hs --- a/alsa/Synthesizer/LLVM/Server/CausalPacked/Test.hs +++ b/alsa/Synthesizer/LLVM/Server/CausalPacked/Test.hs @@ -104,7 +104,7 @@ -- see playFromEvents writeTest :: - (CutG.Read t, Storable a) => + (CutG.Consume t, Storable a) => PIO.T t (SV.Vector a) -> [t] -> IO () writeTest (PIO.Cons next create delete) evsChunky = IO.withFile "/tmp/test.f32" IO.WriteMode $ \h -> @@ -236,7 +236,7 @@ CausalRender.run (Causal.map StereoInt.interleave <<< Causal.envelopeStereo <<< - Causal.map Serial.upsample *** arr Stereo.unMultiValue) + Causal.map Serial.upsample *** arr Stereo.unNiceValue) ping <- Instr.pingStereoReleaseFM @@ -326,7 +326,7 @@ amp <- CausalRender.run - (Causal.map StereoInt.interleave <<^ Stereo.unMultiValue) + (Causal.map StereoInt.interleave <<^ Stereo.unNiceValue) tomatoSmps <- makeSampledSounds opt @@ -398,7 +398,7 @@ amp <- CausalRender.run - (Causal.map StereoInt.interleave <<^ Stereo.unMultiValue) + (Causal.map StereoInt.interleave <<^ Stereo.unNiceValue) tomatoSmps <- makeSampledSounds opt @@ -531,7 +531,7 @@ makeUnpackStereoStrict = fmap (SigStL.unpackStereoStrict ^<<) $ CausalRender.run - (Causal.map StereoInt.interleave <<^ Stereo.unMultiValue) + (Causal.map StereoInt.interleave <<^ Stereo.unNiceValue) {- makeUnpackStereoStrict :: IO (SV.Vector (Stereo.T Vector) -> SV.Vector (Stereo.T Real)) diff --git a/alsa/Synthesizer/LLVM/Server/Packed/Run.hs b/alsa/Synthesizer/LLVM/Server/Packed/Run.hs --- a/alsa/Synthesizer/LLVM/Server/Packed/Run.hs +++ b/alsa/Synthesizer/LLVM/Server/Packed/Run.hs @@ -142,7 +142,7 @@ amp <- CausalRender.run $ \vol -> Causal.map StereoInt.interleave <<< - CausalPS.amplifyStereo vol <<^ Stereo.unMultiValue + CausalPS.amplifyStereo vol <<^ Stereo.unNiceValue arrange <- SigStL.makeArranger withMIDIEventsStereo opt play $ \vectorChunkSize sampleRate -> pioApply (amp (0.2 :: Real)) . @@ -158,7 +158,7 @@ amp <- CausalRender.run $ \vol -> Causal.map StereoInt.interleave <<< - CausalPS.amplifyStereo vol <<^ Stereo.unMultiValue + CausalPS.amplifyStereo vol <<^ Stereo.unNiceValue arrange <- SigStL.makeArranger withMIDIEventsStereo opt play $ \vectorChunkSize sampleRate -> pioApply (amp (0.2 :: Real)) . @@ -176,7 +176,7 @@ amp <- CausalRender.run $ \vol -> Causal.map StereoInt.interleave <<< - CausalPS.amplifyStereo vol <<^ Stereo.unMultiValue + CausalPS.amplifyStereo vol <<^ Stereo.unNiceValue arrange <- SigStL.makeArranger withMIDIEventsStereo opt play $ \vectorChunkSize sampleRate -> pioApply (amp (0.2 :: Real)) . @@ -246,7 +246,7 @@ CausalRender.run $ \ctrl -> (Causal.map StereoInt.interleave <<< Causal.envelopeStereo $< Instr.piecewiseConstantVector ctrl) - <<^ Stereo.unMultiValue + <<^ Stereo.unNiceValue return $ \chan pgm vcsize sr -> do let evHead = @@ -463,7 +463,7 @@ (Causal.stereoFromMonoControlled (UniFilter.lowpass ^<< UniFilterL.causalExp) $< Sig.interpolateConstant (fromIntegral vectorSize :: Exp Int) - (UniFilterL.unMultiValueParameter <$> piecewiseConstant cutoff)) + (UniFilterL.unNiceValueParameter <$> piecewiseConstant cutoff)) <<< Causal.map StereoInt.deinterleave let lowpass :: diff --git a/alsa/Synthesizer/LLVM/Server/Packed/Test.hs b/alsa/Synthesizer/LLVM/Server/Packed/Test.hs --- a/alsa/Synthesizer/LLVM/Server/Packed/Test.hs +++ b/alsa/Synthesizer/LLVM/Server/Packed/Test.hs @@ -213,7 +213,7 @@ (\osc smp _fm _vel _freq _dur -> osc chunkSize (Sample.body smp)) (Render.run $ \smp -> - fmap (\x -> Stereo.consMultiValue x x) $ SigPS.pack smp) + fmap (\x -> Stereo.consNiceValue x x) $ SigPS.pack smp) sampledSoundTest1 :: IO (Sample.T -> @@ -224,7 +224,7 @@ (\osc smp _fm _vel _freq _dur -> osc chunkSize (Sample.body smp)) (Render.run $ \smp -> - Stereo.multiValue <$> + Stereo.niceValue <$> Causal.stereoFromMono (CausalPS.pack (Causal.frequencyModulationLinear smp)) $* liftA2 Stereo.cons @@ -249,7 +249,7 @@ (Render.run $ wrapped $ \(Signal smp) (Modulation fm) -> constant frequency 3 $ \speed _sr -> - Stereo.multiValue <$> + Stereo.niceValue <$> ((Causal.stereoFromMono (CausalPS.pack (Causal.frequencyModulationLinear smp)) <<< @@ -287,7 +287,7 @@ `SigSt.append` pioApply (osc amp release) releaseFM) (CausalRender.run $ \amp smp -> - Stereo.multiValue <$> + Stereo.niceValue <$> (CausalPS.amplifyStereo amp <<< Causal.stereoFromMono @@ -355,7 +355,7 @@ sustainFM `SigSt.append` pioApply (osc amp release) releaseFM) - (CausalRender.run $ \ _amp _smp -> arr (\x -> Stereo.consMultiValue x x)) + (CausalRender.run $ \ _amp _smp -> arr (\x -> Stereo.consNiceValue x x)) (CausalRender.run $ wrapped $ \(Modulation fm) -> constant frequency 3 $ \speed _sr -> @@ -378,7 +378,7 @@ in pioApply osc sustainFM `SigSt.append` SigSt.map (\x -> Stereo.cons x x) releaseFM) - (CausalRender.run $ arr (\x -> Stereo.consMultiValue x x)) + (CausalRender.run $ arr (\x -> Stereo.consNiceValue x x)) sampledSoundSmallSpaceLeak4a :: IO (Sample.T -> @@ -394,7 +394,7 @@ pioApply osc (sustainFM :: SigSt.T Vector) `SigSt.append` SigSt.map (\x -> Stereo.cons x x) releaseFM) - (CausalRender.run $ arr (\x -> Stereo.consMultiValue x x)) + (CausalRender.run $ arr (\x -> Stereo.consNiceValue x x)) sampledSoundNoSmallSpaceLeak3 :: IO (Sample.T -> @@ -434,7 +434,7 @@ (amplifySVL sustainFM `SigSt.append` amplifySVL releaseFM)) - (CausalRender.run $ arr (\x -> Stereo.consMultiValue x x)) + (CausalRender.run $ arr (\x -> Stereo.consNiceValue x x)) sampledSoundSmallSpaceLeak1 :: IO (Sample.T -> @@ -452,7 +452,7 @@ in pioApply osc sustainFM `SigSt.append` pioApply osc releaseFM) - (CausalRender.run $ arr (\x -> Stereo.consMultiValue x x)) + (CausalRender.run $ arr (\x -> Stereo.consNiceValue x x)) sampledSoundSmallSpaceLeak0 :: IO (Sample.T -> @@ -482,7 +482,7 @@ sustainFM `SigSt.append` pioApply (osc amp release) releaseFM) - (CausalRender.run $ \ _amp _smp -> arr (\x -> Stereo.consMultiValue x x)) + (CausalRender.run $ \ _amp _smp -> arr (\x -> Stereo.consNiceValue x x)) makeSample :: Int -> Sample.T makeSample size = diff --git a/alsa/Synthesizer/LLVM/Server/Scalar/Run.hs b/alsa/Synthesizer/LLVM/Server/Scalar/Run.hs --- a/alsa/Synthesizer/LLVM/Server/Scalar/Run.hs +++ b/alsa/Synthesizer/LLVM/Server/Scalar/Run.hs @@ -82,7 +82,7 @@ Causal.osci WaveL.triangle $< zero $* (MIDIL.frequencyFromBendModulation speed - $* piecewiseConstant (fmap BM.unMultiValue <$> fm)) + $* piecewiseConstant (fmap BM.unNiceValue <$> fm)) withMIDIEvents opt play $ \chunkSize sampleRate -> (id :: SigSt.T Real -> SigSt.T Real) . osc chunkSize sampleRate . transposeModulation sampleRate 880 . @@ -116,7 +116,7 @@ sound <- Instr.pingStereoRelease $/ 0.4 $/ 0.1 amp <- CausalRender.run $ \vol -> - Stereo.multiValue ^<< Causal.amplifyStereo vol <<^ Stereo.unMultiValue + Stereo.niceValue ^<< Causal.amplifyStereo vol <<^ Stereo.unNiceValue arrange <- SigStL.makeArranger withMIDIEvents opt play $ \chunkSize sampleRate -> pioApply (amp (0.2 :: Real)) . diff --git a/example/Synthesizer/LLVM/Experiment.hs b/example/Synthesizer/LLVM/Experiment.hs new file mode 100644 --- /dev/null +++ b/example/Synthesizer/LLVM/Experiment.hs @@ -0,0 +1,243 @@ +module Synthesizer.LLVM.Experiment where + +import Synthesizer.LLVM.ExampleUtility + +import qualified Synthesizer.LLVM.Filter.FirstOrder as Filt1 +import qualified Synthesizer.LLVM.Filter.Universal as UniFilter +import qualified Synthesizer.LLVM.Causal.Controlled as Ctrl +import qualified Synthesizer.LLVM.Causal.Process as Causal +import qualified Synthesizer.LLVM.Generator.Render as Render +import qualified Synthesizer.LLVM.Generator.Source as Source +import qualified Synthesizer.LLVM.Generator.Signal as Sig +import qualified Synthesizer.LLVM.Wave as Wave +import Synthesizer.LLVM.Causal.Process (($<), ($*), ($<#)) + +import qualified LLVM.DSL.Expression as Expr +import LLVM.DSL.Expression (Exp, (==*), (<=*), (.&.*)) + +import qualified LLVM.Extra.Nice.Value as NiceValue + +import qualified Synthesizer.Plain.Filter.Recursive.FirstOrder as Filt1Core + +import Control.Arrow ((^<<), (<<^)) +import Control.Category ((.)) + +import qualified Data.StorableVector as SV + +import Data.Tuple.HT (mapFst) +import Data.Word (Word8) +import System.Random (randomRs, randoms, mkStdGen) + +import NumericPrelude.Numeric (fromIntegral, sum, (+), (-), (/), (*)) +import Prelude hiding (fst, snd, id, (.), fromIntegral, sum, (+), (-), (/), (*)) + + + +phaserSawSymmetric :: Exp Float -> Sig.T (NiceValue.T Float) +phaserSawSymmetric freq = + (0.3*) $ + Sig.osci Wave.saw 0.0 (freq*1.003) + + Sig.osci Wave.saw 0.2 (freq*0.997) + + Sig.osci Wave.saw 0.1 freq + +phaserSawAsymmetric :: Exp Float -> Sig.T (NiceValue.T Float) +phaserSawAsymmetric freq = + (0.3*) $ + Sig.osci Wave.saw 0.0 (freq*1.001) + + Sig.osci Wave.saw 0.2 (freq*1.003) + + Sig.osci Wave.saw 0.1 (freq*0.996) + +sigZipWith3 :: + (Expr.Aggregate ae a) => + (Expr.Aggregate be b) => + (Expr.Aggregate ce c) => + (Expr.Aggregate de d) => + (ae -> be -> ce -> de) -> + Sig.T a -> Sig.T b -> Sig.T c -> Sig.T d +sigZipWith3 f sa sb sc = + Causal.map (\(a,(b,c)) -> f a b c) $< sa $< sb $* sc + +phaserSawMinMax :: Exp Float -> Sig.T (NiceValue.T Float) +phaserSawMinMax freq = + sigZipWith3 + (\a b c -> (Expr.min a (Expr.min b c) + Expr.max a (Expr.max b c)) / 2) + (Sig.osci Wave.saw 0.0 (freq*1.001)) + (Sig.osci Wave.saw 0.2 (freq*1.003)) + (Sig.osci Wave.saw 0.1 (freq*0.996)) + +median3 :: + (NiceValue.Comparison a, NiceValue.Select a) => + Exp a -> Exp a -> Exp a -> Exp a +median3 a b c = + Expr.with (a<=*b) $ \a_le_b -> + Expr.with (b<=*c) $ \b_le_c -> + Expr.with (a<=*c) $ \a_le_c -> + Expr.select a_le_b + (Expr.select b_le_c b (Expr.select a_le_c c a)) + (Expr.select a_le_c a (Expr.select b_le_c c b)) + +phaserSawMedian :: Exp Float -> Sig.T (NiceValue.T Float) +phaserSawMedian freq = + sigZipWith3 median3 + (Sig.osci Wave.saw 0.0 (freq*1.0001)) + (Sig.osci Wave.saw 0.2 (freq*1.0003)) + (Sig.osci Wave.saw 0.1 (freq*0.9996)) + +phaserSineMedian :: Exp Float -> Sig.T (NiceValue.T Float) +phaserSineMedian freq = + sigZipWith3 median3 + (Sig.osci Wave.approxSine4 0.0 (freq*1.0001)) + (Sig.osci Wave.approxSine4 0.2 (freq*1.0003)) + (Sig.osci Wave.approxSine4 0.1 (freq*0.9996)) + + +harmonicsTremolo0 :: Exp Float -> Sig.T (NiceValue.T Float) +harmonicsTremolo0 freq = + 0.5 * + sum (map (\k -> + recip (fromInteger k) * + Sig.osci Wave.sine 0 (fromInteger k * freq)) + [1..10]) + +harmonicsTremolo1 :: Exp Float -> Sig.T (NiceValue.T Float) +harmonicsTremolo1 freq = + 0.5 * + sum + (zipWith3 + (\k lfoPhase lfoFreq -> + recip (fromInteger k) * + Sig.osci Wave.sine (Expr.cons lfoPhase) + (Expr.cons (fromInteger k * lfoFreq)) * + Sig.osci Wave.sine 0 (fromInteger k * freq)) + [1..10] +{- + (repeat 0) + (repeat 1e-5)) +-} + (randomRs (0,1) (mkStdGen 42)) + (let f = 1e-5 in randomRs (0.5*f,3*f) (mkStdGen 23))) + +param1 :: NiceValue.T (Filt1.Parameter a) -> Filt1.Parameter (NiceValue.T a) +param1 = NiceValue.decompose (Filt1Core.Parameter NiceValue.atom) + +param2 :: + NiceValue.T (UniFilter.Parameter a) -> UniFilter.Parameter (NiceValue.T a) +param2 = NiceValue.decompose UniFilter.parameterAtoms + +harmonicsTremolo2 :: Exp Float -> Sig.T (NiceValue.T Float) +harmonicsTremolo2 freq = + 100 * + sum + (zipWith + (\k seed -> + recip (fromInteger k) * + ((Filt1.lowpassCausal <<^ mapFst param1) + $<# Filt1.parameter (1e-6 * fromInteger k) + $* Sig.noise (Expr.cons seed) 1) * + Sig.osci Wave.sine 0 (fromInteger k * freq)) + [1..10] + (randoms (mkStdGen 23))) + +harmonicsTremolo :: Exp Float -> Sig.T (NiceValue.T Float) +harmonicsTremolo freq = + 4 * + sum + (zipWith + (\k seed -> + recip (fromInteger k) * + ((UniFilter.lowpass ^<< Ctrl.process <<^ mapFst param2) + -- lower resonance frequency seems to exceed Float precision + $<# UniFilter.parameter 10 (0.5e-4 * fromInteger k) + $* Sig.noise (Expr.cons seed) 1) * + Sig.osci Wave.sine 0 (fromInteger k * freq)) + [1..10] + (randoms (mkStdGen 23))) + +bandpassHarmonics :: Exp Float -> Sig.T (NiceValue.T Float) +bandpassHarmonics freq = + 0.02 * + sum + (zipWith + (\k seed -> + recip (fromInteger k) * + ((UniFilter.lowpass ^<< Ctrl.process) + $< Sig.constant + (UniFilter.parameter 1000 + (fromInteger k * freq :: Exp Float)) + $* Sig.noise (Expr.cons seed) 1)) + [1..10] + (randoms (mkStdGen 23))) + + +asciiWave0 :: Exp Float -> Sig.T (NiceValue.T Float) +asciiWave0 freq = + let char :: Exp Word8 + char = Expr.cons $ fromIntegral $ fromEnum 'Y' in + let wave t = + Expr.select + (Expr.shr char (Expr.floorToInt (t*8)) .&.* 1 ==* 0) (-1) 1 in + Sig.osci (Expr.unliftM1 wave) 0 freq + +asciiWave1 :: Exp Float -> Sig.T (NiceValue.T Float) +asciiWave1 freq = + let char :: Exp Word8 + char = Expr.cons $ fromIntegral $ fromEnum 'Y' in + let wave t = + Expr.select + (Expr.shr char (Expr.floorToInt (t*8)) .&.* 1 ==* 0) (-1) 1 in + (0.7 *) $ + ((Filt1.highpassCausal <<^ mapFst param1) + $<# Filt1.parameter (1e-4) + $* Sig.osci (Expr.unliftM1 wave) 0 freq) + +asciiWavePulse :: + Exp (Source.StorableVector Word8) -> + Exp Float -> Sig.T (NiceValue.T Float) +asciiWavePulse str freq = + let wave char t = + Expr.select + (Expr.shr char (Expr.floorToInt (t*8)) .&.* 1 ==* 0) (-1) 1 in + (0.5 *) $ + ((Filt1.highpassCausal <<^ mapFst param1) + $<# Filt1.parameter (1e-3) + $* (Causal.shapeModOsci (Expr.unliftM2 wave) + $< Sig.interpolateConstant + (10000::Exp Float) (Source.storableVector str) + $* Sig.constant (Expr.zero, freq))) + +asciiWaveSaw :: + Exp (Source.StorableVector Word8) -> + Exp Float -> Sig.T (NiceValue.T Float) +asciiWaveSaw str freq = + let wave char t = + Expr.with (8*t) $ \t8 -> + Expr.select + (Expr.shr char (Expr.floorToInt t8) .&.* 1 ==* 0) + (2 * Expr.fraction t8 - 1) + (1 - 2 * Expr.fraction t8) in + Causal.shapeModOsci (Expr.unliftM2 wave) + $< Sig.interpolateConstant + (10000::Exp Float) (Source.storableVector str) + $* Sig.constant (Expr.zero, freq) + + +render :: Sig.T (NiceValue.T Float) -> IO () +render sig = + SV.writeFile "experiment.f32" . asMono . ($ 1000000) =<< + Render.run sig + + +main :: IO () +main = + case fromInteger 4 :: Integer of + 0 -> render (phaserSawMedian 0.01) + 1 -> render (harmonicsTremolo 0.01) + 2 -> render (bandpassHarmonics 0.01) + 3 -> render (asciiWave1 0.01) + _4 -> + SV.writeFile "experiment.f32" . asMono + . ($ Render.buffer + (SV.pack (map (fromIntegral.fromEnum) "Hello World!"))) + . ($ 1000000) + =<< + Render.run (flip asciiWaveSaw 0.01) diff --git a/example/Synthesizer/LLVM/LAC2011.hs b/example/Synthesizer/LLVM/LAC2011.hs --- a/example/Synthesizer/LLVM/LAC2011.hs +++ b/example/Synthesizer/LLVM/LAC2011.hs @@ -29,8 +29,8 @@ 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.Multi.Vector as MultiVector -import qualified LLVM.Extra.Multi.Value as MultiValue +import qualified LLVM.Extra.Nice.Vector as NiceVector +import qualified LLVM.Extra.Nice.Value as NiceValue import qualified LLVM.Extra.Tuple as Tuple import qualified LLVM.Core as LLVM @@ -84,18 +84,18 @@ import qualified NumericPrelude.Base as P -playStereo :: Gen.T (Stereo.T (MultiValue.T Float)) -> IO () +playStereo :: Gen.T (Stereo.T (NiceValue.T Float)) -> IO () playStereo sig = playStereoStream . ($ SVL.chunkSize 100000) =<< - Render.run (fmap Stereo.multiValue sig) + Render.run (fmap Stereo.niceValue sig) playStereoStream :: SVL.Vector (Stereo.T Float) -> IO () playStereoStream = playStreamSox -playMono :: Gen.MV Float -> IO () +playMono :: Gen.Nice Float -> IO () playMono sig = playMonoStream . ($ SVL.chunkSize 100000) =<< Render.run sig -playMonoPacked :: Gen.T (MultiValue.T (Serial.T D4 Float)) -> IO () +playMonoPacked :: Gen.T (NiceValue.T (Serial.T D4 Float)) -> IO () playMonoPacked = playMonoStream . SigStL.unpack . @@ -109,7 +109,7 @@ {- play :: (C.MakeValueTuple y, Tuple.ValueOf y ~ a, Memory.C a struct) => - Gen.MV a -> IO () + Gen.Nice a -> IO () play = playStreamSox . Gen.renderChunky (SVL.chunkSize 100000) @@ -198,7 +198,7 @@ playMonoStream $ SVL.concat $ map (SVL.take (intSecond 0.2) . png) $ zip (map sin $ [0,0.1..]) (cycle $ map hertz [440, 550, 660, 880]) -retard :: Gen.MV Float -> Gen.MV Float +retard :: Gen.Nice Float -> Gen.Nice Float retard xs = Causal.frequencyModulationLinear xs . Causal.map Field.recip $* @@ -212,7 +212,7 @@ -pingGen :: Gen.MV Float +pingGen :: Gen.Nice Float pingGen = Gen.exponential2 (second 0.5) 0.7 * Gen.osci Wave.triangle 0 (hertz 440) @@ -236,7 +236,7 @@ pingGen) -lfoSine :: Exp Float -> Gen.T (Moog.Parameter D8 (MultiValue.T Float)) +lfoSine :: Exp Float -> Gen.T (Moog.Parameter D8 (NiceValue.T Float)) lfoSine reduct = Causal.map (Moog.parameter d8 30 . (hertz 700 *) . (2**)) $* diff --git a/example/Synthesizer/LLVM/LNdW2011.hs b/example/Synthesizer/LLVM/LNdW2011.hs --- a/example/Synthesizer/LLVM/LNdW2011.hs +++ b/example/Synthesizer/LLVM/LNdW2011.hs @@ -19,7 +19,7 @@ import qualified Synthesizer.MIDI.EventList as Ev import qualified Synthesizer.MIDI.CausalIO.ControllerSelection as MCS import qualified Synthesizer.MIDI.CausalIO.Process as PMIDI -import qualified Synthesizer.MIDI.Value as MV +import qualified Synthesizer.MIDI.Value as Nice import qualified Synthesizer.ALSA.CausalIO.Process as PALSA import qualified Synthesizer.CausalIO.Process as PIO import qualified Synthesizer.Zip as Zip @@ -46,7 +46,7 @@ import qualified LLVM.DSL.Expression as Expr import LLVM.DSL.Expression (Exp) -import qualified LLVM.Extra.Multi.Value as MultiValue +import qualified LLVM.Extra.Nice.Value as NiceValue import qualified LLVM.Extra.ScalarOrVector as SoV import qualified LLVM.Extra.Memory as Memory import qualified LLVM.Extra.Arithmetic as A @@ -116,15 +116,15 @@ import qualified NumericPrelude.Base as P -playStereo :: Gen.T (Stereo.T (MultiValue.T Float)) -> IO () +playStereo :: Gen.T (Stereo.T (NiceValue.T Float)) -> IO () playStereo sig = playStereoStream . ($ SVL.chunkSize 100000) =<< - SigRender.run (fmap Stereo.multiValue sig) + SigRender.run (fmap Stereo.niceValue sig) playStereoStream :: SVL.Vector (Stereo.T Float) -> IO () playStereoStream = playStreamSox -playMono :: Gen.MV Float -> IO () +playMono :: Gen.Nice Float -> IO () playMono sig = playMonoStream . ($ SVL.chunkSize 100000) =<< SigRender.run sig @@ -158,7 +158,7 @@ type Vector = Serial.T VectorSize Float type VectorSize = TypeNum.D4 -type VectorValue = MultiValue.T Vector +type VectorValue = NiceValue.T Vector vectorSize :: Int vectorSize = @@ -368,8 +368,8 @@ Causal.map (Spatial.moveAround att sonicDelay ear) moveAround2d :: - (ve ~ Exp v, vl ~ MultiValue.T v, - MultiValue.Algebraic v, MultiValue.RationalConstant v) => + (ve ~ Exp v, vl ~ NiceValue.T v, + NiceValue.Algebraic v, NiceValue.RationalConstant v) => ve -> ve -> (ve, ve) -> Causal.T (vl, vl) (vl, vl) moveAround2d att sonicDelay ear = Causal.map $ @@ -377,12 +377,12 @@ euclideanNorm2d . subtract ear euclideanNorm2d :: - (MultiValue.Algebraic a) => + (NiceValue.Algebraic a) => (Exp a, Exp a) -> Exp a euclideanNorm2d (x,y) = Expr.sqrt $ Expr.sqr x + Expr.sqr y flyChannel :: - (ae ~ Exp Float, al ~ MultiValue.T Float) => + (ae ~ Exp Float, al ~ NiceValue.T Float) => (ae, ae) -> Causal.T (al, (al, al)) al flyChannel ear = ((snd ^>> moveAround2d 1 0.1 ear >>> Arr.first (negate id)) @@ -400,7 +400,7 @@ fly :: IO () fly = do - let slow, fast :: Causal.T (MultiValue.T Float) (MultiValue.T Float) + let slow, fast :: Causal.T (NiceValue.T Float) (NiceValue.T Float) slow = Filt1.lowpassCausal $< Gen.constant (Filt1Core.parameter (1/sampleRate :: Exp Float)) @@ -431,7 +431,7 @@ >>> Causal.envelopeStereo >>^ - Stereo.multiValue) + Stereo.niceValue) POut.storableVector playFromEvents 0.01 (0.015::Double) ((proc :: PIO.T (PCS.T Int Float) (SV.Vector (Stereo.T Float))) @@ -501,7 +501,7 @@ >>> Causal.envelopeStereo >>^ - Stereo.multiValueSerial) + Stereo.niceValueSerial) POut.storableVector playFromEvents 0.01 (vectorBlockSize/sampleRate) (arr SigStL.unpackStrict diff --git a/example/Synthesizer/LLVM/Test.hs b/example/Synthesizer/LLVM/Test.hs --- a/example/Synthesizer/LLVM/Test.hs +++ b/example/Synthesizer/LLVM/Test.hs @@ -3,6 +3,7 @@ {-# LANGUAGE FlexibleContexts #-} module Main where +import Synthesizer.LLVM.Experiment () import Synthesizer.LLVM.LAC2011 () import Synthesizer.LLVM.ExampleUtility @@ -46,10 +47,10 @@ import qualified LLVM.DSL.Expression as Expr import LLVM.DSL.Expression (Exp, (>*), (&&*)) -import qualified LLVM.Extra.Multi.Value.Marshal as Marshal -import qualified LLVM.Extra.Multi.Vector.Instance as MultiVectorI -import qualified LLVM.Extra.Multi.Vector as MultiVector -import qualified LLVM.Extra.Multi.Value as MultiValue +import qualified LLVM.Extra.Nice.Value.Marshal as Marshal +import qualified LLVM.Extra.Nice.Vector.Instance as NiceVectorI +import qualified LLVM.Extra.Nice.Vector as NiceVector +import qualified LLVM.Extra.Nice.Value as NiceValue import qualified LLVM.Extra.Arithmetic as A import qualified LLVM.Extra.Tuple as Tuple import qualified LLVM.Extra.Maybe as Maybe @@ -123,16 +124,16 @@ {- | > playStereo (Sig.amplifyStereo 0.3 $ stereoOsciSaw 0.01) -} -playStereo :: Sig.T (Stereo.T (MultiValue.T Float)) -> IO () +playStereo :: Sig.T (Stereo.T (NiceValue.T Float)) -> IO () playStereo sig = playStereoVector . ($ SVL.chunkSize 100000) =<< - Render.run (Stereo.multiValue <$> sig) + Render.run (Stereo.niceValue <$> sig) playStereoVector :: SVL.Vector (Stereo.T Float) -> IO () playStereoVector = void . SoxPlay.simple SVL.hPut SoxOption.none 44100 -playMono :: Sig.MV Float -> IO () +playMono :: Sig.Nice Float -> IO () playMono sig = playMonoVector . ($ SVL.chunkSize 100000) =<< Render.run sig playMonoVector :: SVL.Vector Float -> IO () @@ -226,7 +227,7 @@ rationalSineStereo = (SV.writeFile "speedtest.f32" . asStereoPacked =<<) $ fmap ($ div 10000000 4) $ Render.run $ - fmap Stereo.multiValueSerial $ + fmap Stereo.niceValueSerial $ liftA2 Stereo.cons (CausalPS.shapeModOsci Wave.rationalApproxSine1 $< (0.001 + SigPS.rampInf 10000000) @@ -238,13 +239,13 @@ $* SigPS.constant 0.01001) -pingSig :: Float -> Sig.MV Float +pingSig :: Float -> Sig.Nice Float pingSig freq = Sig.exponential2 50000 1 * Sig.osci Wave.saw 0.5 (Expr.cons freq) -pingSigP :: Exp Float -> Sig.MV Float +pingSigP :: Exp Float -> Sig.Nice Float pingSigP freq = Sig.exponential2 50000 1 * @@ -290,7 +291,7 @@ $< fmap Filt1Core.Parameter (1 - Sig.exponential2 (50000/4) 1) $* SigPS.osci Wave.triangle 0 0.01) -stereoOsciSaw :: Exp Float -> Sig.T (Stereo.T (MultiValue.T Float)) +stereoOsciSaw :: Exp Float -> Sig.T (Stereo.T (NiceValue.T Float)) stereoOsciSaw freq = liftA2 Stereo.cons (Sig.osci Wave.saw 0.0 (freq*1.001) + @@ -300,9 +301,9 @@ Sig.osci Wave.saw 0.7 (freq*0.997) + Sig.osci Wave.saw 0.5 (freq*0.999)) -stereoOsciSawPacked :: Float -> Sig.T (Stereo.T (MultiValue.T Float)) +stereoOsciSawPacked :: Float -> Sig.T (Stereo.T (NiceValue.T Float)) stereoOsciSawPacked freq = - let mix4 = Expr.liftM $ MultiVector.sum . MultiVectorI.fromMultiValue + let mix4 = Expr.liftM $ NiceVector.sum . NiceVectorI.fromNiceValue in liftA2 Stereo.cons ((Causal.map mix4 $*) $ Sig.osci Wave.saw @@ -327,21 +328,21 @@ in go xs mixVectorToStereo :: - (TypeNum.Positive n, MultiVector.Additive a) => - MultiVector.T n a -> LLVM.CodeGenFunction r (Stereo.T (MultiValue.T a)) + (TypeNum.Positive n, NiceVector.Additive a) => + NiceVector.T n a -> LLVM.CodeGenFunction r (Stereo.T (NiceValue.T a)) mixVectorToStereo = NonEmpty.foldBalanced (\x y -> join $ liftA2 A.add x y) . - fmap sequenceA . stereoDeinterleave . MultiVector.dissectList1 + fmap sequenceA . stereoDeinterleave . NiceVector.dissectList1 mixVec :: - (TypeNum.Positive n, MultiVector.Additive a) => + (TypeNum.Positive n, NiceVector.Additive a) => Exp (LLVM.Vector n a) -> Stereo.T (Exp a) mixVec = Stereo.unExpression . Expr.liftM - (fmap Stereo.multiValue . mixVectorToStereo . MultiVectorI.fromMultiValue) + (fmap Stereo.niceValue . mixVectorToStereo . NiceVectorI.fromNiceValue) -stereoOsciSawPacked2 :: Float -> Sig.T (Stereo.T (MultiValue.T Float)) +stereoOsciSawPacked2 :: Float -> Sig.T (Stereo.T (NiceValue.T Float)) stereoOsciSawPacked2 freq = (Causal.map mixVec $*) $ Sig.osci (Wave.trapezoidSlope (A.fromRational' 5)) @@ -353,7 +354,7 @@ stereo = SV.writeFile "speedtest.f32" . asStereo . ($ 10000000) =<< Render.run - (Stereo.multiValue <$> Causal.amplifyStereo 0.25 + (Stereo.niceValue <$> Causal.amplifyStereo 0.25 $* stereoOsciSawPacked2 0.01) lazy :: IO () @@ -370,7 +371,7 @@ (SVL.writeFile "speedtest.f32" . asStereo . SVL.take 10000000 =<<) $ fmap ($ SVL.chunkSize 100000) $ Render.run - (Stereo.multiValue <$> Causal.amplifyStereo 0.25 + (Stereo.niceValue <$> Causal.amplifyStereo 0.25 $* stereoOsciSawPacked 0.01) packTake :: IO () @@ -379,7 +380,7 @@ (Render.run . SigPS.packRotate) (Causal.take 5 $* Sig.osci Wave.saw 0 (frequency 0.01)) -chord :: Float -> Sig.T (Stereo.T (MultiValue.T Float)) +chord :: Float -> Sig.T (Stereo.T (NiceValue.T Float)) chord base = {- This exceeds available vector registers @@ -398,7 +399,7 @@ lazyChord = (SVL.writeFile "speedtest.f32" . asStereo . SVL.take 10000000 =<<) $ fmap ($ SVL.chunkSize 100000) $ - Render.run (Stereo.multiValue <$> Causal.amplifyStereo 0.1 $* chord 0.005) + Render.run (Stereo.niceValue <$> Causal.amplifyStereo 0.1 $* chord 0.005) filterSweepComplex :: IO () filterSweepComplex = @@ -409,7 +410,7 @@ $* chord 0.005) lfoSineCausal :: - Causal.T (MultiValue.T Float) a -> Exp Float -> Sig.T a + Causal.T (NiceValue.T Float) a -> Exp Float -> Sig.T a lfoSineCausal f reduct = f . Causal.map (\x -> 0.01 * exp (2*x)) $* Sig.osci Wave.sine 0 (reduct * 0.1/44100) @@ -498,8 +499,8 @@ filterSweepControlRateCausal :: Causal.T - (Stereo.T (MultiValue.T Float)) - (Stereo.T (MultiValue.T Float)) + (Stereo.T (NiceValue.T Float)) + (Stereo.T (NiceValue.T Float)) filterSweepControlRateCausal = Causal.amplifyStereo 0.3 <<< BandPass.causal $< (let reduct = 128 :: Exp Float @@ -519,15 +520,15 @@ (SVL.writeFile "speedtest.f32" . asStereo . SVL.take 10000000 =<<) $ fmap ($ SVL.chunkSize 100000) $ Render.run - (Stereo.multiValue <$> filterSweepControlRateCausal $* chord 0.005) + (Stereo.niceValue <$> filterSweepControlRateCausal $* chord 0.005) filterSweepMusic :: IO () filterSweepMusic = do proc <- Render.run $ \music -> - Stereo.multiValue ^<< Causal.amplifyStereo 20 . - filterSweepControlRateCausal <<^ Stereo.unMultiValue $* music + Stereo.niceValue ^<< Causal.amplifyStereo 20 . + filterSweepControlRateCausal <<^ Stereo.unNiceValue $* music music <- SV.readFile "lichter.f32" SVL.writeFile "speedtest.f32" . asStereo =<< proc (SVL.chunkSize 100000) music @@ -537,8 +538,8 @@ playFilterSweepMusicLazy = do proc <- Render.run $ \vol music -> - Stereo.multiValue ^<< Causal.amplifyStereo vol . - filterSweepControlRateCausal <<^ Stereo.unMultiValue $* music + Stereo.niceValue ^<< Causal.amplifyStereo vol . + filterSweepControlRateCausal <<^ Stereo.unNiceValue $* music IO.withFile "lichter.f32" IO.ReadMode $ \h -> playStereoVector . proc (SVL.chunkSize 100000) (20::Float) {-1.125-} . snd =<< SVL.hGetContentsAsync (SVL.chunkSize 4321) h @@ -547,8 +548,8 @@ playFilterSweepMusicCausal = do proc <- CausalRender.run $ - Stereo.multiValue ^<< Causal.amplifyStereo 20 . - filterSweepControlRateCausal <<^ Stereo.unMultiValue + Stereo.niceValue ^<< Causal.amplifyStereo 20 . + filterSweepControlRateCausal <<^ Stereo.unNiceValue music <- SV.readFile "lichter.f32" void $ SoxPlay.simple SV.hPut SoxOption.none 44100 =<< pioApplyStrict proc music @@ -557,8 +558,8 @@ playFilterSweepMusicCausalLazy = do proc <- CausalRender.run $ - Stereo.multiValue ^<< Causal.amplifyStereo 20 . - filterSweepControlRateCausal <<^ Stereo.unMultiValue + Stereo.niceValue ^<< Causal.amplifyStereo 20 . + filterSweepControlRateCausal <<^ Stereo.unNiceValue IO.withFile "lichter.f32" IO.ReadMode $ \h -> playStereoVector =<< pioApply proc . snd =<< SVL.hGetContentsAsync (SVL.chunkSize 43210) h @@ -984,7 +985,7 @@ iterate (0.999*) 0.01)) -vibes :: (Exp Float, Exp Float) -> Sig.MV Float +vibes :: (Exp Float, Exp Float) -> Sig.Nice Float vibes (modDepth, freq) = let halfLife = 5000 -- sine = Wave.sine @@ -1062,7 +1063,7 @@ proc <- CausalRender.run (\params -> - Stereo.multiValue + Stereo.niceValue ^<< Causal.amplifyStereo 0.3 <<< @@ -1095,7 +1096,7 @@ filterBass = do proc <- Render.run $ \xs -> - (fmap Stereo.multiValue BandPass.causal + (fmap Stereo.niceValue BandPass.causal <<< CausalClass.feedSnd (liftA2 Stereo.cons @@ -1145,7 +1146,7 @@ =<< ((\(x:xs) -> Fold.foldlM (pioApply . mix) x xs) $ take numTones $ map (pingp 1000000) $ iterate (*(2/3)) 0.01) -fadeEnvelope :: Exp Word -> Exp Word -> Sig.MV Float +fadeEnvelope :: Exp Word -> Exp Word -> Sig.Nice Float fadeEnvelope intro len = Sig.parabolaFadeIn intro <> @@ -1169,7 +1170,7 @@ stereoOsciParams :: (TypeNum.Integer n) => - Proxy n -> Float -> (Float, Stereo.T (MultiValue.Array n (Float,Float))) + Proxy n -> Float -> (Float, Stereo.T (NiceValue.Array n (Float,Float))) stereoOsciParams np freq = let n = TypeNum.integralFromProxy np volume :: Float @@ -1181,7 +1182,7 @@ phases :: [Float] phases = randomRs (0,1) $ mkStdGen 54 in (,) volume $ - fmap MultiValue.Array $ + fmap NiceValue.Array $ uncurry Stereo.cons $ splitAt n $ zipWith (\phase detune -> (phase, detune*freq)) @@ -1191,10 +1192,10 @@ (TypeNum.Natural n) => (TypeNum.Natural arrSize, arrSize ~ (n :*: LLVM.UnknownSize)) => (TypeNum.Natural stereoSize, stereoSize ~ (D2 :*: arrSize)) => - Exp Float -> Stereo.T (Exp (MultiValue.Array n (Float,Float))) -> - Sig.MV (Stereo.T Float) + Exp Float -> Stereo.T (Exp (NiceValue.Array n (Float,Float))) -> + Sig.Nice (Stereo.T Float) stereoOsciSawP volume = - fmap Stereo.multiValue + fmap Stereo.niceValue . stereoFromMonoParametricSignal (\params -> @@ -1210,8 +1211,8 @@ (Marshal.C x) => (D2 :*: LLVM.SizeOf (Marshal.Struct x) ~ arrSize, TypeNum.Natural arrSize) => - (Exp x -> Sig.MV Float) -> - Stereo.T (Exp x) -> Sig.T (Stereo.T (MultiValue.T Float)) + (Exp x -> Sig.Nice Float) -> + Stereo.T (Exp x) -> Sig.T (Stereo.T (NiceValue.T Float)) stereoFromMonoParametricSignal f ps = Causal.toSignal $ Causal.stereoFromMonoParametric (Causal.fromSignal . f) ps @@ -1224,7 +1225,7 @@ TypeNum.Natural arraySize, Tuple.Undefined a, Tuple.Phi a, A.Additive a) => (Exp x -> Sig.T a) -> - Exp (MultiValue.Array n x) -> Sig.T a + Exp (NiceValue.Array n x) -> Sig.T a multiMixSignal f = Causal.toSignal . multiMix (Causal.fromSignal . f) @@ -1234,7 +1235,7 @@ TypeNum.Natural arraySize, Tuple.Undefined b, Tuple.Phi b, A.Additive b) => (Exp x -> Causal.T a b) -> - Exp (MultiValue.Array n x) -> Causal.T a b + Exp (NiceValue.Array n x) -> Causal.T a b multiMix f ps = Causal.replicateControlledParam (\x -> Causal.mix <<< first (f x)) ps <<^ @@ -1261,9 +1262,9 @@ pioApply (f attack (dur-attack)) (stereoOsciSawChord pitches)) $ CausalRender.run (\intro len -> - Stereo.multiValue <$> + Stereo.niceValue <$> (Causal.envelopeStereo $< fadeEnvelope intro len) - <<^ Stereo.unMultiValue) + <<^ Stereo.unNiceValue) a0, as0, b0, c1, cs1, d1, ds1, e1, f1, fs1, g1, gs1, a1, as1, b1, c2, cs2, d2, ds2, e2, f2, fs2, g2, gs2, @@ -1311,9 +1312,9 @@ arrange <- SigStL.makeArranger amplify <- CausalRender.run $ \volume -> - Stereo.multiValue ^<< + Stereo.niceValue ^<< Causal.amplifyStereo volume <<^ - Stereo.unMultiValue + Stereo.unNiceValue (playStereoVector =<<) $ pioApply (amplify (0.1::Float)) $ arrange tonesChunkSize $ @@ -1326,8 +1327,8 @@ lowpassSweepControlRateCausal :: Causal.T - (Stereo.T (MultiValue.T Float)) - (Stereo.T (MultiValue.T Float)) + (Stereo.T (NiceValue.T Float)) + (Stereo.T (NiceValue.T Float)) lowpassSweepControlRateCausal = -- Causal.stereoFromVector $ Causal.stereoFromMono $ @@ -1338,8 +1339,8 @@ moogSweepControlRateCausal :: Causal.T - (Stereo.T (MultiValue.T Float)) - (Stereo.T (MultiValue.T Float)) + (Stereo.T (NiceValue.T Float)) + (Stereo.T (NiceValue.T Float)) moogSweepControlRateCausal = -- Causal.stereoFromVector $ Causal.stereoFromMono $ @@ -1353,10 +1354,10 @@ pad <- stereoOsciSawPadIO proc <- CausalRender.run $ \volume -> - Stereo.multiValue ^<< + Stereo.niceValue ^<< Causal.amplifyStereo volume <<< moogSweepControlRateCausal <<^ - Stereo.unMultiValue + Stereo.unNiceValue (playStereoVector =<<) $ pioApply (proc (0.05::Float)) $ arrange tonesChunkSize $ @@ -1383,9 +1384,9 @@ Unsafe.performIO $ pioApply (f attack (dur-attack)) sig) $ CausalRender.run (\intro len -> - Stereo.multiValue <$> + Stereo.niceValue <$> (Causal.envelopeStereo $< fadeEnvelope intro len) - <<^ Stereo.unMultiValue) + <<^ Stereo.unNiceValue) stereoOsciSawChordIO :: IO (NonEmpty.T [] Float -> SVL.Vector (Stereo.T Float)) stereoOsciSawChordIO = do @@ -1407,9 +1408,9 @@ pad <- stereoOsciSawPadIO amplify <- CausalRender.run $ \volume -> - Stereo.multiValue ^<< + Stereo.niceValue ^<< Causal.amplifyStereo volume <<^ - Stereo.unMultiValue + Stereo.unNiceValue (playStereoVector =<<) $ pioApply (amplify (0.08::Float)) $ arrange tonesChunkSize $ @@ -1430,9 +1431,9 @@ env <- applyFadeEnvelopeIO amplify <- CausalRender.run $ \volume -> - Stereo.multiValue ^<< + Stereo.niceValue ^<< Causal.amplifyStereo volume <<^ - Stereo.unMultiValue + Stereo.unNiceValue (playStereoVector =<<) $ pioApply (amplify (0.08::Float)) $ arrange tonesChunkSize $ @@ -1459,7 +1460,7 @@ (SVL.writeFile "speedtest.f32" . asStereo =<<) $ fmap (\f -> f tonesChunkSize (7::Word) (10000::Word)) $ Render.run $ \del dur -> - Causal.take dur . liftA2 Stereo.consMultiValue id (Causal.delayZero del) + Causal.take dur . liftA2 Stereo.consNiceValue id (Causal.delayZero del) $* Sig.osci Wave.saw 0 (frequency 0.01) @@ -1474,7 +1475,7 @@ Func.fromSignal $ Sig.osci Wave.triangle 0 $ frequency (1/20000) in Causal.take dur $& - liftA2 Stereo.consMultiValue + liftA2 Stereo.consNiceValue osci (Causal.delayControlledInterpolated Interpolation.cubic 0 100 $& @@ -1485,15 +1486,15 @@ allpassControl :: (TypeNum.Natural n) => Proxy n -> Exp Float -> - Sig.T (Allpass.CascadeParameter n (MultiValue.T Float)) + Sig.T (Allpass.CascadeParameter n (NiceValue.T Float)) allpassControl order reduct = Sig.interpolateConstant reduct $ lfoSine (Allpass.flangerParameter order) reduct allpassPhaserCausal, allpassPhaserPipeline :: Exp Float -> - Sig.MV Float -> - Sig.MV Float + Sig.Nice Float -> + Sig.Nice Float allpassPhaserCausal reduct xs = let order = TypeNum.d16 in 0.5 * Allpass.phaser $< allpassControl order reduct $* xs @@ -1555,7 +1556,7 @@ sample <- Render.run $ Sig.osci Wave.saw 0 (frequency 0.01) f <- Render.run $ \smp -> - Stereo.multiValue ^<< + Stereo.niceValue ^<< Causal.stereoFromMono (Causal.frequencyModulationLinear smp) $* Sig.constant (Stereo.cons 0.2999 0.3001) SVL.writeFile "speedtest.f32" . asStereo $ @@ -1611,7 +1612,7 @@ fmap ($ SVL.chunkSize 100000) $ Render.run (let osci = Causal.osci Wave.approxSine2 - in liftA2 Stereo.consMultiValue osci osci $* Sig.constant (0, 0.01)) + in liftA2 Stereo.consNiceValue osci osci $* Sig.constant (0, 0.01)) arrowShared :: IO () arrowShared = @@ -1620,7 +1621,7 @@ fmap ($ SVL.chunkSize 100000) $ Render.run (let osci = Func.lift $ Causal.osci Wave.approxSine2 - in Func.compile (liftA2 Stereo.consMultiValue osci osci) $* + in Func.compile (liftA2 Stereo.consNiceValue osci osci) $* Sig.constant (0, 0.01)) arrowIndependent :: IO () @@ -1631,7 +1632,7 @@ Render.run (let osci = Causal.osci Wave.approxSine2 in Func.compile - (uncurry Stereo.consMultiValue <$> + (uncurry Stereo.consNiceValue <$> (osci *** osci $& Func.lift id)) $* Sig.constant ((0, 0.01), (0.25, 0.01001))) @@ -1692,15 +1693,15 @@ word <- Sample.load (Default.sampleDirectory name) return (Sample.period $ head positions, word) -helixOsci :: Exp Float -> Func.T a (MultiValue.T Float) +helixOsci :: Exp Float -> Func.T a (NiceValue.T Float) helixOsci period = Causal.osciCore $& 0 &|& Func.fromSignal (Sig.constant (recip period)) helixSpeechStaticSig :: - Func.T () (MultiValue.T Float) -> + Func.T () (NiceValue.T Float) -> Exp (Source.StorableVector Float) -> Exp Float -> - Sig.MV Float + Sig.Nice Float helixSpeechStaticSig shape word period = Func.compileSignal (Helix.static Interpolation.linear Interpolation.linear @@ -1714,7 +1715,7 @@ Exp Float -> Exp (Source.StorableVector Float) -> Exp Float -> - Sig.MV Float + Sig.Nice Float helixSpeechStaticSpeed speed word = helixSpeechStaticSig (Func.fromSignal @@ -1735,10 +1736,10 @@ mapSnd (Render.buffer . SV.concat . SVL.chunks) smp helixSpeechDynamicSig :: - Func.T () (MultiValue.T Float) -> - Sig.MV Float -> + Func.T () (NiceValue.T Float) -> + Sig.Nice Float -> Exp Float -> - Sig.MV Float + Sig.Nice Float helixSpeechDynamicSig shape word period = Func.compileSignal (Helix.dynamicLimited Interpolation.linear Interpolation.linear @@ -1750,9 +1751,9 @@ helixSpeechDynamicSpeed :: Exp Float -> - Sig.MV Float -> + Sig.Nice Float -> Exp Float -> - Sig.MV Float + Sig.Nice Float helixSpeechDynamicSpeed speed = helixSpeechDynamicSig (Func.fromSignal $ Sig.constant speed) @@ -1770,7 +1771,7 @@ (per,smp) <- loadTomato stretched <- Render.run $ \speed period word wordBuffer -> - fmap Stereo.multiValue $ + fmap Stereo.niceValue $ sequenceA $ Stereo.cons (helixSpeechStaticSpeed speed wordBuffer period) @@ -1784,13 +1785,13 @@ (per,smp) <- loadTomato stretched <- Render.run $ \period word wordBuffer -> - fmap Stereo.multiValue $ + fmap Stereo.niceValue $ sequenceA $ let speed = Func.fromSignal $ Sig.cycle $ Sig.fromArray $ Expr.cons $ - (MultiValue.Array [0.2, 0.5, 1, 1.5, 1.8] - :: MultiValue.Array TypeNum.D5 Float) + (NiceValue.Array [0.2, 0.5, 1, 1.5, 1.8] + :: NiceValue.Array TypeNum.D5 Float) in Stereo.cons (helixSpeechStaticSig (Causal.integrateZero $& speed) @@ -1833,7 +1834,7 @@ &|& helixOsci period stretched osciBuffer = - liftA2 Stereo.consMultiValue + liftA2 Stereo.consNiceValue (stretchedStatic osciBuffer) stretchedDynamic renderHelix <- Render.run $ Func.compileSignal . stretched SV.writeFile "helix-stretched.f32" $ asStereo $ @@ -1873,10 +1874,10 @@ Render.run (let pause len = CausalClass.applyConst (Causal.take len) Maybe.nothing - pulse :: Float -> Exp Word -> Sig.T (Maybe.T (MultiValue.T Float)) + pulse :: Float -> Exp Word -> Sig.T (Maybe.T (NiceValue.T Float)) pulse freq len = Causal.take len . - arr (flip Maybe.fromBool (MultiValue.cons freq) . unbool) . + arr (flip Maybe.fromBool (NiceValue.cons freq) . unbool) . Causal.delay1 Expr.true $*# False in (Causal.zipWith ExprMaybe.select $> Sig.noise 0 (0.01 :: Exp Float)) $* @@ -1887,23 +1888,23 @@ pulse 0.006 400000)) -- FixMe: duplicate of CausalExp.ProcessPrivate -unbool :: MultiValue.T Bool -> LLVM.Value Bool -unbool (MultiValue.Cons b) = b +unbool :: NiceValue.T Bool -> LLVM.Value Bool +unbool (NiceValue.Cons b) = b -triggerLFO :: Sig.MV Float +triggerLFO :: Sig.Nice Float triggerLFO = Sig.osci Wave.approxSine2 0 0.00015 + Sig.osci Wave.approxSine2 0 0.000037 -trackZeros :: Causal.MV Float Bool +trackZeros :: Causal.Nice Float Bool trackZeros = Causal.zipWith (\x y -> x &&* Expr.not y) . (id &&& Causal.delay1 Expr.false) . Causal.map (>* 0) -fmPingSig :: Exp Float -> Exp Float -> Sig.MV Float +fmPingSig :: Exp Float -> Exp Float -> Sig.Nice Float fmPingSig freq depth = Sig.exponential2 5000 1 * diff --git a/server/Synthesizer/LLVM/Server/CausalPacked/Arrange.hs b/server/Synthesizer/LLVM/Server/CausalPacked/Arrange.hs --- a/server/Synthesizer/LLVM/Server/CausalPacked/Arrange.hs +++ b/server/Synthesizer/LLVM/Server/CausalPacked/Arrange.hs @@ -126,7 +126,7 @@ arrange <- CausalSt.makeArranger amp <- CausalRender.run - (emitStereo <<< CausalPS.amplifyStereo 0.2 <<^ Stereo.unMultiValue) + (emitStereo <<< CausalPS.amplifyStereo 0.2 <<^ Stereo.unNiceValue) ping <- Instr.pingStereoReleaseFM @@ -213,7 +213,7 @@ CausalRender.run (emitStereo <<< Causal.envelopeStereo <<< - Causal.map Serial.upsample *** arr Stereo.unMultiValue) + Causal.map Serial.upsample *** arr Stereo.unNiceValue) return $ \chan initPgm rate -> amp <<< @@ -493,9 +493,9 @@ IO (ChannelMsg.Channel -> VoiceMsg.Program -> SampleRate Real -> PIO.T (MIO.Events msg) b) voder emitStereo voice smpDir = do - carrier <- keyboardDetuneFMCore (arr Stereo.multiValue) smpDir + carrier <- keyboardDetuneFMCore (arr Stereo.niceValue) smpDir arrange <- CausalSt.makeArranger - interleave <- CausalRender.run (emitStereo <<^ Stereo.unMultiValue) + interleave <- CausalRender.run (emitStereo <<^ Stereo.unNiceValue) return $ \chan initPgm sampleRate -> interleave @@ -552,7 +552,7 @@ CausalRender.run (emitStereo <<< Causal.envelopeStereo <<< - Causal.map Serial.upsample *** arr Stereo.unMultiValue) + Causal.map Serial.upsample *** arr Stereo.unNiceValue) return $ \chan initPgm sampleRate -> amp @@ -586,7 +586,7 @@ voderSeparated :: - (PathClass.AbsRel ar, Render.RunArg p, + (PathClass.AbsRel ar, Render.Argument p, Check.C msg, Construct.C msg, POut.Default b) => (Render.DSLArg p -> Causal.T (Stereo.T VectorValue) (POut.Element b)) -> Speech.VowelSynthEnv -> @@ -594,13 +594,13 @@ IO (ChannelMsg.Channel -> ChannelMsg.Channel -> VoiceMsg.Program -> SampleRate Real -> p -> PIO.T (MIO.Events msg) b) voderSeparated emitStereo voice smpDir = do - carrier <- keyboardDetuneFMCore (arr Stereo.multiValue) smpDir + carrier <- keyboardDetuneFMCore (arr Stereo.niceValue) smpDir arrange <- CausalSt.makeArranger amp <- CausalRender.run $ \p -> (emitStereo p <<< Causal.envelopeStereo <<< - Causal.map Serial.upsample *** arr Stereo.unMultiValue) + Causal.map Serial.upsample *** arr Stereo.unNiceValue) return $ \carrierChan phonemeChan initPgm sampleRate p -> amp p @@ -621,7 +621,7 @@ (carrier carrierChan initPgm sampleRate))) voderMaskSeparated :: - (PathClass.AbsRel ar, Render.RunArg p, + (PathClass.AbsRel ar, Render.Argument p, Check.C msg, Construct.C msg, POut.Default b) => (Render.DSLArg p -> Causal.T (Stereo.T VectorValue) (POut.Element b)) -> Path.Dir ar -> diff --git a/src/Synthesizer/LLVM/Causal/Controlled.hs b/src/Synthesizer/LLVM/Causal/Controlled.hs --- a/src/Synthesizer/LLVM/Causal/Controlled.hs +++ b/src/Synthesizer/LLVM/Causal/Controlled.hs @@ -36,9 +36,9 @@ import qualified LLVM.DSL.Expression as Expr import LLVM.DSL.Expression (Exp) -import qualified LLVM.Extra.Multi.Value.Marshal as Marshal -import qualified LLVM.Extra.Multi.Value as MultiValue -import qualified LLVM.Extra.Multi.Vector as MultiVector +import qualified LLVM.Extra.Nice.Value.Marshal as Marshal +import qualified LLVM.Extra.Nice.Value as NiceValue +import qualified LLVM.Extra.Nice.Vector as NiceVector import qualified LLVM.Extra.Memory as Memory import qualified LLVM.Extra.Arithmetic as A @@ -53,8 +53,8 @@ processCtrlRate :: (C parameter a b, Memory.C parameter) => - (Marshal.C r, MultiValue.IntegerConstant r, - MultiValue.Additive r, MultiValue.Comparison r) => + (Marshal.C r, NiceValue.IntegerConstant r, + NiceValue.Additive r, NiceValue.Comparison r) => Exp r -> (Exp r -> Sig.T parameter) -> Causal.T a b processCtrlRate reduct ctrlGen = process $< Sig.interpolateConstant reduct (ctrlGen reduct) @@ -93,17 +93,17 @@ process = Filt2.causal instance - (Marshal.C a, Marshal.Vector TypeNum.D4 a, MultiVector.PseudoRing a) => - C (Filt2P.Parameter a) (MultiValue.T a) (MultiValue.T a) where - type Input (Filt2P.Parameter a) (MultiValue.T a) = MultiValue.T a - type Output (Filt2P.Parameter a) (MultiValue.T a) = MultiValue.T a + (Marshal.C a, Marshal.Vector TypeNum.D4 a, NiceVector.PseudoRing a) => + C (Filt2P.Parameter a) (NiceValue.T a) (NiceValue.T a) where + type Input (Filt2P.Parameter a) (NiceValue.T a) = NiceValue.T a + type Output (Filt2P.Parameter a) (NiceValue.T a) = NiceValue.T a process = Filt2P.causal instance - (a ~ MultiValue.Scalar v, MultiValue.PseudoModule v, - Marshal.C a, MultiValue.IntegerConstant a, Marshal.C v, + (a ~ NiceValue.Scalar v, NiceValue.PseudoModule v, + Marshal.C a, NiceValue.IntegerConstant a, Marshal.C v, TypeNum.Natural n, TypeNum.Positive (n :*: LLVM.UnknownSize), - inp ~ MultiValue.T v, out ~ MultiValue.T v) => + inp ~ NiceValue.T v, out ~ NiceValue.T v) => C (Cascade.ParameterValue n a) inp out where type Input (Cascade.ParameterValue n a) out = out type Output (Cascade.ParameterValue n a) inp = inp @@ -152,9 +152,9 @@ process = ComplexFilt.causal instance - (Marshal.Vector n a, n ~ TypeNum.D3, MultiVector.PseudoRing a, - inp ~ MultiValue.T a, out ~ MultiValue.T a) => - C (ComplexFiltPack.ParameterMV a) (Stereo.T inp) (Stereo.T out) where - type Input (ComplexFiltPack.ParameterMV a) (Stereo.T out) = Stereo.T out - type Output (ComplexFiltPack.ParameterMV a) (Stereo.T inp) = Stereo.T inp + (Marshal.Vector n a, n ~ TypeNum.D3, NiceVector.PseudoRing a, + inp ~ NiceValue.T a, out ~ NiceValue.T a) => + C (ComplexFiltPack.ParameterNice a) (Stereo.T inp) (Stereo.T out) where + type Input (ComplexFiltPack.ParameterNice a) (Stereo.T out) = Stereo.T out + type Output (ComplexFiltPack.ParameterNice a) (Stereo.T inp) = Stereo.T inp process = ComplexFiltPack.causal diff --git a/src/Synthesizer/LLVM/Causal/ControlledPacked.hs b/src/Synthesizer/LLVM/Causal/ControlledPacked.hs --- a/src/Synthesizer/LLVM/Causal/ControlledPacked.hs +++ b/src/Synthesizer/LLVM/Causal/ControlledPacked.hs @@ -30,8 +30,8 @@ import qualified LLVM.DSL.Expression as Expr import LLVM.DSL.Expression (Exp) -import qualified LLVM.Extra.Multi.Value.Marshal as Marshal -import qualified LLVM.Extra.Multi.Value as MultiValue +import qualified LLVM.Extra.Nice.Value.Marshal as Marshal +import qualified LLVM.Extra.Nice.Value as NiceValue import qualified LLVM.Extra.Memory as Memory import qualified LLVM.Extra.Tuple as Tuple import qualified LLVM.Extra.Arithmetic as A @@ -52,8 +52,8 @@ (C parameter av bv, Memory.C parameter, Serial.Read av, n ~ Serial.Size av, Serial.Write bv, n ~ Serial.Size bv) => - (Marshal.C r, MultiValue.RationalConstant r, - MultiValue.Field r, MultiValue.Comparison r) => + (Marshal.C r, NiceValue.RationalConstant r, + NiceValue.Field r, NiceValue.Comparison r) => Exp r -> (Exp r -> Sig.T parameter) -> Causal.T av bv processCtrlRate reduct ctrlGen = Serial.withSize $ \n -> process $< @@ -97,9 +97,9 @@ process = Filt2.causalPacked instance - (Serial.Write v, Serial.Element v ~ MultiValue.T a, + (Serial.Write v, Serial.Element v ~ NiceValue.T a, Memory.C v, A.PseudoRing v, A.IntegerConstant v, - Marshal.C a, MultiValue.PseudoRing a, MultiValue.IntegerConstant a, + Marshal.C a, NiceValue.PseudoRing a, NiceValue.IntegerConstant a, TypeNum.Positive (n :*: LLVM.UnknownSize), TypeNum.Natural n) => C (Cascade.ParameterValue n a) v v where diff --git a/src/Synthesizer/LLVM/Causal/Exponential2.hs b/src/Synthesizer/LLVM/Causal/Exponential2.hs --- a/src/Synthesizer/LLVM/Causal/Exponential2.hs +++ b/src/Synthesizer/LLVM/Causal/Exponential2.hs @@ -11,16 +11,16 @@ Parameter, parameter, parameterPlain, - multiValueParameter, - unMultiValueParameter, + niceValueParameter, + unNiceValueParameter, causal, ParameterPacked, parameterPacked, parameterPackedExp, parameterPackedPlain, - multiValueParameterPacked, - unMultiValueParameterPacked, + niceValueParameterPacked, + unNiceValueParameterPacked, causalPacked, ) where @@ -36,9 +36,9 @@ import qualified LLVM.DSL.Expression as Expr import LLVM.DSL.Expression (Exp) -import qualified LLVM.Extra.Multi.Value.Marshal as MarshalMV -import qualified LLVM.Extra.Multi.Value as MultiValue -import qualified LLVM.Extra.Multi.Vector as MultiVector +import qualified LLVM.Extra.Nice.Value.Marshal as MarshalNice +import qualified LLVM.Extra.Nice.Value as NiceValue +import qualified LLVM.Extra.Nice.Vector as NiceVector import qualified LLVM.Extra.ScalarOrVector as SoV import qualified LLVM.Extra.Vector as Vector import qualified LLVM.Extra.Storable as Storable @@ -114,9 +114,9 @@ pack (Parameter k) = Marshal.pack k unpack = Parameter . Marshal.unpack -instance (MarshalMV.C a) => MarshalMV.C (Parameter a) where - pack (Parameter k) = MarshalMV.pack k - unpack = Parameter . MarshalMV.unpack +instance (MarshalNice.C a) => MarshalNice.C (Parameter a) where + pack (Parameter k) = MarshalNice.pack k + unpack = Parameter . MarshalNice.unpack instance (Storable.C a) => Storable.C (Parameter a) where load = Storable.loadNewtype Parameter Parameter @@ -126,26 +126,26 @@ type ValueOf (Parameter a) = Parameter (Tuple.ValueOf a) valueOf = Tuple.valueOfFunctor -instance (MultiValue.C a) => MultiValue.C (Parameter a) where - type Repr (Parameter a) = Parameter (MultiValue.Repr a) - cons = multiValueParameter . fmap MultiValue.cons - undef = multiValueParameter $ pure MultiValue.undef - zero = multiValueParameter $ pure MultiValue.zero +instance (NiceValue.C a) => NiceValue.C (Parameter a) where + type Repr (Parameter a) = Parameter (NiceValue.Repr a) + cons = niceValueParameter . fmap NiceValue.cons + undef = niceValueParameter $ pure NiceValue.undef + zero = niceValueParameter $ pure NiceValue.zero phi bb = - fmap multiValueParameter . - traverse (MultiValue.phi bb) . unMultiValueParameter + fmap niceValueParameter . + traverse (NiceValue.phi bb) . unNiceValueParameter addPhi bb a b = Fold.sequence_ $ - liftA2 (MultiValue.addPhi bb) - (unMultiValueParameter a) (unMultiValueParameter b) + liftA2 (NiceValue.addPhi bb) + (unNiceValueParameter a) (unNiceValueParameter b) -multiValueParameter :: - Parameter (MultiValue.T a) -> MultiValue.T (Parameter a) -multiValueParameter = MultiValue.Cons . fmap (\(MultiValue.Cons a) -> a) +niceValueParameter :: + Parameter (NiceValue.T a) -> NiceValue.T (Parameter a) +niceValueParameter = NiceValue.Cons . fmap (\(NiceValue.Cons a) -> a) -unMultiValueParameter :: - MultiValue.T (Parameter a) -> Parameter (MultiValue.T a) -unMultiValueParameter (MultiValue.Cons x) = fmap MultiValue.Cons x +unNiceValueParameter :: + NiceValue.T (Parameter a) -> Parameter (NiceValue.T a) +unNiceValueParameter (NiceValue.Cons x) = fmap NiceValue.Cons x instance (Value.Flatten a) => Value.Flatten (Parameter a) where @@ -165,10 +165,10 @@ instance - (Expr.Aggregate exp mv) => - Expr.Aggregate (Parameter exp) (Parameter mv) where - type MultiValuesOf (Parameter exp) = Parameter (Expr.MultiValuesOf exp) - type ExpressionsOf (Parameter mv) = Parameter (Expr.ExpressionsOf mv) + (Expr.Aggregate exp nv) => + Expr.Aggregate (Parameter exp) (Parameter nv) where + type NiceValuesOf (Parameter exp) = Parameter (Expr.NiceValuesOf exp) + type ExpressionsOf (Parameter nv) = Parameter (Expr.ExpressionsOf nv) bundle (Parameter p) = fmap Parameter $ Expr.bundle p dissect (Parameter p) = Parameter $ Expr.dissect p @@ -187,7 +187,7 @@ causal :: - (MarshalMV.C a, MultiValue.T a ~ am, MultiValue.PseudoRing a) => + (MarshalNice.C a, NiceValue.T a ~ am, NiceValue.PseudoRing a) => Exp a -> Causal.T (Parameter am) am causal initial = Causal.loop initial @@ -277,9 +277,9 @@ pack (ParameterPacked bend depth) = Marshal.pack (bend, depth) unpack = uncurry ParameterPacked . Marshal.unpack -instance (MarshalMV.C a) => MarshalMV.C (ParameterPacked a) where - pack (ParameterPacked bend depth) = MarshalMV.pack (bend, depth) - unpack = uncurry ParameterPacked . MarshalMV.unpack +instance (MarshalNice.C a) => MarshalNice.C (ParameterPacked a) where + pack (ParameterPacked bend depth) = MarshalNice.pack (bend, depth) + unpack = uncurry ParameterPacked . MarshalNice.unpack instance (Storable.C a) => Storable.C (ParameterPacked a) where load = Storable.loadApplicative @@ -290,26 +290,26 @@ type ValueOf (ParameterPacked a) = ParameterPacked (Tuple.ValueOf a) valueOf = Tuple.valueOfFunctor -instance (MultiValue.C a) => MultiValue.C (ParameterPacked a) where - type Repr (ParameterPacked a) = ParameterPacked (MultiValue.Repr a) - cons = multiValueParameterPacked . fmap MultiValue.cons - undef = multiValueParameterPacked $ pure MultiValue.undef - zero = multiValueParameterPacked $ pure MultiValue.zero +instance (NiceValue.C a) => NiceValue.C (ParameterPacked a) where + type Repr (ParameterPacked a) = ParameterPacked (NiceValue.Repr a) + cons = niceValueParameterPacked . fmap NiceValue.cons + undef = niceValueParameterPacked $ pure NiceValue.undef + zero = niceValueParameterPacked $ pure NiceValue.zero phi bb = - fmap multiValueParameterPacked . - traverse (MultiValue.phi bb) . unMultiValueParameterPacked + fmap niceValueParameterPacked . + traverse (NiceValue.phi bb) . unNiceValueParameterPacked addPhi bb a b = Fold.sequence_ $ - liftA2 (MultiValue.addPhi bb) - (unMultiValueParameterPacked a) (unMultiValueParameterPacked b) + liftA2 (NiceValue.addPhi bb) + (unNiceValueParameterPacked a) (unNiceValueParameterPacked b) -multiValueParameterPacked :: - ParameterPacked (MultiValue.T a) -> MultiValue.T (ParameterPacked a) -multiValueParameterPacked = MultiValue.Cons . fmap (\(MultiValue.Cons a) -> a) +niceValueParameterPacked :: + ParameterPacked (NiceValue.T a) -> NiceValue.T (ParameterPacked a) +niceValueParameterPacked = NiceValue.Cons . fmap (\(NiceValue.Cons a) -> a) -unMultiValueParameterPacked :: - MultiValue.T (ParameterPacked a) -> ParameterPacked (MultiValue.T a) -unMultiValueParameterPacked (MultiValue.Cons x) = fmap MultiValue.Cons x +unNiceValueParameterPacked :: + NiceValue.T (ParameterPacked a) -> ParameterPacked (NiceValue.T a) +unNiceValueParameterPacked (NiceValue.Cons x) = fmap NiceValue.Cons x instance (Value.Flatten a) => Value.Flatten (ParameterPacked a) where @@ -318,12 +318,12 @@ unfoldCode = Value.unfoldCodeTraversable instance - (Expr.Aggregate exp mv) => - Expr.Aggregate (ParameterPacked exp) (ParameterPacked mv) where - type MultiValuesOf (ParameterPacked exp) = - ParameterPacked (Expr.MultiValuesOf exp) - type ExpressionsOf (ParameterPacked mv) = - ParameterPacked (Expr.ExpressionsOf mv) + (Expr.Aggregate exp nv) => + Expr.Aggregate (ParameterPacked exp) (ParameterPacked nv) where + type NiceValuesOf (ParameterPacked exp) = + ParameterPacked (Expr.NiceValuesOf exp) + type ExpressionsOf (ParameterPacked nv) = + ParameterPacked (Expr.ExpressionsOf nv) bundle p = liftA2 ParameterPacked (Expr.bundle $ ppFeedback p) (Expr.bundle $ ppCurrent p) @@ -389,8 +389,8 @@ parameterPackedExp :: (TypeNum.Positive n) => - (MultiValue.Transcendental a, MultiValue.RationalConstant a) => - (MultiVector.C a) => + (NiceValue.Transcendental a, NiceValue.RationalConstant a) => + (NiceVector.C a) => Exp a -> ParameterPacked (Exp (Serial.T n a)) parameterPackedExp halfLife = withSizeExp $ \n -> @@ -401,8 +401,8 @@ causalPacked :: - (MultiVector.PseudoRing a, MultiValue.IntegerConstant a, - TypeNum.Positive n, MarshalMV.Vector n a, MarshalMV.C a) => + (NiceVector.PseudoRing a, NiceValue.IntegerConstant a, + TypeNum.Positive n, MarshalNice.Vector n a, MarshalNice.C a) => Exp a -> Causal.T (ParameterPacked (SerialCode.Value n a)) (SerialCode.Value n a) causalPacked initial = diff --git a/src/Synthesizer/LLVM/Causal/Functional.hs b/src/Synthesizer/LLVM/Causal/Functional.hs --- a/src/Synthesizer/LLVM/Causal/Functional.hs +++ b/src/Synthesizer/LLVM/Causal/Functional.hs @@ -34,7 +34,7 @@ import qualified Synthesizer.Causal.Class as CausalClass import Synthesizer.LLVM.Private (getPairPtrs, noLocalPtr) -import qualified LLVM.Extra.Multi.Value as MultiValue +import qualified LLVM.Extra.Nice.Value as NiceValue import qualified LLVM.Extra.Tuple as Tuple import qualified LLVM.Extra.MaybeContinuation as MaybeCont import qualified LLVM.Extra.Memory as Memory @@ -291,8 +291,8 @@ instance MakeArguments (LLVM.Value a) where makeArgs = id -type instance Arguments f (MultiValue.T a) = f (MultiValue.T a) -instance MakeArguments (MultiValue.T a) where +type instance Arguments f (NiceValue.T a) = f (NiceValue.T a) +instance MakeArguments (NiceValue.T a) where makeArgs = id {- | diff --git a/src/Synthesizer/LLVM/Causal/FunctionalPlug.hs b/src/Synthesizer/LLVM/Causal/FunctionalPlug.hs --- a/src/Synthesizer/LLVM/Causal/FunctionalPlug.hs +++ b/src/Synthesizer/LLVM/Causal/FunctionalPlug.hs @@ -30,7 +30,7 @@ import LLVM.DSL.Expression (Exp(Exp)) -import qualified LLVM.Extra.Multi.Value.Marshal as Marshal +import qualified LLVM.Extra.Nice.Value.Marshal as Marshal import qualified LLVM.Extra.MaybeContinuation as MaybeCont import qualified LLVM.Extra.Arithmetic as A import LLVM.Core (CodeGenFunction) @@ -89,7 +89,7 @@ and then we could not define numeric instances. -} data Core pp inp out = - forall x y. CutG.Read x => + forall x y. CutG.Consume x => Plugged (pp -> inp -> x) (PIn.T x y) @@ -277,7 +277,7 @@ type Input pp a = MR.Reader (pp, a) plug :: - (CutG.Read b, PIn.Default b) => + (CutG.Consume b, PIn.Default b) => Input pp a b -> T pp a (PIn.Element b) plug accessor = diff --git a/src/Synthesizer/LLVM/Causal/Helix.hs b/src/Synthesizer/LLVM/Causal/Helix.hs --- a/src/Synthesizer/LLVM/Causal/Helix.hs +++ b/src/Synthesizer/LLVM/Causal/Helix.hs @@ -41,11 +41,11 @@ import qualified LLVM.DSL.Expression as Expr import LLVM.DSL.Expression (Exp, (<*), (>=*)) -import qualified LLVM.Extra.Multi.Value.Storable as Storable -import qualified LLVM.Extra.Multi.Value.Marshal as Marshal -import qualified LLVM.Extra.Multi.Value.Vector as MultiValueVec -import qualified LLVM.Extra.Multi.Value as MultiValue -import qualified LLVM.Extra.Multi.Vector as MultiVector +import qualified LLVM.Extra.Nice.Value.Storable as Storable +import qualified LLVM.Extra.Nice.Value.Marshal as Marshal +import qualified LLVM.Extra.Nice.Value.Vector as NiceValueVec +import qualified LLVM.Extra.Nice.Value as NiceValue +import qualified LLVM.Extra.Nice.Vector as NiceVector import qualified LLVM.Extra.Arithmetic as A import qualified LLVM.Extra.Memory as Memory @@ -79,10 +79,10 @@ -} static :: (Ip.C nodesStep, Ip.C nodesLeap) => - (Storable.C vh, MultiValue.T vh ~ v) => - (Marshal.C a, MultiValue.Field a, MultiValue.RationalConstant a) => - (MultiValue.Fraction a, MultiValue.NativeFloating a ar) => - (MultiValueVec.NativeFloating a ar, MultiValue.T a ~ am) => + (Storable.C vh, NiceValue.T vh ~ v) => + (Marshal.C a, NiceValue.Field a, NiceValue.RationalConstant a) => + (NiceValue.Fraction a, NiceValue.NativeFloating a ar) => + (NiceValueVec.NativeFloating a ar, NiceValue.T a ~ am) => (forall r. Ip.T r nodesLeap am v) -> (forall r. Ip.T r nodesStep am v) -> Exp Int -> @@ -110,15 +110,15 @@ staticPacked :: (Ip.C nodesStep, Ip.C nodesLeap) => - (Storable.C vh, MultiValue.T vh ~ ve, SerialClass.Element v ~ ve) => + (Storable.C vh, NiceValue.T vh ~ ve, SerialClass.Element v ~ ve) => (SerialClass.Size (nodesLeap (nodesStep v)) ~ n, SerialClass.Write (nodesLeap (nodesStep v)), SerialClass.Element (nodesLeap (nodesStep v)) ~ nodesLeap (nodesStep (SerialClass.Element v))) => (TypeNum.Positive n) => - (Marshal.C a, MultiVector.Field a, MultiVector.Real a, - MultiVector.Fraction a, MultiVector.RationalConstant a, - MultiVector.NativeFloating n a ar) => + (Marshal.C a, NiceVector.Field a, NiceVector.Real a, + NiceVector.Fraction a, NiceVector.RationalConstant a, + NiceVector.NativeFloating n a ar) => (forall r. Ip.T r nodesLeap (Serial.Value n a) v) -> (forall r. Ip.T r nodesStep (Serial.Value n a) v) -> Exp Int -> @@ -146,12 +146,12 @@ -} dynamicLimited :: (Ip.C nodesStep, Ip.C nodesLeap) => - (Marshal.C a, MultiValue.Field a, MultiValue.Fraction a, - MultiValue.Select a, MultiValue.Comparison a, - MultiValue.NativeFloating a ar, - MultiValue.RationalConstant a, - MultiValueVec.NativeFloating a ar) => - (MultiValue.T a ~ am) => + (Marshal.C a, NiceValue.Field a, NiceValue.Fraction a, + NiceValue.Select a, NiceValue.Comparison a, + NiceValue.NativeFloating a ar, + NiceValue.RationalConstant a, + NiceValueVec.NativeFloating a ar) => + (NiceValue.T a ~ am) => (Memory.C v) => (forall r. Ip.T r nodesLeap am v) -> (forall r. Ip.T r nodesStep am v) -> @@ -178,12 +178,12 @@ -} dynamic :: (Ip.C nodesStep, Ip.C nodesLeap) => - (Marshal.C a, MultiValue.Field a, MultiValue.Fraction a, - MultiValue.Select a, MultiValue.Comparison a, - MultiValue.NativeFloating a ar, - MultiValue.RationalConstant a, - MultiValueVec.NativeFloating a ar) => - (MultiValue.T a ~ am) => + (Marshal.C a, NiceValue.Field a, NiceValue.Fraction a, + NiceValue.Select a, NiceValue.Comparison a, + NiceValue.NativeFloating a ar, + NiceValue.RationalConstant a, + NiceValueVec.NativeFloating a ar) => + (NiceValue.T a ~ am) => (Memory.C v) => (forall r. Ip.T r nodesLeap am v) -> (forall r. Ip.T r nodesStep am v) -> @@ -214,18 +214,18 @@ dynamicGen :: (Ip.C nodesStep, Ip.C nodesLeap) => - (Marshal.C a, MultiValue.Field a, MultiValue.Fraction a, - MultiValue.Select a, MultiValue.Comparison a, - MultiValue.NativeFloating a ar, - MultiValue.RationalConstant a, - MultiValueVec.NativeFloating a ar) => - (MultiValue.T a ~ am) => + (Marshal.C a, NiceValue.Field a, NiceValue.Fraction a, + NiceValue.Select a, NiceValue.Comparison a, + NiceValue.NativeFloating a ar, + NiceValue.RationalConstant a, + NiceValueVec.NativeFloating a ar) => + (NiceValue.T a ~ am) => (Memory.C v) => (Exp (Ip.Margin (nodesLeap (nodesStep v))) -> - (Func.T (am, am) (MultiValue.T Word), + (Func.T (am, am) (NiceValue.T Word), Func.T (am, am) am) -> (Func.T (am, am) (RingBuffer.T v), - Func.T (am, am) (MultiValue.T Word), + Func.T (am, am) (NiceValue.T Word), Func.T (am, am) am)) -> (forall r. Ip.T r nodesLeap am v) -> (forall r. Ip.T r nodesStep am v) -> @@ -265,16 +265,16 @@ shapePhases constantFromWord :: - (MultiValue.NativeFloating a ar) => - Exp Word -> Func.T inp (MultiValue.T a) + (NiceValue.NativeFloating a ar) => + Exp Word -> Func.T inp (NiceValue.T a) constantFromWord x = Func.fromSignal (Causal.map Expr.fromIntegral $* Sig.constant x) limitMinShape :: - (Marshal.C a, MultiValue.Select a, MultiValue.Comparison a, - MultiValue.NativeFloating a ar) => + (Marshal.C a, NiceValue.Select a, NiceValue.Comparison a, + NiceValue.NativeFloating a ar) => Exp Word -> - Causal.T (MultiValue.T a) (MultiValue.T a) + Causal.T (NiceValue.T a) (NiceValue.T a) limitMinShape xLim = Causal.mapAccum (\x lim -> @@ -283,9 +283,9 @@ (Expr.fromIntegral xLim) integrateFrac :: - (Marshal.C a, MultiValue.Additive a, - MultiValueVec.NativeFloating a ar, LLVM.IsPrimitive ar) => - Causal.T (MultiValue.T a) (MultiValue.T Word, MultiValue.T a) + (Marshal.C a, NiceValue.Additive a, + NiceValueVec.NativeFloating a ar, LLVM.IsPrimitive ar) => + Causal.T (NiceValue.T a) (NiceValue.T Word, NiceValue.T a) integrateFrac = Causal.mapAccum (\a frac -> @@ -306,9 +306,9 @@ cellFromBuffer :: (Memory.C a, Ip.C nodesLeap, Ip.C nodesStep) => - MultiValue.T Word -> + NiceValue.T Word -> RingBuffer.T a -> - MultiValue.T Word -> + NiceValue.T Word -> LLVM.CodeGenFunction r (nodesLeap (nodesStep a)) cellFromBuffer periodInt buffer offset = Ip.indexNodesExp @@ -321,16 +321,16 @@ elementMargin = Expr.liftReprM return peekCell :: - (Storable.C a, MultiValue.T a ~ value, Ip.C nodesLeap, Ip.C nodesStep) => + (Storable.C a, NiceValue.T a ~ value, Ip.C nodesLeap, Ip.C nodesStep) => Exp (Ip.Margin (nodesLeap (nodesStep value))) -> Exp Word -> Exp (Source.StorableVector a) -> - Causal.T (MultiValue.T Word) (nodesLeap (nodesStep value)) + Causal.T (NiceValue.T Word) (nodesLeap (nodesStep value)) peekCell margin periodWord vec = CausalPriv.map (\n -> do - ~(MultiValue.Cons (ptr,_l)) <- Expr.unExp vec - ~(MultiValue.Cons offset) <- + ~(NiceValue.Cons (ptr,_l)) <- Expr.unExp vec + ~(NiceValue.Cons offset) <- Expr.unExp $ intFromWord (Expr.lift0 n) - Ip.marginOffsetExp margin perInt <- Expr.unExp $ intFromWord periodWord Ip.loadNodesExp (Ip.loadNodesExp Storable.load A.one) perInt @@ -338,25 +338,25 @@ flattenShapePhaseProc :: - (MultiValue.Field a, MultiValue.RationalConstant a, MultiValue.Fraction a) => - (MultiValue.NativeFloating a ar, MultiValueVec.NativeFloating a ar) => + (NiceValue.Field a, NiceValue.RationalConstant a, NiceValue.Fraction a) => + (NiceValue.NativeFloating a ar, NiceValueVec.NativeFloating a ar) => Exp Word -> Exp a -> Causal.T - (MultiValue.T a, MultiValue.T a) - (MultiValue.T Word, (MultiValue.T a, MultiValue.T a)) + (NiceValue.T a, NiceValue.T a) + (NiceValue.T Word, (NiceValue.T a, NiceValue.T a)) flattenShapePhaseProc periodInt period = Causal.map (\(shape, phase) -> flattenShapePhase periodInt period shape phase) _flattenShapePhaseProc :: - (MultiValue.Field a, MultiValue.RationalConstant a, MultiValue.Fraction a) => - (MultiValue.NativeFloating a ar) => + (NiceValue.Field a, NiceValue.RationalConstant a, NiceValue.Fraction a) => + (NiceValue.NativeFloating a ar) => Exp Word -> Exp a -> Causal.T - (MultiValue.T a, MultiValue.T a) - (MultiValue.T Word, (MultiValue.T a, MultiValue.T a)) + (NiceValue.T a, NiceValue.T a) + (NiceValue.T Word, (NiceValue.T a, NiceValue.T a)) _flattenShapePhaseProc period32 period = CausalPriv.map (\(shape, phase) -> do @@ -365,8 +365,8 @@ _flattenShapePhase perInt per shape phase) flattenShapePhaseProcPacked :: - (TypeNum.Positive n, MultiVector.Field a, MultiVector.RationalConstant a) => - (MultiVector.Fraction a, MultiVector.NativeFloating n a ar) => + (TypeNum.Positive n, NiceVector.Field a, NiceVector.RationalConstant a) => + (NiceVector.Fraction a, NiceVector.NativeFloating n a ar) => Exp Word -> Exp a -> Causal.T @@ -378,8 +378,8 @@ (SerialExp.upsample periodInt) (SerialExp.upsample period)) flattenShapePhase :: - (MultiValue.Field a, MultiValue.RationalConstant a, MultiValue.Fraction a) => - (MultiValueVec.NativeFloating a ar, MultiValueVec.NativeInteger i ir) => + (NiceValue.Field a, NiceValue.RationalConstant a, NiceValue.Fraction a) => + (NiceValueVec.NativeFloating a ar, NiceValueVec.NativeInteger i ir) => (LLVM.ShapeOf ir ~ LLVM.ShapeOf ar) => Exp i -> Exp a -> Exp a -> Exp a -> @@ -398,12 +398,12 @@ in (n,(qLeap,qStep)) _flattenShapePhase :: - (MultiValue.Field a, MultiValue.RationalConstant a, MultiValue.Fraction a) => - (MultiValue.NativeFloating a ar, MultiValue.NativeInteger i ir) => - MultiValue.T i -> - MultiValue.T a -> - MultiValue.T a -> MultiValue.T a -> - LLVM.CodeGenFunction r (MultiValue.T i, (MultiValue.T a, MultiValue.T a)) + (NiceValue.Field a, NiceValue.RationalConstant a, NiceValue.Fraction a) => + (NiceValue.NativeFloating a ar, NiceValue.NativeInteger i ir) => + NiceValue.T i -> + NiceValue.T a -> + NiceValue.T a -> NiceValue.T a -> + LLVM.CodeGenFunction r (NiceValue.T i, (NiceValue.T a, NiceValue.T a)) _flattenShapePhase = Expr.unliftM4 $ \periodInt period shape phase -> let qLeap = Expr.fraction $ shape/period - phase (n,qStep) = @@ -420,10 +420,10 @@ limitShape :: (Ip.C nodesStep, Ip.C nodesLeap) => - (Marshal.C t, MultiValue.Real t, MultiValue.NativeFloating t tr) => + (Marshal.C t, NiceValue.Real t, NiceValue.NativeFloating t tr) => (i ~ Int) => Exp (Ip.Margin (nodesLeap (nodesStep value))) -> - Exp i -> Exp i -> Causal.MV t t + Exp i -> Exp i -> Causal.Nice t t limitShape margin periodInt len = Causal.zipWith Expr.limit $< @@ -431,8 +431,8 @@ limitShapePacked :: (Ip.C nodesStep, Ip.C nodesLeap) => - (Marshal.C t, MultiValue.NativeFloating t tr) => - (TypeNum.Positive n, MultiVector.Real t) => + (Marshal.C t, NiceValue.NativeFloating t tr) => + (TypeNum.Positive n, NiceVector.Real t) => (i ~ Int) => Exp (Ip.Margin (nodesLeap (nodesStep value))) -> Exp i -> @@ -450,12 +450,12 @@ limitShapeSignal :: (Ip.C nodesStep, Ip.C nodesLeap) => - (Marshal.C t, MultiValue.NativeFloating t tr) => + (Marshal.C t, NiceValue.NativeFloating t tr) => (i ~ Int) => Exp (Ip.Margin (nodesLeap (nodesStep value))) -> Exp i -> Exp i -> - Sig.T (MultiValue.T t, MultiValue.T t) + Sig.T (NiceValue.T t, NiceValue.T t) limitShapeSignal margin periodInt len = SigPriv.Cons (\minMax -> noLocalPtr $ \() -> return (minMax, ())) @@ -483,15 +483,15 @@ shapeMargin margin periodInt = let (marginNumber, marginOffset) = Expr.unzip $ - Expr.lift1 (uncurry MultiValue.zip . Ip.unzipMargin) margin + Expr.lift1 (uncurry NiceValue.zip . Ip.unzipMargin) margin leftMargin = marginOffset + periodInt rightMargin = marginNumber - leftMargin in (leftMargin, rightMargin) _shapeLimits :: (Ip.C nodesLeap, Ip.C nodesStep) => - (MultiValue.NativeFloating t tr) => - (MultiValue.Additive t) => + (NiceValue.NativeFloating t tr) => + (NiceValue.Additive t) => Ip.Margin (nodesLeap (nodesStep value)) -> Exp Word -> Exp t -> (Exp t, Exp t) _shapeLimits margin periodInt len = @@ -553,23 +553,23 @@ -} zigZagLong :: (Marshal.C a) => - (MultiValue.Select a, MultiValue.Comparison a, MultiValue.Fraction a) => - (MultiValue.Field a, MultiValue.RationalConstant a) => - Exp a -> Exp a -> Causal.MV a a + (NiceValue.Select a, NiceValue.Comparison a, NiceValue.Fraction a) => + (NiceValue.Field a, NiceValue.RationalConstant a) => + Exp a -> Exp a -> Causal.Nice a a zigZagLong = zigZagLongGen (Causal.fromSignal . Sig.constant) zigZag zigZagLongPacked :: (Marshal.Vector n a) => - (MultiVector.Field a, MultiVector.Fraction a) => - (MultiVector.RationalConstant a) => - (MultiVector.Select a, MultiVector.Comparison a) => + (NiceVector.Field a, NiceVector.Fraction a) => + (NiceVector.RationalConstant a) => + (NiceVector.Select a, NiceVector.Comparison a) => Exp a -> Exp a -> Causal.T (Serial.Value n a) (Serial.Value n a) zigZagLongPacked = zigZagLongGen (Causal.fromSignal . SigPS.constant) zigZagPacked zigZagLongGen :: - (MultiValue.RationalConstant a, MultiValue.Field a) => + (NiceValue.RationalConstant a, NiceValue.Field a) => (A.RationalConstant al, A.Field al) => (Exp a -> Causal.T al al) -> (Exp a -> Causal.T al al) -> @@ -588,9 +588,9 @@ -} zigZag :: (Marshal.C a) => - (MultiValue.Select a, MultiValue.Comparison a, MultiValue.Fraction a) => - (MultiValue.Field a, MultiValue.RationalConstant a) => - Exp a -> Causal.MV a a + (NiceValue.Select a, NiceValue.Comparison a, NiceValue.Fraction a) => + (NiceValue.Field a, NiceValue.RationalConstant a) => + Exp a -> Causal.Nice a a zigZag start = Causal.map (\x -> 1 - abs (1-x)) <<< @@ -601,9 +601,9 @@ zigZagPacked :: (TypeNum.Positive n) => (Marshal.C a) => - (MultiVector.Field a, MultiVector.Fraction a) => - (MultiVector.RationalConstant a) => - (MultiVector.Select a, MultiVector.Comparison a) => + (NiceVector.Field a, NiceVector.Fraction a) => + (NiceVector.RationalConstant a) => + (NiceVector.Select a, NiceVector.Comparison a) => Exp a -> Causal.T (Serial.Value n a) (Serial.Value n a) zigZagPacked start = Causal.map (\x -> 1 - abs (1-x)) @@ -615,7 +615,7 @@ start wrap :: - (MultiValue.Field a, MultiValue.Fraction a, MultiValue.RationalConstant a) => + (NiceValue.Field a, NiceValue.Fraction a, NiceValue.RationalConstant a) => (Exp b -> Exp a -> Exp a -> Exp a) -> (Exp a -> Exp b) -> Exp a -> Exp a diff --git a/src/Synthesizer/LLVM/Causal/Parametric.hs b/src/Synthesizer/LLVM/Causal/Parametric.hs --- a/src/Synthesizer/LLVM/Causal/Parametric.hs +++ b/src/Synthesizer/LLVM/Causal/Parametric.hs @@ -7,8 +7,8 @@ import LLVM.DSL.Expression (Exp(Exp)) -import qualified LLVM.Extra.Multi.Value.Marshal as Marshal -import qualified LLVM.Extra.Multi.Value as MultiValue +import qualified LLVM.Extra.Nice.Value.Marshal as Marshal +import qualified LLVM.Extra.Nice.Value as NiceValue import qualified LLVM.Extra.Memory as Memory import qualified LLVM.Extra.MaybeContinuation as MaybeCont import qualified LLVM.Extra.Tuple as Tuple @@ -31,7 +31,7 @@ (forall r. p -> global -> LLVM.CodeGenFunction r ()) -fromProcess :: String -> (Exp p -> Causal.T a b) -> IO (T (MultiValue.T p) a b) +fromProcess :: String -> (Exp p -> Causal.T a b) -> IO (T (NiceValue.T p) a b) fromProcess name f = do ref <- newIORef $ error $ name ++ ": uninitialized parameter reference" return $ @@ -63,7 +63,7 @@ loadParam :: (Marshal.C param) => - IORef (MultiValue.T param) -> + IORef (NiceValue.T param) -> LLVM.Value (MarshalPtr param) -> LLVM.CodeGenFunction r () loadParam ref ptr = liftIO . writeIORef ref =<< Memory.load ptr diff --git a/src/Synthesizer/LLVM/Causal/Private.hs b/src/Synthesizer/LLVM/Causal/Private.hs --- a/src/Synthesizer/LLVM/Causal/Private.hs +++ b/src/Synthesizer/LLVM/Causal/Private.hs @@ -13,8 +13,8 @@ import qualified LLVM.DSL.Expression as Expr import LLVM.DSL.Expression (Exp) -import qualified LLVM.Extra.Multi.Value.Marshal as Marshal -import qualified LLVM.Extra.Multi.Value as MultiValue +import qualified LLVM.Extra.Nice.Value.Marshal as Marshal +import qualified LLVM.Extra.Nice.Value as NiceValue import qualified LLVM.Extra.Memory as Memory import qualified LLVM.Extra.MaybeContinuation as MaybeCont import qualified LLVM.Extra.Control as C @@ -241,7 +241,7 @@ LLVM.getElementPtr0 globalStatePtr (TypeNum.d1, ()) return a1) (do - MultiValue.Cons len <- Expr.unExp n + NiceValue.Cons len <- Expr.unExp n globalStates <- LLVM.arrayMalloc len C.arrayLoop len globalStates () $ \globalStatePtr () -> flip Memory.store globalStatePtr =<< start @@ -271,9 +271,9 @@ quantizeLift :: - (Memory.C b, Marshal.C c, MultiValue.IntegerConstant c, - MultiValue.Additive c, MultiValue.Comparison c) => - T a b -> T (MultiValue.T c, a) b + (Memory.C b, Marshal.C c, NiceValue.IntegerConstant c, + NiceValue.Additive c, NiceValue.Comparison c) => + T a b -> T (NiceValue.T c, a) b quantizeLift (Cons next start stop) = Cons (\global local (k, a0) yState0 -> do (yState1, frac1) <- @@ -282,7 +282,7 @@ (LLVM.valueOf True, yState0) (\(cont1, (_, frac0)) -> LLVM.and cont1 . unbool - =<< MultiValue.cmp LLVM.CmpLE frac0 A.zero) + =<< NiceValue.cmp LLVM.CmpLE frac0 A.zero) (\(_,((_,state01), frac0)) -> MaybeCont.toBool $ liftA2 (,) (next global local a0 state01) diff --git a/src/Synthesizer/LLVM/Causal/Process.hs b/src/Synthesizer/LLVM/Causal/Process.hs --- a/src/Synthesizer/LLVM/Causal/Process.hs +++ b/src/Synthesizer/LLVM/Causal/Process.hs @@ -2,7 +2,7 @@ {-# LANGUAGE TypeOperators #-} {-# LANGUAGE Rank2Types #-} module Synthesizer.LLVM.Causal.Process ( - Causal.T, MV, + Causal.T, Nice, CausalClass.fromSignal, CausalClass.toSignal, (CausalClass.$<), (CausalClass.$>), (CausalClass.$*), @@ -36,6 +36,8 @@ osci, shapeModOsci, skip, + foldChunks, + foldChunksPartial, frequencyModulation, frequencyModulationLinear, Causal.quantizeLift, @@ -61,6 +63,7 @@ import qualified Synthesizer.LLVM.Causal.Private as Causal import qualified Synthesizer.LLVM.Generator.Private as SigPriv import qualified Synthesizer.LLVM.Generator.Signal as Sig +import qualified Synthesizer.LLVM.Fold as Fold import qualified Synthesizer.LLVM.RingBuffer as RingBuffer import qualified Synthesizer.LLVM.Interpolation as Interpolation import qualified Synthesizer.LLVM.Frame.Stereo as Stereo @@ -75,9 +78,9 @@ import qualified LLVM.DSL.Expression as Expr import LLVM.DSL.Expression (Exp) -import qualified LLVM.Extra.Multi.Vector as MultiVector -import qualified LLVM.Extra.Multi.Value.Marshal as Marshal -import qualified LLVM.Extra.Multi.Value as MultiValue +import qualified LLVM.Extra.Nice.Vector as NiceVector +import qualified LLVM.Extra.Nice.Value.Marshal as Marshal +import qualified LLVM.Extra.Nice.Value as NiceValue import qualified LLVM.Extra.Memory as Memory import qualified LLVM.Extra.MaybeContinuation as MaybeCont import qualified LLVM.Extra.Maybe as Maybe @@ -114,7 +117,7 @@ import Prelude () -type MV a b = Causal.T (MultiValue.T a) (MultiValue.T b) +type Nice a b = Causal.T (NiceValue.T a) (NiceValue.T b) infixl 0 $<#, $>#, $*# @@ -124,19 +127,19 @@ -} ($*#) :: (CausalClass.C process, CausalClass.SignalOf process ~ signal, - MultiValue.C a) => - process (MultiValue.T a) b -> a -> signal b -proc $*# x = CausalClass.applyConst proc $ MultiValue.cons x + NiceValue.C a) => + process (NiceValue.T a) b -> a -> signal b +proc $*# x = CausalClass.applyConst proc $ NiceValue.cons x ($<#) :: - (CausalClass.C process, MultiValue.C a) => - process (MultiValue.T a, b) c -> a -> process b c -proc $<# x = CausalClass.applyConstFst proc $ MultiValue.cons x + (CausalClass.C process, NiceValue.C a) => + process (NiceValue.T a, b) c -> a -> process b c +proc $<# x = CausalClass.applyConstFst proc $ NiceValue.cons x ($>#) :: - (CausalClass.C process, MultiValue.C b) => - process (a, MultiValue.T b) c -> b -> process a c -proc $># x = CausalClass.applyConstSnd proc $ MultiValue.cons x + (CausalClass.C process, NiceValue.C b) => + process (a, NiceValue.T b) c -> b -> process a c +proc $># x = CausalClass.applyConstSnd proc $ NiceValue.cons x @@ -171,7 +174,7 @@ {- | You may also use '(+)' and a 'Sig.constant' signal or a number literal. -} -raise :: (Marshal.C a, MultiValue.Additive a) => Exp a -> MV a a +raise :: (Marshal.C a, NiceValue.Additive a) => Exp a -> Nice a a raise x = mix $< Sig.constant x @@ -193,21 +196,21 @@ amplify x = envelope $< Sig.constant x amplifyStereo :: - (Marshal.C a, MultiValue.PseudoRing a, Stereo.T (MultiValue.T a) ~ stereo) => + (Marshal.C a, NiceValue.PseudoRing a, Stereo.T (NiceValue.T a) ~ stereo) => Exp a -> Causal.T stereo stereo amplifyStereo x = envelopeStereo $< Sig.constant x mapLinear :: - (Marshal.C a, MultiValue.T a ~ am, - MultiValue.PseudoRing a, MultiValue.IntegerConstant a) => + (Marshal.C a, NiceValue.T a ~ am, + NiceValue.PseudoRing a, NiceValue.IntegerConstant a) => Exp a -> Exp a -> Causal.T am am mapLinear depth center = map (\x -> center + depth*x) -- ToDo: use base 2 mapExponential :: - (Marshal.C a, MultiValue.T a ~ am, - MultiValue.Transcendental a, MultiValue.RationalConstant a) => + (Marshal.C a, NiceValue.T a ~ am, + NiceValue.Transcendental a, NiceValue.RationalConstant a) => Exp a -> Exp a -> Causal.T am am mapExponential depth center = let logDepth = log depth @@ -271,7 +274,7 @@ (Marshal.C b, (n TypeNum.:*: LLVM.SizeOf (Marshal.Struct b)) ~ bSize, TypeNum.Natural bSize) => (Exp b -> Causal.T (c,a) a) -> - Exp (MultiValue.Array n b) -> Causal.T (c,a) a + Exp (NiceValue.Array n b) -> Causal.T (c,a) a replicateControlledParam f ps = Unsafe.performIO $ do let n :: Word n = TypeNum.integralFromProxy $ arraySize ps @@ -364,11 +367,11 @@ arrayFromStereo :: (Marshal.C a) => - Stereo.T (MultiValue.T a) -> - LLVM.CodeGenFunction r (MultiValue.T (MultiValue.Array TypeNum.D2 a)) + Stereo.T (NiceValue.T a) -> + LLVM.CodeGenFunction r (NiceValue.T (NiceValue.Array TypeNum.D2 a)) arrayFromStereo a = - MultiValue.insertArrayValue TypeNum.d0 (Stereo.left a) =<< - MultiValue.insertArrayValue TypeNum.d1 (Stereo.right a) MultiValue.undef + NiceValue.insertArrayValue TypeNum.d0 (Stereo.left a) =<< + NiceValue.insertArrayValue TypeNum.d1 (Stereo.right a) NiceValue.undef stereoFromMonoParametric :: (Marshal.C x, @@ -478,9 +481,9 @@ -} skip :: (Tuple.Undefined a, Tuple.Phi a, Memory.C a) => - Sig.T a -> Causal.T (MultiValue.T Word) a + Sig.T a -> Causal.T (NiceValue.T Word) a skip (SigPriv.Cons next start stop) = Causal.Cons - (\global local n1 (yState0, MultiValue.Cons n0) -> do + (\global local n1 (yState0, NiceValue.Cons n0) -> do yState1@(y,_) <- MaybeCont.fromMaybe $ fmap snd $ MaybeCont.fixedLengthLoop n0 yState0 $ @@ -489,14 +492,62 @@ (mapSnd (\s -> ((Tuple.undef, s), A.one)) <$> start) stop +{- | +The input of the process is a sequence of chunk sizes. +The signal is chopped into chunks of these sizes +and each chunk is folded using +the given initial value and the accumulation function. +A trailing incomplete chunk will be ignored. +-} +foldChunks :: + (Tuple.Undefined b, Tuple.Phi b) => + Fold.T a b -> Sig.T a -> Causal.T (NiceValue.T Word) b +foldChunks (Fold.Cons accum initial) (SigPriv.Cons next start stop) = + Causal.Cons + (\global local (NiceValue.Cons n) state -> + MaybeCont.fromMaybe $ fmap snd $ + MaybeCont.fixedLengthLoop n (initial,state) $ \(b0,state0) -> do + (a,state1) <- next global local state0 + b1 <- MaybeCont.lift $ accum b0 a + return (b1,state1)) + start + stop + +{- | +Like 'foldChunks' but an incomplete chunk at the end +is treated like a complete one. +-} +foldChunksPartial :: + (Tuple.Undefined a, Tuple.Phi a, Tuple.Undefined b, Tuple.Phi b) => + Fold.T a b -> Sig.T a -> Causal.T (NiceValue.T Word) b +foldChunksPartial (Fold.Cons accum initial) (SigPriv.Cons next start stop) = + Causal.Cons + (\global local (NiceValue.Cons n) runState0 -> do + ((i,b), runState1) <- + MaybeCont.lift $ + C.whileLoopShared ((n, initial), runState0) $ + \((i0,b0), (run,s0)) -> + (A.and run =<< A.cmp LLVM.CmpGT i0 A.zero, + do mas1 <- MaybeCont.toMaybe $ next global local s0 + Maybe.run mas1 + (return ((i0,b0), (LLVM.valueOf False, s0))) + (\(a,s1) -> do + b1 <- accum b0 a + i1 <- A.dec i0 + return ((i1,b1), (LLVM.valueOf True, s1)))) + MaybeCont.guard =<< MaybeCont.lift (A.cmp LLVM.CmpLT i n) + return (b, runState1)) + (fmap (mapSnd ((,) (LLVM.valueOf True))) $ start) + stop + frequencyModulation :: (Marshal.C a, - MultiValue.IntegerConstant a, - MultiValue.Additive a, - MultiValue.Comparison a, + NiceValue.IntegerConstant a, + NiceValue.Additive a, + NiceValue.Comparison a, Tuple.Undefined nodes, Tuple.Phi nodes, Memory.C nodes) => - (forall r. MultiValue.T a -> nodes -> LLVM.CodeGenFunction r v) -> - SigPriv.T nodes -> Causal.T (MultiValue.T a) v + (forall r. NiceValue.T a -> nodes -> LLVM.CodeGenFunction r v) -> + SigPriv.T nodes -> Causal.T (NiceValue.T a) v frequencyModulation ip (SigPriv.Cons next start stop) = Causal.Cons (\global local k yState0 -> do ((nodes2,state2), ss2) <- @@ -504,7 +555,7 @@ C.whileLoop (LLVM.valueOf True, yState0) (\(cont0, (_, ss0)) -> - LLVM.and cont0 . unbool =<< MultiValue.cmp LLVM.CmpGE ss0 A.one) + LLVM.and cont0 . unbool =<< NiceValue.cmp LLVM.CmpGE ss0 A.one) (\(_,((_,state0), ss0)) -> MaybeCont.toBool $ liftA2 (,) (next global local state0) @@ -518,9 +569,9 @@ stop frequencyModulationLinear :: - (MultiValue.PseudoRing a, MultiValue.IntegerConstant a, - MultiValue.Comparison a, Marshal.C a) => - Sig.MV a -> MV a a + (NiceValue.PseudoRing a, NiceValue.IntegerConstant a, + NiceValue.Comparison a, Marshal.C a) => + Sig.Nice a -> Nice a a frequencyModulationLinear sig = frequencyModulation Interpolation.linear (Sig.adjacentNodes02 sig) @@ -536,7 +587,7 @@ size1 <- A.inc size0 return (RingBuffer.Cons ptr size1 remain0 remain1, remain1)) (do - MultiValue.Cons size0 <- Expr.unExp time + NiceValue.Cons size0 <- Expr.unExp time size1 <- A.inc size0 ptr <- LLVM.arrayMalloc size1 a <- Expr.bundle initial @@ -562,13 +613,13 @@ Delay time must be greater than zero! -} comb :: - (Marshal.C a, MultiValue.PseudoRing a) => - Exp a -> Exp Word -> MV a a + (Marshal.C a, NiceValue.PseudoRing a) => + Exp a -> Exp Word -> Nice a a comb gain time = loopZero (mix >>> (Cat.id &&& (delayZero (time-1) >>> amplify gain))) combStereo :: - (Marshal.C a, MultiValue.PseudoRing a, Stereo.T (MultiValue.T a) ~ stereo) => + (Marshal.C a, NiceValue.PseudoRing a, Stereo.T (NiceValue.T a) ~ stereo) => Exp a -> Exp Word -> Causal.T stereo stereo combStereo gain time = loopZero (mix >>> (Cat.id &&& (delayZero (time-1) >>> amplifyStereo gain))) @@ -577,8 +628,8 @@ (TypeNum.Natural n, (n TypeNum.:*: LLVM.UnknownSize) ~ paramSize, TypeNum.Natural paramSize) => (Marshal.C a, - MultiValue.Field a, MultiValue.Real a, MultiValue.IntegerConstant a) => - Exp (MultiValue.Array n (a,Word)) -> MV a a + NiceValue.Field a, NiceValue.Real a, NiceValue.IntegerConstant a) => + Exp (NiceValue.Array n (a,Word)) -> Nice a a reverbExplicit params = amplify (Expr.recip $ TypeNum.integralFromProxy $ arraySize params) <<< @@ -590,7 +641,7 @@ reverbParams :: (RandomGen g, TypeNum.Integer n, Random a) => - g -> Proxy n -> (a,a) -> (Word, Word) -> MultiValue.Array n (a, Word) + g -> Proxy n -> (a,a) -> (Word, Word) -> NiceValue.Array n (a, Word) reverbParams rnd Proxy gainRange timeRange = flip MS.evalState rnd $ sequenceA $ pure $ @@ -606,11 +657,11 @@ -} delayControlled :: (Expr.Aggregate ae al, Memory.C al) => - ae -> Exp Word -> Causal.T (MultiValue.T Word, al) al + ae -> Exp Word -> Causal.T (NiceValue.T Word, al) al delayControlled initial maxTime = Causal.zipWith RingBuffer.index <<< - arr (\(MultiValue.Cons i) -> i) *** track initial maxTime + arr (\(NiceValue.Cons i) -> i) *** track initial maxTime {- | Delay by a variable fractional amount of samples. @@ -619,8 +670,8 @@ -} delayControlledInterpolated :: (Interpolation.C nodes) => - (MultiValue.T a ~ am) => - (MultiValue.NativeFloating a ar, MultiValue.Additive a) => + (NiceValue.T a ~ am) => + (NiceValue.NativeFloating a ar, NiceValue.Additive a) => (Expr.Aggregate ve v, Memory.C v) => (forall r. Interpolation.T r nodes am v) -> ve -> Exp Word -> Causal.T (am, v) v @@ -631,9 +682,9 @@ let offset = A.fromInteger' $ fromIntegral $ Interpolation.marginOffset margin - n <- A.max offset =<< MultiValue.truncateToInt del - k <- A.sub del =<< MultiValue.fromIntegral n - ~(MultiValue.Cons m) <- A.sub n (offset :: MultiValue.T Word) + n <- A.max offset =<< NiceValue.truncateToInt del + k <- A.sub del =<< NiceValue.fromIntegral n + ~(NiceValue.Cons m) <- A.sub n (offset :: NiceValue.T Word) ip k =<< Interpolation.indexNodes (flip RingBuffer.index buf) A.one m) <<< @@ -669,14 +720,14 @@ then we may add a more sensible initialization. -} pipeline :: - (TypeNum.Positive n, MultiVector.C x, - v ~ MultiVector.T n x, - a ~ MultiValue.T x, + (TypeNum.Positive n, NiceVector.C x, + v ~ NiceVector.T n x, + a ~ NiceValue.T x, Tuple.Zero v, Memory.C v) => Causal.T v v -> Causal.T a a pipeline vectorProcess = - loopConst MultiVector.zero $ - Causal.map (uncurry MultiVector.shiftUp) + loopConst NiceVector.zero $ + Causal.map (uncurry NiceVector.shiftUp) >>> Arrow.second vectorProcess @@ -689,8 +740,8 @@ -} vectorize :: (TypeNum.Positive n, - MultiVector.C x, MultiValue.T x ~ a, MultiVector.T n x ~ va, - MultiVector.C y, MultiValue.T y ~ b, MultiVector.T n y ~ vb) => + NiceVector.C x, NiceValue.T x ~ a, NiceVector.T n x ~ va, + NiceVector.C y, NiceValue.T y ~ b, NiceVector.T n y ~ vb) => Causal.T a b -> Causal.T va vb vectorize proc = withSize $ \n -> @@ -700,7 +751,7 @@ List.take (TypeNum.integralFromSingleton n) [0 ..] withSize :: - (TypeNum.Positive n, MultiVector.T n a ~ v) => + (TypeNum.Positive n, NiceVector.T n a ~ v) => (TypeNum.Singleton n -> f v) -> f v withSize f = f TypeNum.singleton @@ -711,13 +762,13 @@ -} replaceChannel :: (TypeNum.Positive n, - MultiVector.C x, MultiValue.T x ~ a, MultiVector.T n x ~ va, - MultiVector.C y, MultiValue.T y ~ b, MultiVector.T n y ~ vb) => + NiceVector.C x, NiceValue.T x ~ a, NiceVector.T n x ~ va, + NiceVector.C y, NiceValue.T y ~ b, NiceVector.T n y ~ vb) => Int -> Causal.T a b -> Causal.T va vb -> Causal.T va vb replaceChannel i channel proc = let li = LLVM.valueOf $ fromIntegral i - in Causal.zipWith (MultiVector.insert li) <<< - (channel <<< Causal.map (MultiVector.extract li)) &&& + in Causal.zipWith (NiceVector.insert li) <<< + (channel <<< Causal.map (NiceVector.extract li)) &&& proc @@ -727,8 +778,8 @@ arrayElement :: (Marshal.C a, Marshal.Struct a ~ aStruct, LLVM.IsFirstClass aStruct, TypeNum.Natural i, TypeNum.Natural n, i :<: n) => - Proxy i -> Causal.T (MultiValue.T (MultiValue.Array n a)) (MultiValue.T a) -arrayElement i = Causal.map (MultiValue.extractArrayValue i) + Proxy i -> Causal.T (NiceValue.T (NiceValue.Array n a)) (NiceValue.T a) +arrayElement i = Causal.map (NiceValue.extractArrayValue i) {- | @@ -740,7 +791,7 @@ trigger :: (Marshal.C a, Tuple.Undefined b, Tuple.Phi b) => (Exp a -> Sig.T b) -> - Causal.T (Maybe.T (MultiValue.T a)) (Maybe.T b) + Causal.T (Maybe.T (NiceValue.T a)) (Maybe.T b) trigger f = Unsafe.performIO $ do paramd <- Parametric.fromProcess "Causal.trigger" (CausalClass.fromSignal . f) @@ -780,8 +831,8 @@ Maybe.for maybeGlobal $ \(a,global) -> stop a global nothingFromFunc :: - (MultiValue.C a, Tuple.Undefined global) => + (NiceValue.C a, Tuple.Undefined global) => (Exp a -> Sig.T b) -> (ap -> global -> code) -> - Maybe.T (MultiValue.T a, global) + Maybe.T (NiceValue.T a, global) nothingFromFunc _ _ = Maybe.nothing diff --git a/src/Synthesizer/LLVM/Causal/ProcessPacked.hs b/src/Synthesizer/LLVM/Causal/ProcessPacked.hs --- a/src/Synthesizer/LLVM/Causal/ProcessPacked.hs +++ b/src/Synthesizer/LLVM/Causal/ProcessPacked.hs @@ -14,9 +14,9 @@ import qualified LLVM.DSL.Expression as Expr import LLVM.DSL.Expression (Exp) -import qualified LLVM.Extra.Multi.Vector as MultiVector -import qualified LLVM.Extra.Multi.Value.Marshal as Marshal -import qualified LLVM.Extra.Multi.Value as MultiValue +import qualified LLVM.Extra.Nice.Vector as NiceVector +import qualified LLVM.Extra.Nice.Value.Marshal as Marshal +import qualified LLVM.Extra.Nice.Value as NiceValue import qualified LLVM.Extra.Tuple as Tuple import qualified LLVM.Extra.MaybeContinuation as Maybe import qualified LLVM.Extra.Control as C @@ -42,7 +42,7 @@ import Prelude () -type Serial n a = MultiValue.T (Serial.T n a) +type Serial n a = NiceValue.T (Serial.T n a) {- | @@ -103,21 +103,21 @@ raise :: - (TypeNum.Positive n, MultiVector.Additive a) => + (TypeNum.Positive n, NiceVector.Additive a) => Exp a -> Causal.T (Serial n a) (Serial n a) raise x = CausalPriv.map (\y -> Expr.unExp (Serial.upsample x) >>= flip Frame.mix y) amplify :: - (TypeNum.Positive n, MultiVector.PseudoRing a) => + (TypeNum.Positive n, NiceVector.PseudoRing a) => Exp a -> Causal.T (Serial n a) (Serial n a) amplify x = CausalPriv.map (\y -> Expr.unExp (Serial.upsample x) >>= flip Frame.amplifyMono y) amplifyStereo :: - (TypeNum.Positive n, MultiVector.PseudoRing a) => + (TypeNum.Positive n, NiceVector.PseudoRing a) => Exp a -> Causal.T (Stereo.T (Serial n a)) (Stereo.T (Serial n a)) amplifyStereo x = CausalPriv.map @@ -126,7 +126,7 @@ delay1 :: (LLVM.Positive n, Marshal.C a, - MultiVector.C a, SerialCode.Value n a ~ v) => + NiceVector.C a, SerialCode.Value n a ~ v) => Exp a -> Causal.T v v delay1 initial = Causal.loop initial $ @@ -134,20 +134,20 @@ differentiate :: (LLVM.Positive n, Marshal.C a, - MultiVector.Additive a, SerialCode.Value n a ~ v) => + NiceVector.Additive a, SerialCode.Value n a ~ v) => Exp a -> Causal.T v v differentiate initial = Cat.id - delay1 initial integrate :: (LLVM.Positive n, Marshal.C a, - MultiVector.Additive a, SerialCode.Value n a ~ v) => + NiceVector.Additive a, SerialCode.Value n a ~ v) => Exp a -> Causal.T v v integrate = Causal.mapAccum (\a acc0 -> swap $ Serial.cumulate acc0 a) osciCore :: - (TypeNum.Positive n, Marshal.C t, MultiVector.Fraction t) => + (TypeNum.Positive n, Marshal.C t, NiceVector.Fraction t) => Causal.T (Serial n t, Serial n t) (Serial n t) osciCore = CausalPriv.zipWith A.addToPhase <<< @@ -159,13 +159,13 @@ Expr.zero) osci :: - (TypeNum.Positive n, Marshal.C t, MultiVector.Fraction t) => + (TypeNum.Positive n, Marshal.C t, NiceVector.Fraction t) => (forall r. Serial n t -> LLVM.CodeGenFunction r y) -> Causal.T (Serial n t, Serial n t) y osci wave = CausalPriv.map wave <<< osciCore shapeModOsci :: - (TypeNum.Positive n, Marshal.C t, MultiVector.Fraction t) => + (TypeNum.Positive n, Marshal.C t, NiceVector.Fraction t) => (forall r. c -> Serial n t -> LLVM.CodeGenFunction r y) -> Causal.T (c, (Serial n t, Serial n t)) y shapeModOsci wave = CausalPriv.zipWith wave <<< Arrow.second osciCore @@ -173,8 +173,8 @@ arrayElement :: (TypeNum.Positive n, - MultiVector.C a, Marshal.C a, + NiceVector.C a, Marshal.C a, Marshal.Struct a ~ aStruct, LLVM.IsFirstClass aStruct, TypeNum.Natural i, TypeNum.Natural d, i :<: d) => - Proxy i -> Causal.T (MultiValue.T (MultiValue.Array d a)) (Serial n a) + Proxy i -> Causal.T (NiceValue.T (NiceValue.Array d a)) (Serial n a) arrayElement i = Causal.map Serial.upsample <<< Causal.arrayElement i diff --git a/src/Synthesizer/LLVM/Causal/Render.hs b/src/Synthesizer/LLVM/Causal/Render.hs --- a/src/Synthesizer/LLVM/Causal/Render.hs +++ b/src/Synthesizer/LLVM/Causal/Render.hs @@ -5,7 +5,8 @@ {-# LANGUAGE ForeignFunctionInterface #-} module Synthesizer.LLVM.Causal.Render ( -- * type driven - RunArg, DSLArg, + Argument, DSLArg, + Run, DSL, In, Out, run, runPlugged, processIO, @@ -13,7 +14,8 @@ -- * explicit argument converters runPluggedExplicit, - build, -- ToDo: better name + function, + argument, Plugs, -- * internally used in FunctionalPlug @@ -24,7 +26,7 @@ import qualified Synthesizer.LLVM.Causal.Parametric as Parametric import Synthesizer.LLVM.Causal.Private (T(Cons)) import Synthesizer.LLVM.Private.Render - (RunArg (DSLArg, buildArg), + (Argument (DSLArg, argument), Triple, tripleStruct, derefStartPtr, derefStopPtr) import qualified Synthesizer.LLVM.Plug.Input as PIn @@ -39,9 +41,9 @@ import LLVM.DSL.Render.Run ((*->)) import LLVM.DSL.Expression (Exp(Exp)) -import qualified LLVM.Extra.Multi.Value.Storable as Storable -import qualified LLVM.Extra.Multi.Value.Marshal as Marshal -import qualified LLVM.Extra.Multi.Value as MultiValue +import qualified LLVM.Extra.Nice.Value.Storable as Storable +import qualified LLVM.Extra.Nice.Value.Marshal as Marshal +import qualified LLVM.Extra.Nice.Value as NiceValue import qualified LLVM.Extra.Memory as Memory import qualified LLVM.Extra.MaybeContinuation as MaybeCont import qualified LLVM.Extra.Maybe as Maybe @@ -70,8 +72,8 @@ compile :: - (Storable.C a, MultiValue.T a ~ al, - Storable.C b, MultiValue.T b ~ bl, + (Storable.C a, NiceValue.T a ~ al, + Storable.C b, NiceValue.T b ~ bl, Marshal.C param, Marshal.Struct param ~ paramStruct) => (Exp param -> T al bl) -> IO (LLVM.Ptr paramStruct -> Word -> Ptr a -> Ptr b -> IO Word) @@ -93,8 +95,8 @@ runAux :: (Marshal.C p, - Storable.C a, MultiValue.T a ~ al, - Storable.C b, MultiValue.T b ~ bl) => + Storable.C a, NiceValue.T a ~ al, + Storable.C b, NiceValue.T b ~ bl) => (Exp p -> T al bl) -> IO (IO () -> p -> SV.Vector a -> IO (SV.Vector b)) runAux proc = do @@ -109,8 +111,8 @@ _run :: (Marshal.C p, - Storable.C a, MultiValue.T a ~ al, - Storable.C b, MultiValue.T b ~ bl) => + Storable.C a, NiceValue.T a ~ al, + Storable.C b, NiceValue.T b ~ bl) => (Exp p -> T al bl) -> IO (p -> SV.Vector a -> IO (SV.Vector b)) _run = fmap ($ return ()) . runAux @@ -125,8 +127,8 @@ Memory.C global, Memory.Struct global ~ globalStruct, Triple paramStruct globalStruct stateStruct ~ triple, LLVM.IsSized local, - Storable.C a, MultiValue.T a ~ valueA, - Storable.C b, MultiValue.T b ~ valueB) => + Storable.C a, NiceValue.T a ~ valueA, + Storable.C b, NiceValue.T b ~ valueB) => (forall r z. (Tuple.Phi z) => pPtr -> global -> LLVM.Value (LLVM.Ptr local) -> @@ -286,7 +288,7 @@ and thus to a processor of chunky storable vectors. -} processIOParametric :: - (Marshal.C p, Cut.Read a, x ~ LLVM.Value (LLVM.Ptr (Marshal.Struct p))) => + (Marshal.C p, Cut.Consume a, x ~ LLVM.Value (LLVM.Ptr (Marshal.Struct p))) => PIn.T a b -> Parametric.T x b c -> POut.T c d -> IO (Arg.Creator p -> PIO.T a d) processIOParametric @@ -324,7 +326,7 @@ (\(deleteContext, ptr) -> stopFunc ptr >> deleteContext) processIOCore :: - (Marshal.C p, Cut.Read a) => + (Marshal.C p, Cut.Consume a) => PIn.T a b -> (Exp p -> T b c) -> POut.T c d -> IO (Arg.Creator p -> PIO.T a d) processIOCore pin proc pout = do @@ -332,7 +334,7 @@ processIOParametric pin paramd pout processIO :: - (Marshal.C p, Cut.Read a, PIn.Default a, POut.Default d) => + (Marshal.C p, Cut.Consume a, PIn.Default a, POut.Default d) => (Exp p -> T (PIn.Element a) (POut.Element d)) -> IO (p -> PIO.T a d) processIO proc = @@ -346,21 +348,21 @@ type DSL f a b type In f type Out f - build :: (Marshal.C p) => Run.T (Plugs f a b) p (DSL f a b) f + function :: (Marshal.C p) => Run.T (Plugs f a b) p (DSL f a b) f -instance (Cut.Read a) => Run (PIO.T a b) where +instance (Cut.Consume a) => Run (PIO.T a b) where type DSL (PIO.T a b) al bl = T al bl type In (PIO.T a b) = a type Out (PIO.T a b) = b - build = + function = Run.Cons $ \proc -> MR.ReaderT $ \(pin,pout) -> processIOCore pin proc pout -instance (RunArg a, Run f) => Run (a -> f) where +instance (Argument a, Run f) => Run (a -> f) where type DSL (a -> f) al bl = DSLArg a -> DSL f al bl type In (a -> f) = In f type Out (a -> f) = Out f - build = buildArg *-> build + function = argument *-> function runPluggedExplicit :: @@ -371,7 +373,7 @@ runPlugged :: (Run f) => PIn.T (In f) a -> DSL f a b -> POut.T b (Out f) -> IO f -runPlugged = runPluggedExplicit build +runPlugged = runPluggedExplicit function run :: (Run f) => @@ -381,9 +383,9 @@ run proc = runPlugged PIn.deflt proc POut.deflt _exampleExplicit :: - (Exp Float -> Exp Word -> T (MultiValue.T Float) (MultiValue.T Word)) -> + (Exp Float -> Exp Word -> T (NiceValue.T Float) (NiceValue.T Word)) -> IO (Float -> Word -> PIO.T (SV.Vector Float) (SV.Vector Word)) _exampleExplicit proc = runPluggedExplicit - (Arg.primitive *-> Arg.primitive *-> build) + (Arg.primitive *-> Arg.primitive *-> function) PIn.storableVector proc POut.storableVector diff --git a/src/Synthesizer/LLVM/Causal/RingBufferForward.hs b/src/Synthesizer/LLVM/Causal/RingBufferForward.hs --- a/src/Synthesizer/LLVM/Causal/RingBufferForward.hs +++ b/src/Synthesizer/LLVM/Causal/RingBufferForward.hs @@ -17,7 +17,7 @@ import qualified LLVM.DSL.Expression as Expr import LLVM.DSL.Expression (Exp) -import qualified LLVM.Extra.Multi.Value as MultiValue +import qualified LLVM.Extra.Nice.Value as NiceValue import qualified LLVM.Extra.MaybeContinuation as MaybeCont import qualified LLVM.Extra.Maybe as Maybe import qualified LLVM.Extra.Memory as Memory @@ -82,8 +82,8 @@ 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) => MultiValue.T Word -> T a -> CodeGenFunction r a -index (MultiValue.Cons i) rb = do +index :: (Memory.C a) => NiceValue.T Word -> T a -> CodeGenFunction r a +index (NiceValue.Cons i) rb = do k <- flip A.irem (length rb) =<< A.add (current rb) i Memory.load =<< LLVM.getElementPtr (buffer rb) (k, ()) @@ -110,14 +110,14 @@ -} trackSkip :: (Memory.C a) => - Exp Word -> Sig.T a -> Causal.T (MultiValue.T Word) (T a) + Exp Word -> Sig.T a -> Causal.T (NiceValue.T Word) (T a) trackSkip time (Sig.Cons next start stop) = CausalPriv.Cons (trackNext next) (trackStart start time) (trackStop stop) <<^ - (\(MultiValue.Cons skip) -> skip) + (\(NiceValue.Cons skip) -> skip) {- | Like @trackSkip@ but repeats the last buffer content @@ -143,19 +143,19 @@ trackSkipHold :: (Memory.C a) => Exp Word -> Sig.T a -> - Causal.T (MultiValue.T Word) ((MultiValue.T Bool, MultiValue.T Word), T a) + Causal.T (NiceValue.T Word) ((NiceValue.T Bool, NiceValue.T Word), T a) trackSkipHold time xs = Arrow.first - (Arrow.second clearFirst <<^ mapPair (MultiValue.Cons, MultiValue.Cons)) + (Arrow.second clearFirst <<^ mapPair (NiceValue.Cons, NiceValue.Cons)) <<< trackSkipHold_ time xs <<^ - (\(MultiValue.Cons skip) -> skip) + (\(NiceValue.Cons skip) -> skip) clearFirst :: - (MultiValue.PseudoRing a, MultiValue.Real a, - MultiValue.IntegerConstant a, MultiValue.Select a) => - Causal.MV a a + (NiceValue.PseudoRing a, NiceValue.Real a, + NiceValue.IntegerConstant a, NiceValue.Select a) => + Causal.Nice a a clearFirst = Causal.zipWith (\b x -> Expr.select b x 0) $< (Causal.delay1 Expr.false $*# True) @@ -198,7 +198,7 @@ (Value Word, (state, Value Word))) trackStart start size = do (context, state) <- start - ~(MultiValue.Cons size0) <- Expr.unExp size + ~(NiceValue.Cons size0) <- Expr.unExp size ptr <- LLVM.arrayMalloc size0 return ((context, (size0,ptr)), (size0, (state, A.zero))) @@ -267,7 +267,7 @@ (Value Word, (Maybe.T state, Value Word))) trackStartHold start size = do (context, state) <- start - ~(MultiValue.Cons size0) <- Expr.unExp size + ~(NiceValue.Cons size0) <- Expr.unExp size ptr <- LLVM.arrayMalloc size0 return ((context, (size0,ptr)), (size0, (Maybe.just state, A.zero))) diff --git a/src/Synthesizer/LLVM/Complex.hs b/src/Synthesizer/LLVM/Complex.hs --- a/src/Synthesizer/LLVM/Complex.hs +++ b/src/Synthesizer/LLVM/Complex.hs @@ -11,8 +11,8 @@ import qualified Synthesizer.LLVM.Value as Value -import qualified LLVM.Extra.Multi.Value.Marshal as Marshal -import qualified LLVM.Extra.Multi.Value as MultiValue +import qualified LLVM.Extra.Nice.Value.Marshal as Marshal +import qualified LLVM.Extra.Nice.Value as NiceValue import qualified LLVM.Extra.Memory as Memory import qualified LLVM.Extra.Tuple as Tuple @@ -75,28 +75,28 @@ -instance (MultiValue.C a) => MultiValue.C (Complex.T a) where - type Repr (Complex.T a) = Complex.T (MultiValue.Repr a) +instance (NiceValue.C a) => NiceValue.C (Complex.T a) where + type Repr (Complex.T a) = Complex.T (NiceValue.Repr a) cons x = - consMV - (MultiValue.cons $ Complex.real x) - (MultiValue.cons $ Complex.imag x) - undef = consMV MultiValue.undef MultiValue.undef - zero = consMV MultiValue.zero MultiValue.zero + consNice + (NiceValue.cons $ Complex.real x) + (NiceValue.cons $ Complex.imag x) + undef = consNice NiceValue.undef NiceValue.undef + zero = consNice NiceValue.zero NiceValue.zero phi bb a = - case deconsMV a of - (a0,a1) -> liftA2 consMV (MultiValue.phi bb a0) (MultiValue.phi bb a1) + case deconsNice a of + (a0,a1) -> liftA2 consNice (NiceValue.phi bb a0) (NiceValue.phi bb a1) addPhi bb a b = - case (deconsMV a, deconsMV b) of + case (deconsNice a, deconsNice b) of ((a0,a1), (b0,b1)) -> - MultiValue.addPhi bb a0 b0 >> MultiValue.addPhi bb a1 b1 + NiceValue.addPhi bb a0 b0 >> NiceValue.addPhi bb a1 b1 -consMV :: MultiValue.T a -> MultiValue.T a -> MultiValue.T (Complex.T a) -consMV (MultiValue.Cons a) (MultiValue.Cons b) = MultiValue.Cons (a+:b) +consNice :: NiceValue.T a -> NiceValue.T a -> NiceValue.T (Complex.T a) +consNice (NiceValue.Cons a) (NiceValue.Cons b) = NiceValue.Cons (a+:b) -deconsMV :: MultiValue.T (Complex.T a) -> (MultiValue.T a, MultiValue.T a) -deconsMV (MultiValue.Cons x) = - (MultiValue.Cons $ Complex.real x, MultiValue.Cons $ Complex.imag x) +deconsNice :: NiceValue.T (Complex.T a) -> (NiceValue.T a, NiceValue.T a) +deconsNice (NiceValue.Cons x) = + (NiceValue.Cons $ Complex.real x, NiceValue.Cons $ Complex.imag x) instance (Marshal.C a) => Marshal.C (Complex.T a) where diff --git a/src/Synthesizer/LLVM/EventIterator.hs b/src/Synthesizer/LLVM/EventIterator.hs --- a/src/Synthesizer/LLVM/EventIterator.hs +++ b/src/Synthesizer/LLVM/EventIterator.hs @@ -6,7 +6,7 @@ import qualified Data.EventList.Relative.BodyTime as EventList import qualified Numeric.NonNegative.Wrapper as NonNeg -import qualified LLVM.Extra.Multi.Value.Marshal as Marshal +import qualified LLVM.Extra.Nice.Value.Marshal as Marshal import qualified LLVM.Core as LLVM import Foreign.StablePtr diff --git a/src/Synthesizer/LLVM/Filter/Allpass.hs b/src/Synthesizer/LLVM/Filter/Allpass.hs --- a/src/Synthesizer/LLVM/Filter/Allpass.hs +++ b/src/Synthesizer/LLVM/Filter/Allpass.hs @@ -10,7 +10,7 @@ module Synthesizer.LLVM.Filter.Allpass ( Parameter, Allpass.parameter, CascadeParameter(CascadeParameter), flangerParameter, - cascadeParameterMultiValue, cascadeParameterUnMultiValue, + niceValueCascadeParameter, unNiceValueCascadeParameter, causal, cascade, phaser, cascadePipeline, phaserPipeline, causalPacked, cascadePacked, phaserPacked, @@ -29,9 +29,9 @@ import qualified LLVM.DSL.Expression as Expr -import qualified LLVM.Extra.Multi.Value.Marshal as MarshalMV -import qualified LLVM.Extra.Multi.Vector as MultiVector -import qualified LLVM.Extra.Multi.Value as MultiValue +import qualified LLVM.Extra.Nice.Value.Marshal as MarshalNice +import qualified LLVM.Extra.Nice.Vector as NiceVector +import qualified LLVM.Extra.Nice.Value as NiceValue import qualified LLVM.Extra.Vector as Vector import qualified LLVM.Extra.Scalar as Scalar import qualified LLVM.Extra.Storable as Storable @@ -71,10 +71,10 @@ zero = Tuple.zeroPointed instance - (Expr.Aggregate e mv) => - Expr.Aggregate (Parameter e) (Parameter mv) where - type MultiValuesOf (Parameter e) = Parameter (Expr.MultiValuesOf e) - type ExpressionsOf (Parameter mv) = Parameter (Expr.ExpressionsOf mv) + (Expr.Aggregate e nv) => + Expr.Aggregate (Parameter e) (Parameter nv) where + type NiceValuesOf (Parameter e) = Parameter (Expr.NiceValuesOf e) + type ExpressionsOf (Parameter nv) = Parameter (Expr.ExpressionsOf nv) bundle = Trav.traverse Expr.bundle dissect = fmap Expr.dissect @@ -89,9 +89,9 @@ pack (Parameter k) = Marshal.pack k unpack = Parameter . Marshal.unpack -instance (MarshalMV.C a) => MarshalMV.C (Parameter a) where - pack (Parameter k) = MarshalMV.pack k - unpack = Parameter . MarshalMV.unpack +instance (MarshalNice.C a) => MarshalNice.C (Parameter a) where + pack (Parameter k) = MarshalNice.pack k + unpack = Parameter . MarshalNice.unpack instance (Storable.C a) => Storable.C (Parameter a) where load = Storable.loadNewtype Parameter Parameter @@ -106,72 +106,72 @@ 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 (Parameter a) = Parameter (MultiValue.Repr a) - cons = paramFromPlainValue . MultiValue.cons . Allpass.getParameter +instance (NiceValue.C a) => NiceValue.C (Allpass.Parameter a) where + type Repr (Parameter a) = Parameter (NiceValue.Repr a) + cons = paramFromPlainValue . NiceValue.cons . Allpass.getParameter - undef = paramFromPlainValue MultiValue.undef - zero = paramFromPlainValue MultiValue.zero + undef = paramFromPlainValue NiceValue.undef + zero = paramFromPlainValue NiceValue.zero phi bb = fmap paramFromPlainValue . - MultiValue.phi bb . + NiceValue.phi bb . plainFromParamValue addPhi bb a b = - MultiValue.addPhi bb + NiceValue.addPhi bb (plainFromParamValue a) (plainFromParamValue b) -instance (MultiVector.C a) => MultiVector.C (Allpass.Parameter a) where - type Repr n (Parameter a) = Parameter (MultiVector.Repr n a) - cons = paramFromPlainVector . MultiVector.cons . fmap Allpass.getParameter - undef = paramFromPlainVector MultiVector.undef - zero = paramFromPlainVector MultiVector.zero +instance (NiceVector.C a) => NiceVector.C (Allpass.Parameter a) where + type Repr n (Parameter a) = Parameter (NiceVector.Repr n a) + cons = paramFromPlainVector . NiceVector.cons . fmap Allpass.getParameter + undef = paramFromPlainVector NiceVector.undef + zero = paramFromPlainVector NiceVector.zero phi bb = fmap paramFromPlainVector . - MultiVector.phi bb . + NiceVector.phi bb . plainFromParamVector addPhi bb a b = - MultiVector.addPhi bb + NiceVector.addPhi bb (plainFromParamVector a) (plainFromParamVector b) shuffle is a b = fmap paramFromPlainVector $ - MultiVector.shuffle is (plainFromParamVector a) (plainFromParamVector b) + NiceVector.shuffle is (plainFromParamVector a) (plainFromParamVector b) extract i v = fmap paramFromPlainValue $ - MultiVector.extract i $ + NiceVector.extract i $ plainFromParamVector v insert i a v = fmap paramFromPlainVector $ - MultiVector.insert i (plainFromParamValue a) $ + NiceVector.insert i (plainFromParamValue a) $ plainFromParamVector v paramFromPlainVector :: - MultiVector.T n a -> - MultiVector.T n (Allpass.Parameter a) + NiceVector.T n a -> + NiceVector.T n (Allpass.Parameter a) paramFromPlainVector = - MultiVector.lift1 Allpass.Parameter + NiceVector.lift1 Allpass.Parameter plainFromParamVector :: - MultiVector.T n (Allpass.Parameter a) -> - MultiVector.T n a + NiceVector.T n (Allpass.Parameter a) -> + NiceVector.T n a plainFromParamVector = - MultiVector.lift1 Allpass.getParameter + NiceVector.lift1 Allpass.getParameter paramFromPlainValue :: - MultiValue.T a -> - MultiValue.T (Allpass.Parameter a) + NiceValue.T a -> + NiceValue.T (Allpass.Parameter a) paramFromPlainValue = - MultiValue.lift1 Allpass.Parameter + NiceValue.lift1 Allpass.Parameter plainFromParamValue :: - MultiValue.T (Allpass.Parameter a) -> - MultiValue.T a + NiceValue.T (Allpass.Parameter a) -> + NiceValue.T a plainFromParamValue = - MultiValue.lift1 Allpass.getParameter + NiceValue.lift1 Allpass.getParameter instance (Vector.Simple v) => Vector.Simple (Parameter v) where @@ -210,9 +210,9 @@ pack (CascadeParameter k) = Marshal.pack k unpack = CascadeParameter . Marshal.unpack -instance (MarshalMV.C a) => MarshalMV.C (CascadeParameter n a) where - pack (CascadeParameter k) = MarshalMV.pack k - unpack = CascadeParameter . MarshalMV.unpack +instance (MarshalNice.C a) => MarshalNice.C (CascadeParameter n a) where + pack (CascadeParameter k) = MarshalNice.pack k + unpack = CascadeParameter . MarshalNice.unpack instance (Storable.C a) => Storable.C (CascadeParameter n a) where load = Storable.loadNewtype CascadeParameter id @@ -231,71 +231,71 @@ vectorValueOf = fmap Tuple.vectorValueOf . Trav.traverse (\(CascadeParameter k) -> k) -instance (MultiValue.C a) => MultiValue.C (CascadeParameter n a) where - type Repr (CascadeParameter n a) = Parameter (MultiValue.Repr a) - cons (CascadeParameter a) = cascadeFromParamValue $ MultiValue.cons a +instance (NiceValue.C a) => NiceValue.C (CascadeParameter n a) where + type Repr (CascadeParameter n a) = Parameter (NiceValue.Repr a) + cons (CascadeParameter a) = cascadeFromParamValue $ NiceValue.cons a - undef = cascadeFromParamValue MultiValue.undef - zero = cascadeFromParamValue MultiValue.zero + undef = cascadeFromParamValue NiceValue.undef + zero = cascadeFromParamValue NiceValue.zero phi bb = fmap cascadeFromParamValue . - MultiValue.phi bb . + NiceValue.phi bb . paramFromCascadeValue addPhi bb a b = - MultiValue.addPhi bb + NiceValue.addPhi bb (paramFromCascadeValue a) (paramFromCascadeValue b) -instance (MultiVector.C a) => MultiVector.C (CascadeParameter m a) where - type Repr n (CascadeParameter m a) = Parameter (MultiVector.Repr n a) +instance (NiceVector.C a) => NiceVector.C (CascadeParameter m a) where + type Repr n (CascadeParameter m a) = Parameter (NiceVector.Repr n a) cons = - cascadeFromParamVector . MultiVector.cons . + cascadeFromParamVector . NiceVector.cons . fmap (\(CascadeParameter a) -> a) - undef = cascadeFromParamVector MultiVector.undef - zero = cascadeFromParamVector MultiVector.zero + undef = cascadeFromParamVector NiceVector.undef + zero = cascadeFromParamVector NiceVector.zero phi bb = fmap cascadeFromParamVector . - MultiVector.phi bb . + NiceVector.phi bb . paramFromCascadeVector addPhi bb a b = - MultiVector.addPhi bb + NiceVector.addPhi bb (paramFromCascadeVector a) (paramFromCascadeVector b) shuffle is a b = fmap cascadeFromParamVector $ - MultiVector.shuffle is + NiceVector.shuffle is (paramFromCascadeVector a) (paramFromCascadeVector b) extract i v = fmap cascadeFromParamValue $ - MultiVector.extract i $ + NiceVector.extract i $ paramFromCascadeVector v insert i a v = fmap cascadeFromParamVector $ - MultiVector.insert i (paramFromCascadeValue a) $ + NiceVector.insert i (paramFromCascadeValue a) $ paramFromCascadeVector v cascadeFromParamVector :: - MultiVector.T n (Allpass.Parameter a) -> - MultiVector.T n (CascadeParameter m a) -cascadeFromParamVector = MultiVector.lift1 id + NiceVector.T n (Allpass.Parameter a) -> + NiceVector.T n (CascadeParameter m a) +cascadeFromParamVector = NiceVector.lift1 id paramFromCascadeVector :: - MultiVector.T n (CascadeParameter m a) -> - MultiVector.T n (Allpass.Parameter a) -paramFromCascadeVector = MultiVector.lift1 id + NiceVector.T n (CascadeParameter m a) -> + NiceVector.T n (Allpass.Parameter a) +paramFromCascadeVector = NiceVector.lift1 id cascadeFromParamValue :: - MultiValue.T (Allpass.Parameter a) -> - MultiValue.T (CascadeParameter m a) -cascadeFromParamValue = MultiValue.lift1 id + NiceValue.T (Allpass.Parameter a) -> + NiceValue.T (CascadeParameter m a) +cascadeFromParamValue = NiceValue.lift1 id paramFromCascadeValue :: - MultiValue.T (CascadeParameter m a) -> - MultiValue.T (Allpass.Parameter a) -paramFromCascadeValue = MultiValue.lift1 id + NiceValue.T (CascadeParameter m a) -> + NiceValue.T (Allpass.Parameter a) +paramFromCascadeValue = NiceValue.lift1 id instance (Vector.Simple v) => Vector.Simple (CascadeParameter n v) where @@ -313,12 +313,12 @@ instance - (Expr.Aggregate e mv, n ~ m) => - Expr.Aggregate (CascadeParameter n e) (CascadeParameter m mv) where - type MultiValuesOf (CascadeParameter n e) = - CascadeParameter n (Expr.MultiValuesOf e) - type ExpressionsOf (CascadeParameter m mv) = - CascadeParameter m (Expr.ExpressionsOf mv) + (Expr.Aggregate e nv, n ~ m) => + Expr.Aggregate (CascadeParameter n e) (CascadeParameter m nv) where + type NiceValuesOf (CascadeParameter n e) = + CascadeParameter n (Expr.NiceValuesOf e) + type ExpressionsOf (CascadeParameter m nv) = + CascadeParameter m (Expr.ExpressionsOf nv) bundle = Trav.traverse Expr.bundle dissect = fmap Expr.dissect @@ -373,24 +373,24 @@ paramFromCascadeParam :: - MultiValue.T (CascadeParameter n a) -> - Allpass.Parameter (MultiValue.T a) -paramFromCascadeParam (MultiValue.Cons a) = - fmap MultiValue.Cons a + NiceValue.T (CascadeParameter n a) -> + Allpass.Parameter (NiceValue.T a) +paramFromCascadeParam (NiceValue.Cons a) = + fmap NiceValue.Cons a {- It shouldn't be too hard to use vector operations for the code we generate, but LLVM-2.6 does not yet do it. -} stage :: - (TypeNum.Positive n, MultiVector.C a, - MultiVector.T n (CascadeParameter n a, a) ~ v, - MultiValue.PseudoRing a, MultiValue.IntegerConstant a, - MarshalMV.C a) => + (TypeNum.Positive n, NiceVector.C a, + NiceVector.T n (CascadeParameter n a, a) ~ v, + NiceValue.PseudoRing a, NiceValue.IntegerConstant a, + MarshalNice.C a) => Proxy n -> Causal.T v v stage _ = Causal.vectorize $ - uncurry MultiValue.zip + uncurry NiceValue.zip ^<< (arr fst &&& (Scalar.decons @@ -400,11 +400,11 @@ (\(p, v) -> (fmap Scalar.Cons $ paramFromCascadeParam p, Scalar.Cons v)))) <<^ - MultiValue.unzip + NiceValue.unzip withSize :: - (Proxy n -> Causal.T (mv (CascadeParameter n a), b) c) -> - Causal.T (mv (CascadeParameter n a), b) c + (Proxy n -> Causal.T (nv (CascadeParameter n a), b) c) -> + Causal.T (nv (CascadeParameter n a), b) c withSize f = f Proxy {- | @@ -414,22 +414,22 @@ and we get a delay by the number of pipeline stages. -} cascadePipeline :: - (TypeNum.Positive n, MultiVector.C a, + (TypeNum.Positive n, NiceVector.C a, Tuple.ValueOf a ~ ar, - MultiValue.PseudoRing a, MultiValue.IntegerConstant a, - MarshalMV.C a, MarshalMV.Vector n a) => + NiceValue.PseudoRing a, NiceValue.IntegerConstant a, + MarshalNice.C a, MarshalNice.Vector n a) => Causal.T - (MultiValue.T (CascadeParameter n a), MultiValue.T a) - (MultiValue.T a) + (NiceValue.T (CascadeParameter n a), NiceValue.T a) + (NiceValue.T a) cascadePipeline = withSize $ \order -> - MultiValue.snd + NiceValue.snd ^<< Causal.pipeline (stage order) <<^ - uncurry MultiValue.zip + uncurry NiceValue.zip vectorId :: - Proxy n -> Causal.T (MultiVector.T n a) (MultiVector.T n a) + Proxy n -> Causal.T (NiceVector.T n a) (NiceVector.T n a) vectorId _ = Cat.id half :: @@ -472,28 +472,27 @@ second (CausalPriv.map (A.mul (A.fromRational' 0.5))) --- ToDo: consistent naming with Exponential2 -cascadeParameterMultiValue :: - CascadeParameter n (MultiValue.T a) -> - MultiValue.T (CascadeParameter n a) -cascadeParameterMultiValue (CascadeParameter k) = - MultiValue.Cons $ fmap (\(MultiValue.Cons a) -> a) k +niceValueCascadeParameter :: + CascadeParameter n (NiceValue.T a) -> + NiceValue.T (CascadeParameter n a) +niceValueCascadeParameter (CascadeParameter k) = + NiceValue.Cons $ fmap (\(NiceValue.Cons a) -> a) k -cascadeParameterUnMultiValue :: - MultiValue.T (CascadeParameter n a) -> - CascadeParameter n (MultiValue.T a) -cascadeParameterUnMultiValue (MultiValue.Cons k) = - CascadeParameter $ fmap MultiValue.Cons k +unNiceValueCascadeParameter :: + NiceValue.T (CascadeParameter n a) -> + CascadeParameter n (NiceValue.T a) +unNiceValueCascadeParameter (NiceValue.Cons k) = + CascadeParameter $ fmap NiceValue.Cons k -phaserPipelineMV :: +phaserPipelineNice :: (TypeNum.Positive n, - MultiValue.PseudoRing a, MultiValue.RationalConstant a, - Marshal.C a, MarshalMV.Vector n a) => + NiceValue.PseudoRing a, NiceValue.RationalConstant a, + Marshal.C a, MarshalNice.Vector n a) => Causal.T - (MultiValue.T (CascadeParameter n a), MultiValue.T a) - (MultiValue.T a) -phaserPipelineMV = withSize $ \order -> + (NiceValue.T (CascadeParameter n a), NiceValue.T a) + (NiceValue.T a) +phaserPipelineNice = withSize $ \order -> Causal.mix <<< cascadePipeline &&& (Causal.pipeline (vectorId order) <<^ snd) <<< @@ -502,9 +501,9 @@ phaserPipeline :: (TypeNum.Positive n, - MultiValue.PseudoRing a, MultiValue.RationalConstant a, - Marshal.C a, MarshalMV.Vector n a) => + NiceValue.PseudoRing a, NiceValue.RationalConstant a, + Marshal.C a, MarshalNice.Vector n a) => Causal.T - (CascadeParameter n (MultiValue.T a), MultiValue.T a) - (MultiValue.T a) -phaserPipeline = phaserPipelineMV <<^ mapFst cascadeParameterMultiValue + (CascadeParameter n (NiceValue.T a), NiceValue.T a) + (NiceValue.T a) +phaserPipeline = phaserPipelineNice <<^ mapFst niceValueCascadeParameter diff --git a/src/Synthesizer/LLVM/Filter/Butterworth.hs b/src/Synthesizer/LLVM/Filter/Butterworth.hs --- a/src/Synthesizer/LLVM/Filter/Butterworth.hs +++ b/src/Synthesizer/LLVM/Filter/Butterworth.hs @@ -19,8 +19,8 @@ import qualified LLVM.DSL.Expression as Expr -import qualified LLVM.Extra.Multi.Value.Marshal as Marshal -import qualified LLVM.Extra.Multi.Value as MultiValue +import qualified LLVM.Extra.Nice.Value.Marshal as Marshal +import qualified LLVM.Extra.Nice.Value as NiceValue import qualified LLVM.Extra.Memory as Memory import qualified LLVM.Extra.Arithmetic as A import qualified LLVM.Extra.Control as U @@ -45,9 +45,9 @@ (TypeNum.Positive (n :*: LLVM.SizeOf (Marshal.Struct a)), TypeNum.Natural (n :*: LLVM.UnknownSize), TypeNum.Natural n, Trans.C a, - Marshal.C a, MultiValue.RationalConstant a, MultiValue.Transcendental a) => + Marshal.C a, NiceValue.RationalConstant a, NiceValue.Transcendental a) => Proxy n -> Passband -> - Causal.T (MultiValue.T a, MultiValue.T a) (Cascade.ParameterValue n a) + Causal.T (NiceValue.T a, NiceValue.T a) (Cascade.ParameterValue n a) parameterCausal n kind = Causal.map (\((psine, ps), (ratio, freq)) -> @@ -59,8 +59,8 @@ (TypeNum.Positive (n :*: LLVM.SizeOf (Marshal.Struct a)), TypeNum.Natural (n :*: LLVM.UnknownSize), TypeNum.Natural n, Trans.C a, - Marshal.C a, MultiValue.RationalConstant a, MultiValue.Transcendental a) => - Proxy n -> Passband -> MultiValue.T a -> MultiValue.T a -> + Marshal.C a, NiceValue.RationalConstant a, NiceValue.Transcendental a) => + Proxy n -> Passband -> NiceValue.T a -> NiceValue.T a -> LLVM.CodeGenFunction r (Cascade.ParameterValue n a) parameter n kind ratio freq = do psine <- LLVM.malloc @@ -74,16 +74,16 @@ (TypeNum.Positive (n :*: LLVM.SizeOf (Marshal.Struct a)), TypeNum.Natural (n :*: LLVM.UnknownSize), TypeNum.Natural n, Trans.C a, - Marshal.C a, MultiValue.RationalConstant a, MultiValue.Transcendental a) => + Marshal.C a, NiceValue.RationalConstant a, NiceValue.Transcendental a) => Proxy n -> Passband -> - LLVM.Value (LLVM.Ptr (Marshal.Struct (MultiValue.Array n a))) -> + LLVM.Value (LLVM.Ptr (Marshal.Struct (NiceValue.Array n a))) -> LLVM.Value (LLVM.Ptr (Cascade.ParameterStruct n a)) -> - MultiValue.T a -> MultiValue.T a -> + NiceValue.T a -> NiceValue.T a -> LLVM.CodeGenFunction r (Cascade.ParameterValue n a) parameterCore n kind psine ps ratio freq = do let order = 2 * TypeNum.integralFromProxy n partialRatio <- Expr.unliftM1 (Butterworth.partialRatio order) ratio - let evalSines :: (Trans.C a) => mv a -> Int -> [a] + let evalSines :: (Trans.C a) => nv a -> Int -> [a] evalSines _ = Butterworth.makeSines let sines = Cascade.constArray n $ evalSines freq order Memory.store sines psine @@ -93,7 +93,7 @@ _ <- U.arrayLoop len p s $ \ptri si -> do sinw <- Memory.load si flip Memory.store ptri =<< - Filt2.composeParameterMV =<< + Filt2.composeParameterNice =<< Expr.unliftM3 (Butterworth.partialParameter kind) partialRatio sinw freq A.advanceArrayElementPtr si diff --git a/src/Synthesizer/LLVM/Filter/Chebyshev.hs b/src/Synthesizer/LLVM/Filter/Chebyshev.hs --- a/src/Synthesizer/LLVM/Filter/Chebyshev.hs +++ b/src/Synthesizer/LLVM/Filter/Chebyshev.hs @@ -21,8 +21,8 @@ import qualified LLVM.DSL.Expression as Expr -import qualified LLVM.Extra.Multi.Value.Marshal as Marshal -import qualified LLVM.Extra.Multi.Value as MultiValue +import qualified LLVM.Extra.Nice.Value.Marshal as Marshal +import qualified LLVM.Extra.Nice.Value as NiceValue import qualified LLVM.Extra.Memory as Memory import qualified LLVM.Extra.Arithmetic as A import qualified LLVM.Extra.Control as U @@ -53,11 +53,11 @@ -} parameterCausalA, parameterCausalB :: (TypeNum.Natural n, Trans.C a, - Marshal.C a, MultiValue.RationalConstant a, MultiValue.Transcendental a) => + Marshal.C a, NiceValue.RationalConstant a, NiceValue.Transcendental a) => (TypeNum.Positive (n :*: LLVM.SizeOf (Marshal.Struct a)), TypeNum.Positive (n :*: LLVM.UnknownSize)) => Proxy n -> Passband -> - Causal.T (MultiValue.T a, MultiValue.T a) (Cascade.ParameterValue n a) + Causal.T (NiceValue.T a, NiceValue.T a) (Cascade.ParameterValue n a) parameterCausalA n kind = Causal.map (\((psine, ps), (ratio, freq)) -> @@ -82,10 +82,10 @@ parameterA, parameterB :: (TypeNum.Natural n, Trans.C a, - Marshal.C a, MultiValue.RationalConstant a, MultiValue.Transcendental a) => + Marshal.C a, NiceValue.RationalConstant a, NiceValue.Transcendental a) => (TypeNum.Positive (n :*: LLVM.SizeOf (Marshal.Struct a)), TypeNum.Positive (n :*: LLVM.UnknownSize)) => - Proxy n -> Passband -> MultiValue.T a -> MultiValue.T a -> + Proxy n -> Passband -> NiceValue.T a -> NiceValue.T a -> LLVM.CodeGenFunction r (Cascade.ParameterValue n a) parameterA n kind ratio freq = withArrays $ \psine ps -> @@ -115,31 +115,31 @@ -- | adjust amplification of the first filter adjustAmplitude :: (TypeNum.Natural n, Filt2.Parameter a ~ filt2, - Marshal.C a, MultiValue.IntegerConstant a, MultiValue.PseudoRing a) => - MultiValue.T a -> MultiValue.T (MultiValue.Array n filt2) -> - LLVM.CodeGenFunction r (MultiValue.T (MultiValue.Array n filt2)) -adjustAmplitude ratio (MultiValue.Cons pv) = do - filt0 <- Filt2.decomposeParameterMV =<< LLVM.extractvalue pv (0::Word) - fmap MultiValue.Cons $ + Marshal.C a, NiceValue.IntegerConstant a, NiceValue.PseudoRing a) => + NiceValue.T a -> NiceValue.T (NiceValue.Array n filt2) -> + LLVM.CodeGenFunction r (NiceValue.T (NiceValue.Array n filt2)) +adjustAmplitude ratio (NiceValue.Cons pv) = do + filt0 <- Filt2.decomposeParameterNice =<< LLVM.extractvalue pv (0::Word) + fmap NiceValue.Cons $ flip (LLVM.insertvalue pv) (0::Word) =<< - Filt2.composeParameterMV =<< + Filt2.composeParameterNice =<< Expr.unliftM2 Filt2Core.amplify ratio filt0 parameter :: (TypeNum.Positive (n :*: LLVM.SizeOf (Marshal.Struct a)), TypeNum.Positive (n :*: LLVM.UnknownSize), TypeNum.Natural n, Trans.C a, - Marshal.C a, MultiValue.RationalConstant a, MultiValue.Transcendental a, + Marshal.C a, NiceValue.RationalConstant a, NiceValue.Transcendental a, Expr.Exp a ~ ae) => (Passband -> Int -> ae -> Complex.T ae -> ae -> Filt2Core.Parameter ae) -> Proxy n -> Passband -> - LLVM.Value (LLVM.Ptr (Marshal.Struct (MultiValue.Array n (Complex.T a)))) -> + LLVM.Value (LLVM.Ptr (Marshal.Struct (NiceValue.Array n (Complex.T a)))) -> LLVM.Value (LLVM.Ptr (Cascade.ParameterStruct n a)) -> - MultiValue.T a -> MultiValue.T a -> - LLVM.CodeGenFunction r (MultiValue.T (Cascade.Parameter n a)) + NiceValue.T a -> NiceValue.T a -> + LLVM.CodeGenFunction r (NiceValue.T (Cascade.Parameter n a)) parameter partialParameter n kind psine ps ratio freq = do let order = TypeNum.integralFromProxy n - let evalSines :: (Trans.C a) => mv a -> Int -> [Complex.T a] + let evalSines :: (Trans.C a) => nv a -> Int -> [Complex.T a] evalSines _ = Chebyshev.makeCirclePoints let sines = Cascade.constArray n $ evalSines freq order Memory.store sines psine @@ -149,7 +149,7 @@ _ <- U.arrayLoop len p s $ \ptri si -> do c <- Memory.load si flip Memory.store ptri =<< - Filt2.composeParameterMV =<< + Filt2.composeParameterNice =<< Expr.unliftM3 (partialParameter kind order) ratio c freq A.advanceArrayElementPtr si diff --git a/src/Synthesizer/LLVM/Filter/ComplexFirstOrder.hs b/src/Synthesizer/LLVM/Filter/ComplexFirstOrder.hs --- a/src/Synthesizer/LLVM/Filter/ComplexFirstOrder.hs +++ b/src/Synthesizer/LLVM/Filter/ComplexFirstOrder.hs @@ -98,10 +98,10 @@ unfoldCode = Value.unfoldCodeTraversable instance - (Expr.Aggregate e mv) => - Expr.Aggregate (Parameter e) (Parameter mv) where - type MultiValuesOf (Parameter e) = Parameter (Expr.MultiValuesOf e) - type ExpressionsOf (Parameter mv) = Parameter (Expr.ExpressionsOf mv) + (Expr.Aggregate e nv) => + Expr.Aggregate (Parameter e) (Parameter nv) where + type NiceValuesOf (Parameter e) = Parameter (Expr.NiceValuesOf e) + type ExpressionsOf (Parameter nv) = Parameter (Expr.ExpressionsOf nv) bundle = Trav.traverse Expr.bundle dissect = fmap Expr.dissect diff --git a/src/Synthesizer/LLVM/Filter/ComplexFirstOrderPacked.hs b/src/Synthesizer/LLVM/Filter/ComplexFirstOrderPacked.hs --- a/src/Synthesizer/LLVM/Filter/ComplexFirstOrderPacked.hs +++ b/src/Synthesizer/LLVM/Filter/ComplexFirstOrderPacked.hs @@ -7,7 +7,7 @@ {-# LANGUAGE Rank2Types #-} module Synthesizer.LLVM.Filter.ComplexFirstOrderPacked ( Parameter(Parameter), parameterPlain, parameter, causal, - ParameterMV, + ParameterNice, ) where import qualified Synthesizer.LLVM.Filter.ComplexFirstOrder as ComplexFilter @@ -19,9 +19,9 @@ import qualified LLVM.DSL.Expression as Expr import LLVM.DSL.Expression (Exp(Exp)) -import qualified LLVM.Extra.Multi.Value.Marshal as Marshal -import qualified LLVM.Extra.Multi.Value as MultiValue -import qualified LLVM.Extra.Multi.Vector as MultiVector +import qualified LLVM.Extra.Nice.Value.Marshal as Marshal +import qualified LLVM.Extra.Nice.Value as NiceValue +import qualified LLVM.Extra.Nice.Vector as NiceVector import qualified LLVM.Extra.Arithmetic as A import qualified LLVM.Extra.Memory as Memory import qualified LLVM.Extra.Tuple as Tuple @@ -42,35 +42,35 @@ data Parameter a = Parameter (LLVM.Vector D3 a) (LLVM.Vector D3 a) -data ParameterMV a = ParameterMV (MultiVector.T D3 a) (MultiVector.T D3 a) +data ParameterNice a = ParameterNice (NiceVector.T D3 a) (NiceVector.T D3 a) -instance (MultiVector.C a) => Tuple.Phi (ParameterMV a) where - phi bb (ParameterMV r i) = do +instance (NiceVector.C a) => Tuple.Phi (ParameterNice a) where + phi bb (ParameterNice r i) = do r' <- Tuple.phi bb r i' <- Tuple.phi bb i - return (ParameterMV r' i') + return (ParameterNice r' i') addPhi bb - (ParameterMV r i) - (ParameterMV r' i') = do + (ParameterNice r i) + (ParameterNice r' i') = do Tuple.addPhi bb r r' Tuple.addPhi bb i i' -instance (MultiVector.C a) => Tuple.Undefined (ParameterMV a) where - undef = ParameterMV Tuple.undef Tuple.undef +instance (NiceVector.C a) => Tuple.Undefined (ParameterNice a) where + undef = ParameterNice Tuple.undef Tuple.undef type ParameterStruct a = Marshal.Struct (LLVM.Vector D3 a, LLVM.Vector D3 a) parameterMemory :: (Marshal.Vector D3 a) => - Memory.Record r (ParameterStruct a) (ParameterMV a) + Memory.Record r (ParameterStruct a) (ParameterNice a) parameterMemory = - liftA2 ParameterMV - (Memory.element (\(ParameterMV kr _) -> kr) d0) - (Memory.element (\(ParameterMV _ ki) -> ki) d1) + liftA2 ParameterNice + (Memory.element (\(ParameterNice kr _) -> kr) d0) + (Memory.element (\(ParameterNice _ ki) -> ki) d1) -instance (Marshal.Vector D3 a) => Memory.C (ParameterMV a) where - type Struct (ParameterMV a) = ParameterStruct a +instance (Marshal.Vector D3 a) => Memory.C (ParameterNice a) where + type Struct (ParameterNice a) = ParameterStruct a load = Memory.loadRecord parameterMemory store = Memory.storeRecord parameterMemory decompose = Memory.decomposeRecord parameterMemory @@ -78,11 +78,11 @@ data ParameterExp a = - ParameterExp (forall r. LLVM.CodeGenFunction r (ParameterMV a)) + ParameterExp (forall r. LLVM.CodeGenFunction r (ParameterNice a)) -instance Expr.Aggregate (ParameterExp a) (ParameterMV a) where - type MultiValuesOf (ParameterExp a) = ParameterMV a - type ExpressionsOf (ParameterMV a) = ParameterExp a +instance Expr.Aggregate (ParameterExp a) (ParameterNice a) where + type NiceValuesOf (ParameterExp a) = ParameterNice a + type ExpressionsOf (ParameterNice a) = ParameterExp a dissect x = ParameterExp (return x) bundle (ParameterExp code) = code @@ -97,7 +97,7 @@ (LLVM.consVector ki kr amp) parameter :: - (MultiVector.Transcendental a, MultiVector.RationalConstant a) => + (NiceVector.Transcendental a, NiceVector.RationalConstant a) => Exp a -> Exp a -> ParameterExp a parameter (Exp reson) (Exp freq) = ParameterExp (do @@ -107,31 +107,31 @@ let kr = Complex.real k let ki = Complex.imag k kin <- A.neg ki - liftA2 ParameterMV - (MultiVector.assembleFromVector $ LLVM.consVector kr kin amp) - (MultiVector.assembleFromVector $ LLVM.consVector ki kr amp)) + liftA2 ParameterNice + (NiceVector.consVarArg kr kin amp) + (NiceVector.consVarArg ki kr amp)) -type State a = MultiVector.T D3 a +type State a = NiceVector.T D3 a next :: - (MultiVector.PseudoRing a) => - (ParameterMV a, Stereo.T (MultiValue.T a)) -> - State a -> LLVM.CodeGenFunction r (Stereo.T (MultiValue.T a), State a) -next (ParameterMV kr ki, x) s = do + (NiceVector.PseudoRing a) => + (ParameterNice a, Stereo.T (NiceValue.T a)) -> + State a -> LLVM.CodeGenFunction r (Stereo.T (NiceValue.T a), State a) +next (ParameterNice kr ki, x) s = do let two = LLVM.valueOf 2 - sr <- MultiVector.insert two (Stereo.left x) s - yr <- MultiVector.dotProduct kr sr + sr <- NiceVector.insert two (Stereo.left x) s + yr <- NiceVector.dotProduct kr sr - si <- MultiVector.insert two (Stereo.right x) s - yi <- MultiVector.dotProduct ki si + si <- NiceVector.insert two (Stereo.right x) s + yi <- NiceVector.dotProduct ki si - sv <- MultiVector.assembleFromVector $ LLVM.consVector yr yi Tuple.undef + sv <- NiceVector.consVarArg yr yi Tuple.undef return (Stereo.cons yr yi, sv) causal :: - (Marshal.Vector n a, n ~ D3, MultiVector.PseudoRing a) => + (Marshal.Vector n a, n ~ D3, NiceVector.PseudoRing a) => Causal.T - (ParameterMV a, Stereo.T (MultiValue.T a)) - (Stereo.T (MultiValue.T a)) + (ParameterNice a, Stereo.T (NiceValue.T a)) + (Stereo.T (NiceValue.T a)) causal = Causal.mapAccum next (return A.zero) diff --git a/src/Synthesizer/LLVM/Filter/FirstOrder.hs b/src/Synthesizer/LLVM/Filter/FirstOrder.hs --- a/src/Synthesizer/LLVM/Filter/FirstOrder.hs +++ b/src/Synthesizer/LLVM/Filter/FirstOrder.hs @@ -23,6 +23,7 @@ import qualified LLVM.DSL.Expression as Expr +import qualified LLVM.Extra.Nice.Value as NiceValue import qualified LLVM.Extra.Tuple as Tuple import qualified LLVM.Extra.Memory as Memory import qualified LLVM.Extra.Arithmetic as A @@ -31,8 +32,11 @@ import Control.Arrow (arr, (&&&), (<<<)) import Control.Monad (foldM) -import Control.Applicative (liftA2) +import Control.Applicative (liftA2, pure) +import qualified Data.Foldable as Fold +import Data.Traversable (traverse) + import qualified Algebra.Module as Module import NumericPrelude.Numeric @@ -54,18 +58,57 @@ compose = Memory.composeNewtype (\(Parameter k) -> k) +instance (NiceValue.C a) => NiceValue.C (Parameter a) where + type Repr (Parameter a) = Parameter (NiceValue.Repr a) + cons = niceValueParameter . fmap NiceValue.cons + undef = niceValueParameter $ pure NiceValue.undef + zero = niceValueParameter $ pure NiceValue.zero + phi bb = + fmap niceValueParameter . + traverse (NiceValue.phi bb) . unNiceValueParameter + addPhi bb a b = + Fold.sequence_ $ + liftA2 (NiceValue.addPhi bb) + (unNiceValueParameter a) (unNiceValueParameter b) + +instance (NiceValue.Compose a) => NiceValue.Compose (Parameter a) where + type Composed (Parameter a) = Parameter (NiceValue.Composed a) + compose = niceValueParameter . fmap NiceValue.compose + +instance (NiceValue.Decompose a) => NiceValue.Decompose (Parameter a) where + decompose pat = + fmap (NiceValue.decompose (FirstOrder.getParameter pat)) . + unNiceValueParameter + +type instance + NiceValue.Decomposed f (Parameter p) = + Parameter (NiceValue.Decomposed f p) +type instance + NiceValue.PatternTuple (Parameter p) = + Parameter (NiceValue.PatternTuple p) + +niceValueParameter :: + Parameter (NiceValue.T a) -> NiceValue.T (Parameter a) +niceValueParameter = NiceValue.Cons . fmap (\(NiceValue.Cons a) -> a) + +unNiceValueParameter :: + NiceValue.T (Parameter a) -> Parameter (NiceValue.T a) +unNiceValueParameter (NiceValue.Cons x) = fmap NiceValue.Cons x + + + instance - (Expr.Aggregate e mv) => - Expr.Aggregate (Parameter e) (Parameter mv) where - type MultiValuesOf (Parameter e) = Parameter (Expr.MultiValuesOf e) - type ExpressionsOf (Parameter mv) = Parameter (Expr.ExpressionsOf mv) + (Expr.Aggregate e nv) => + Expr.Aggregate (Parameter e) (Parameter nv) where + type NiceValuesOf (Parameter e) = Parameter (Expr.NiceValuesOf e) + type ExpressionsOf (Parameter nv) = Parameter (Expr.ExpressionsOf nv) bundle (Parameter p) = fmap Parameter $ Expr.bundle p dissect (Parameter p) = Parameter $ Expr.dissect p -instance (Expr.Aggregate e mv) => Expr.Aggregate (Result e) (Result mv) where - type MultiValuesOf (Result e) = Result (Expr.MultiValuesOf e) - type ExpressionsOf (Result mv) = Result (Expr.ExpressionsOf mv) +instance (Expr.Aggregate e nv) => Expr.Aggregate (Result e) (Result nv) where + type NiceValuesOf (Result e) = Result (Expr.NiceValuesOf e) + type ExpressionsOf (Result nv) = Result (Expr.ExpressionsOf nv) bundle (Result f k) = liftA2 Result (Expr.bundle f) (Expr.bundle k) dissect (Result f k) = Result (Expr.dissect f) (Expr.dissect k) diff --git a/src/Synthesizer/LLVM/Filter/Moog.hs b/src/Synthesizer/LLVM/Filter/Moog.hs --- a/src/Synthesizer/LLVM/Filter/Moog.hs +++ b/src/Synthesizer/LLVM/Filter/Moog.hs @@ -101,10 +101,10 @@ Moog.parameter (TypeNum.integralFromProxy order) (Pole reson freq) instance - (n ~ m, Expr.Aggregate e mv) => - Expr.Aggregate (Parameter n e) (Parameter m mv) where - type MultiValuesOf (Parameter n e) = Parameter n (Expr.MultiValuesOf e) - type ExpressionsOf (Parameter m mv) = Parameter m (Expr.ExpressionsOf mv) + (n ~ m, Expr.Aggregate e nv) => + Expr.Aggregate (Parameter n e) (Parameter m nv) where + type NiceValuesOf (Parameter n e) = Parameter n (Expr.NiceValuesOf e) + type ExpressionsOf (Parameter m nv) = Parameter m (Expr.ExpressionsOf nv) bundle (Parameter (Moog.Parameter f k)) = fmap Parameter $ liftA2 Moog.Parameter (Expr.bundle f) (Expr.bundle k) dissect (Parameter (Moog.Parameter f k)) = diff --git a/src/Synthesizer/LLVM/Filter/NonRecursive.hs b/src/Synthesizer/LLVM/Filter/NonRecursive.hs --- a/src/Synthesizer/LLVM/Filter/NonRecursive.hs +++ b/src/Synthesizer/LLVM/Filter/NonRecursive.hs @@ -18,10 +18,10 @@ import qualified LLVM.DSL.Expression as Expr import LLVM.DSL.Expression (Exp) -import qualified LLVM.Extra.Multi.Value.Storable as Storable -import qualified LLVM.Extra.Multi.Value.Marshal as Marshal -import qualified LLVM.Extra.Multi.Value as MultiValue -import qualified LLVM.Extra.Multi.Vector as MultiVector +import qualified LLVM.Extra.Nice.Value.Storable as Storable +import qualified LLVM.Extra.Nice.Value.Marshal as Marshal +import qualified LLVM.Extra.Nice.Value as NiceValue +import qualified LLVM.Extra.Nice.Vector as NiceVector import qualified LLVM.Extra.Control as C import qualified LLVM.Extra.Arithmetic as A import qualified LLVM.Extra.Tuple as Tuple @@ -46,28 +46,28 @@ No Karatsuba, No Toom-Cook, No Fourier. -} convolve :: - (Storable.C a, Marshal.C a, MultiValue.PseudoRing a, MultiValue.T a ~ am) => + (Storable.C a, Marshal.C a, NiceValue.PseudoRing a, NiceValue.T a ~ am) => Exp (Source.StorableVector a) -> Causal.T am am convolve mask = let len = Source.storableVectorLength mask - in (CausalPriv.zipWith (\(MultiValue.Cons l) -> scalarProduct l) + in (CausalPriv.zipWith (\(NiceValue.Cons l) -> scalarProduct l) $< Sig.constant len) <<< Causal.track Expr.zero len &&& provideMask mask convolvePacked :: - (Marshal.Vector n a, MultiVector.PseudoRing a) => - (Storable.C a, MultiValue.PseudoRing a, Serial.Value n a ~ v) => + (Marshal.Vector n a, NiceVector.PseudoRing a) => + (Storable.C a, NiceValue.PseudoRing a, Serial.Value n a ~ v) => Exp (Source.StorableVector a) -> Causal.T v v convolvePacked = convolvePackedAux TypeNum.singleton convolvePackedAux :: - (Marshal.Vector n a, MultiVector.PseudoRing a) => - (Storable.C a, MultiValue.PseudoRing a, Serial.Value n a ~ v) => + (Marshal.Vector n a, NiceVector.PseudoRing a) => + (Storable.C a, NiceValue.PseudoRing a, Serial.Value n a ~ v) => TypeNum.Singleton n -> Exp (Source.StorableVector a) -> Causal.T v v convolvePackedAux vectorSize mask = let len = Source.storableVectorLength mask - in (CausalPriv.zipWith (\(MultiValue.Cons l) -> scalarProductPacked l) + in (CausalPriv.zipWith (\(NiceValue.Cons l) -> scalarProductPacked l) $< Sig.constant len) <<< Causal.track Expr.zero @@ -83,12 +83,12 @@ Exp (Source.StorableVector a) -> Causal.T x (LLVM.Value (Ptr a)) provideMask mask = CausalClass.fromSignal $ - fmap (\(MultiValue.Cons (ptr,_l)) -> ptr) $ + fmap (\(NiceValue.Cons (ptr,_l)) -> ptr) $ Sig.constant mask scalarProduct :: - (Storable.C a, Marshal.C a, MultiValue.T a ~ am, MultiValue.PseudoRing a) => + (Storable.C a, Marshal.C a, NiceValue.T a ~ am, NiceValue.PseudoRing a) => LLVM.Value Word -> (RingBuffer.T am, LLVM.Value (Ptr a)) -> LLVM.CodeGenFunction r am @@ -101,7 +101,7 @@ scalarProductPacked :: - (Storable.C a, Marshal.Vector n a, MultiVector.PseudoRing a) => + (Storable.C a, Marshal.Vector n a, NiceVector.PseudoRing a) => LLVM.Value Word -> (RingBuffer.T (Serial.Value n a), LLVM.Value (Ptr a)) -> LLVM.CodeGenFunction r (Serial.Value n a) @@ -138,7 +138,7 @@ return (a, ((a, Tuple.undef, A.zero), A.zero)) readSerialNext :: - (MultiValue.C a, Marshal.Vector n a) => + (NiceValue.C a, Marshal.Vector n a) => RingBuffer.T (Serial.Value n a) -> Iterator n a -> LLVM.CodeGenFunction r (Serial.Value n a, Iterator n a) diff --git a/src/Synthesizer/LLVM/Filter/SecondOrder.hs b/src/Synthesizer/LLVM/Filter/SecondOrder.hs --- a/src/Synthesizer/LLVM/Filter/SecondOrder.hs +++ b/src/Synthesizer/LLVM/Filter/SecondOrder.hs @@ -10,7 +10,7 @@ bandpassParameter, bandpassParameterCode, ParameterStruct, composeParameter, decomposeParameter, -- for cascade - composeParameterMV, decomposeParameterMV, + composeParameterNice, decomposeParameterNice, causalExp, causal, causalPacked, ) where @@ -27,8 +27,8 @@ import qualified LLVM.DSL.Expression as Expr -import qualified LLVM.Extra.Multi.Value.Marshal as MarshalMV -import qualified LLVM.Extra.Multi.Value as MultiValue +import qualified LLVM.Extra.Nice.Value.Marshal as MarshalNice +import qualified LLVM.Extra.Nice.Value as NiceValue import qualified LLVM.Extra.Storable as Storable import qualified LLVM.Extra.Marshal as Marshal import qualified LLVM.Extra.Memory as Memory @@ -93,11 +93,11 @@ <*> LLVM.extractvalue param TypeNum.d3 <*> LLVM.extractvalue param TypeNum.d4 -decomposeParameterMV :: - (MarshalMV.C a) => - LLVM.Value (MarshalMV.Struct (Parameter a)) -> - CodeGenFunction r (Filt2.Parameter (MultiValue.T a)) -decomposeParameterMV param = +decomposeParameterNice :: + (MarshalNice.C a) => + LLVM.Value (MarshalNice.Struct (Parameter a)) -> + CodeGenFunction r (Filt2.Parameter (NiceValue.T a)) +decomposeParameterNice param = pure Filt2.Parameter <*> (Memory.decompose =<< LLVM.extractvalue param TypeNum.d0) <*> (Memory.decompose =<< LLVM.extractvalue param TypeNum.d1) @@ -117,11 +117,11 @@ (\param -> LLVM.insertvalue param d2_ TypeNum.d4) =<< return (LLVM.value LLVM.undef) -composeParameterMV :: - (MarshalMV.C a) => - Filt2.Parameter (MultiValue.T a) -> - CodeGenFunction r (LLVM.Value (MarshalMV.Struct (Parameter a))) -composeParameterMV (Filt2.Parameter c0_ c1_ c2_ d1_ d2_) = +composeParameterNice :: + (MarshalNice.C a) => + Filt2.Parameter (NiceValue.T a) -> + CodeGenFunction r (LLVM.Value (MarshalNice.Struct (Parameter a))) +composeParameterNice (Filt2.Parameter c0_ c1_ c2_ d1_ d2_) = let insert field ix param = Memory.compose field >>= flip (LLVM.insertvalue param) ix in insert c0_ TypeNum.d0 =<< @@ -155,42 +155,42 @@ flattenCode = Value.flattenCodeTraversable unfoldCode = Value.unfoldCodeTraversable -instance (MultiValue.C a) => MultiValue.C (Parameter a) where - type Repr (Parameter a) = Parameter (MultiValue.Repr a) - cons = parameterMultiValue . fmap MultiValue.cons - undef = parameterMultiValue $ pure MultiValue.undef - zero = parameterMultiValue $ pure MultiValue.zero +instance (NiceValue.C a) => NiceValue.C (Parameter a) where + type Repr (Parameter a) = Parameter (NiceValue.Repr a) + cons = niceValueParameter . fmap NiceValue.cons + undef = niceValueParameter $ pure NiceValue.undef + zero = niceValueParameter $ pure NiceValue.zero phi bb = - fmap parameterMultiValue . - traverse (MultiValue.phi bb) . - parameterUnMultiValue + fmap niceValueParameter . + traverse (NiceValue.phi bb) . + unNiceValueParameter addPhi bb a b = Fold.sequence_ $ - liftA2 (MultiValue.addPhi bb) - (parameterUnMultiValue a) (parameterUnMultiValue b) + liftA2 (NiceValue.addPhi bb) + (unNiceValueParameter a) (unNiceValueParameter b) -instance (MarshalMV.C a) => MarshalMV.C (Parameter a) where +instance (MarshalNice.C a) => MarshalNice.C (Parameter a) where pack p = - case MarshalMV.pack <$> p of + case MarshalNice.pack <$> p of Filt2.Parameter c0_ c1_ c2_ d1_ d2_ -> LLVM.consStruct c0_ c1_ c2_ d1_ d2_ - unpack = fmap MarshalMV.unpack . LLVM.uncurryStruct Filt2.Parameter + unpack = fmap MarshalNice.unpack . LLVM.uncurryStruct Filt2.Parameter -parameterMultiValue :: - Parameter (MultiValue.T a) -> MultiValue.T (Parameter a) -parameterMultiValue = - MultiValue.Cons . fmap (\(MultiValue.Cons a) -> a) +niceValueParameter :: + Parameter (NiceValue.T a) -> NiceValue.T (Parameter a) +niceValueParameter = + NiceValue.Cons . fmap (\(NiceValue.Cons a) -> a) -parameterUnMultiValue :: - MultiValue.T (Parameter a) -> Parameter (MultiValue.T a) -parameterUnMultiValue (MultiValue.Cons x) = - fmap MultiValue.Cons x +unNiceValueParameter :: + NiceValue.T (Parameter a) -> Parameter (NiceValue.T a) +unNiceValueParameter (NiceValue.Cons x) = + fmap NiceValue.Cons x instance - (Expr.Aggregate e mv) => - Expr.Aggregate (Parameter e) (Parameter mv) where - type MultiValuesOf (Parameter e) = Parameter (Expr.MultiValuesOf e) - type ExpressionsOf (Parameter mv) = Parameter (Expr.ExpressionsOf mv) + (Expr.Aggregate e nv) => + Expr.Aggregate (Parameter e) (Parameter nv) where + type NiceValuesOf (Parameter e) = Parameter (Expr.NiceValuesOf e) + type ExpressionsOf (Parameter nv) = Parameter (Expr.ExpressionsOf nv) bundle = traverse Expr.bundle dissect = fmap Expr.dissect @@ -230,10 +230,10 @@ unfoldCode = Value.unfoldCodeTraversable instance - (Expr.Aggregate e mv) => - Expr.Aggregate (Filt2.State e) (Filt2.State mv) where - type MultiValuesOf (Filt2.State e) = Filt2.State (Expr.MultiValuesOf e) - type ExpressionsOf (Filt2.State mv) = Filt2.State (Expr.ExpressionsOf mv) + (Expr.Aggregate e nv) => + Expr.Aggregate (Filt2.State e) (Filt2.State nv) where + type NiceValuesOf (Filt2.State e) = Filt2.State (Expr.NiceValuesOf e) + type ExpressionsOf (Filt2.State nv) = Filt2.State (Expr.ExpressionsOf nv) bundle = traverse Expr.bundle dissect = fmap Expr.dissect diff --git a/src/Synthesizer/LLVM/Filter/SecondOrderCascade.hs b/src/Synthesizer/LLVM/Filter/SecondOrderCascade.hs --- a/src/Synthesizer/LLVM/Filter/SecondOrderCascade.hs +++ b/src/Synthesizer/LLVM/Filter/SecondOrderCascade.hs @@ -21,8 +21,8 @@ import qualified Synthesizer.LLVM.Frame.SerialVector.Class as Serial import Synthesizer.Causal.Class (($<)) -import qualified LLVM.Extra.Multi.Value.Marshal as Marshal -import qualified LLVM.Extra.Multi.Value as MultiValue +import qualified LLVM.Extra.Nice.Value.Marshal as Marshal +import qualified LLVM.Extra.Nice.Value as NiceValue import qualified LLVM.Extra.Arithmetic as A import qualified LLVM.Extra.Tuple as Tuple import qualified LLVM.Extra.Memory as Memory @@ -40,11 +40,11 @@ import NumericPrelude.Base -type Parameter n a = MultiValue.Array n (Filt2.Parameter a) +type Parameter n a = NiceValue.Array n (Filt2.Parameter a) type ParameterStruct n a = Marshal.Struct (Parameter n a) newtype ParameterValue n a = - ParameterValue {parameterValue :: MultiValue.T (Parameter n a)} + ParameterValue {parameterValue :: NiceValue.T (Parameter n a)} {- Automatic deriving is not allowed even with GeneralizedNewtypeDeriving because of IsSized constraint @@ -56,16 +56,16 @@ instance (TypeNum.Natural n, Marshal.C a) => Tuple.Phi (ParameterValue n a) where - phi bb (ParameterValue r) = fmap ParameterValue $ MultiValue.phi bb r - addPhi bb (ParameterValue r) (ParameterValue r') = MultiValue.addPhi bb r r' + phi bb (ParameterValue r) = fmap ParameterValue $ NiceValue.phi bb r + addPhi bb (ParameterValue r) (ParameterValue r') = NiceValue.addPhi bb r r' instance (TypeNum.Natural n, Marshal.C a) => Tuple.Undefined (ParameterValue n a) where - undef = ParameterValue MultiValue.undef + undef = ParameterValue NiceValue.undef instance (TypeNum.Natural n, Marshal.C a) => Tuple.Zero (ParameterValue n a) where - zero = ParameterValue MultiValue.zero + zero = ParameterValue NiceValue.zero instance (TypeNum.Natural n, Marshal.C a, TypeNum.Positive (n :*: LLVM.UnknownSize)) => @@ -95,20 +95,20 @@ constArray :: (TypeNum.Natural n, Marshal.C a) => - Proxy n -> [a] -> MultiValue.T (MultiValue.Array n a) -constArray _n = MultiValue.cons . MultiValue.Array + Proxy n -> [a] -> NiceValue.T (NiceValue.Array n a) +constArray _n = NiceValue.cons . NiceValue.Array causal :: - (A.PseudoModule v, Memory.C v, A.Scalar v ~ MultiValue.T a, - Marshal.C a, MultiValue.IntegerConstant a, + (A.PseudoModule v, Memory.C v, A.Scalar v ~ NiceValue.T a, + Marshal.C a, NiceValue.IntegerConstant a, TypeNum.Natural n, TypeNum.Positive (n :*: LLVM.UnknownSize)) => Causal.T (ParameterValue n a, v) v causal = causalGen Filt2.causal causalPacked :: - (Marshal.C a, MultiValue.PseudoRing a, MultiValue.IntegerConstant a, - Serial.Write v, Serial.Element v ~ MultiValue.T a, + (Marshal.C a, NiceValue.PseudoRing a, NiceValue.IntegerConstant a, + Serial.Write v, Serial.Element v ~ NiceValue.T a, Memory.C v, A.PseudoRing v, A.IntegerConstant v, TypeNum.Natural n, TypeNum.Positive (n :*: LLVM.UnknownSize)) => Causal.T (ParameterValue n a, v) v @@ -117,7 +117,7 @@ causalGen :: (Marshal.C a, Tuple.Phi v, Tuple.Undefined v, TypeNum.Natural n, TypeNum.Positive (n :*: LLVM.UnknownSize)) => - Causal.T (Filt2.Parameter (MultiValue.T a), v) v -> + Causal.T (Filt2.Parameter (NiceValue.T a), v) v -> Causal.T (ParameterValue n a, v) v causalGen stage = withSize $ \n -> @@ -136,7 +136,7 @@ paramStage :: (TypeNum.Natural n, Marshal.C a) => - Causal.T (Filt2.Parameter (MultiValue.T a), v) v -> + Causal.T (Filt2.Parameter (NiceValue.T a), v) v -> Causal.T (LLVM.Value (LLVM.Ptr (ParameterStruct n a)), (LLVM.Value Word, v)) (LLVM.Value Word, v) @@ -155,8 +155,8 @@ (TypeNum.Natural n, Marshal.C a) => LLVM.Value (LLVM.Ptr (ParameterStruct n a)) -> LLVM.Value Word -> - LLVM.CodeGenFunction r (Filt2.Parameter (MultiValue.T a)) + LLVM.CodeGenFunction r (Filt2.Parameter (NiceValue.T a)) getStageParameterGEP ptr k = - Filt2.decomposeParameterMV + Filt2.decomposeParameterNice =<< LLVM.load =<< LLVM.getElementPtr0 ptr (k, ()) diff --git a/src/Synthesizer/LLVM/Filter/SecondOrderPacked.hs b/src/Synthesizer/LLVM/Filter/SecondOrderPacked.hs --- a/src/Synthesizer/LLVM/Filter/SecondOrderPacked.hs +++ b/src/Synthesizer/LLVM/Filter/SecondOrderPacked.hs @@ -16,9 +16,9 @@ import qualified LLVM.DSL.Expression as Expr import LLVM.DSL.Expression (Exp(Exp)) -import qualified LLVM.Extra.Multi.Value.Marshal as Marshal -import qualified LLVM.Extra.Multi.Value as MultiValue -import qualified LLVM.Extra.Multi.Vector as MultiVector +import qualified LLVM.Extra.Nice.Value.Marshal as Marshal +import qualified LLVM.Extra.Nice.Value as NiceValue +import qualified LLVM.Extra.Nice.Vector as NiceVector import qualified LLVM.Extra.Tuple as Tuple import qualified LLVM.Extra.Memory as Memory import qualified LLVM.Extra.Arithmetic as A @@ -38,9 +38,9 @@ > c0 [c1 d1 c2 d2] -} -data Parameter a = Parameter (MultiValue.T a) (MultiVector.T D4 a) +data Parameter a = Parameter (NiceValue.T a) (NiceVector.T D4 a) -instance (MultiVector.C a) => Tuple.Phi (Parameter a) where +instance (NiceVector.C a) => Tuple.Phi (Parameter a) where phi bb (Parameter r i) = do r' <- Tuple.phi bb r i' <- Tuple.phi bb i @@ -49,11 +49,11 @@ Tuple.addPhi bb r r' Tuple.addPhi bb i i' -instance (MultiVector.C a) => Tuple.Undefined (Parameter a) where +instance (NiceVector.C a) => Tuple.Undefined (Parameter a) where undef = Parameter Tuple.undef Tuple.undef -type ParameterStruct a = Memory.Struct (MultiValue.T a, MultiVector.T D4 a) +type ParameterStruct a = Memory.Struct (NiceValue.T a, NiceVector.T D4 a) parameterMemory :: (Marshal.C a, Marshal.Vector D4 a) => @@ -75,19 +75,19 @@ ParameterExp (forall r. LLVM.CodeGenFunction r (Parameter a)) instance Expr.Aggregate (ParameterExp a) (Parameter a) where - type MultiValuesOf (ParameterExp a) = Parameter a + type NiceValuesOf (ParameterExp a) = Parameter a type ExpressionsOf (Parameter a) = ParameterExp a dissect x = ParameterExp (return x) bundle (ParameterExp code) = code -type State = MultiVector.T D4 +type State = NiceVector.T D4 {-# DEPRECATED bandpassParameter "only for testing, use Universal or Moog filter for production code" #-} bandpassParameter :: - (MultiVector.C a, MultiValue.Transcendental a, - MultiValue.RationalConstant a) => + (NiceVector.C a, NiceValue.Transcendental a, + NiceValue.RationalConstant a) => Exp a -> Exp a -> ParameterExp a bandpassParameter (Exp reson) (Exp cutoff) = ParameterExp (do @@ -96,35 +96,35 @@ bandpassParameterCode r c) bandpassParameterCode :: - (MultiVector.C a, MultiValue.Transcendental a, - MultiValue.RationalConstant a) => - MultiValue.T a -> - MultiValue.T a -> + (NiceVector.C a, NiceValue.Transcendental a, + NiceValue.RationalConstant a) => + NiceValue.T a -> + NiceValue.T a -> LLVM.CodeGenFunction r (Parameter a) bandpassParameterCode reson cutoff = do p <- Filt2L.bandpassParameterCode reson cutoff v <- - MultiVector.assembleFromVector $ fmap ($ p) $ + NiceVector.assembleFromVector $ fmap ($ p) $ LLVM.consVector Filt2.c1 Filt2.d1 Filt2.c2 Filt2.d2 return $ Parameter (Filt2.c0 p) v next :: - (MultiVector.PseudoRing a) => - (Parameter a, MultiValue.T a) -> + (NiceVector.PseudoRing a) => + (Parameter a, NiceValue.T a) -> State a -> - LLVM.CodeGenFunction r (MultiValue.T a, State a) + LLVM.CodeGenFunction r (NiceValue.T a, State a) next (Parameter c0 k1, x0) y1 = do s0 <- A.mul c0 x0 - s1 <- MultiVector.dotProduct k1 y1 + s1 <- NiceVector.dotProduct k1 y1 y0 <- A.add s0 s1 - x1new <- MultiVector.extract (LLVM.valueOf 0) y1 - y1new <- MultiVector.extract (LLVM.valueOf 1) y1 - yv <- MultiVector.assembleFromVector $ LLVM.consVector x0 y0 x1new y1new + x1new <- NiceVector.extract (LLVM.valueOf 0) y1 + y1new <- NiceVector.extract (LLVM.valueOf 1) y1 + yv <- NiceVector.assembleFromVector $ LLVM.consVector x0 y0 x1new y1new return (y0, yv) causal :: - (MultiVector.PseudoRing a) => + (NiceVector.PseudoRing a) => (Marshal.Vector D4 a) => - Causal.T (Parameter a, MultiValue.T a) (MultiValue.T a) + Causal.T (Parameter a, NiceValue.T a) (NiceValue.T a) causal = Causal.mapAccum next (return A.zero) diff --git a/src/Synthesizer/LLVM/Filter/Universal.hs b/src/Synthesizer/LLVM/Filter/Universal.hs --- a/src/Synthesizer/LLVM/Filter/Universal.hs +++ b/src/Synthesizer/LLVM/Filter/Universal.hs @@ -6,8 +6,8 @@ Result(Result, lowpass, highpass, bandpass, bandlimit), Parameter, parameter, causal, parameterCode, causalExp, - multiValueResult, unMultiValueResult, - multiValueParameter, unMultiValueParameter, + niceValueResult, unNiceValueResult, + niceValueParameter, unNiceValueParameter, parameterAtoms, ) where import qualified Synthesizer.Plain.Filter.Recursive.Universal as Universal @@ -24,8 +24,8 @@ import qualified LLVM.DSL.Expression as Expr -import qualified LLVM.Extra.Multi.Value.Marshal as MarshalMV -import qualified LLVM.Extra.Multi.Value as MultiValue +import qualified LLVM.Extra.Nice.Value.Marshal as MarshalNice +import qualified LLVM.Extra.Nice.Value as NiceValue import qualified LLVM.Extra.Storable as Storable import qualified LLVM.Extra.Marshal as Marshal import qualified LLVM.Extra.Memory as Memory @@ -120,36 +120,36 @@ flattenCode = Value.flattenCodeTraversable unfoldCode = Value.unfoldCodeTraversable -instance (MultiValue.C a) => MultiValue.C (Result a) where - type Repr (Result a) = Result (MultiValue.Repr a) - cons = multiValueResult . fmap MultiValue.cons - undef = multiValueResult $ pure MultiValue.undef - zero = multiValueResult $ pure MultiValue.zero +instance (NiceValue.C a) => NiceValue.C (Result a) where + type Repr (Result a) = Result (NiceValue.Repr a) + cons = niceValueResult . fmap NiceValue.cons + undef = niceValueResult $ pure NiceValue.undef + zero = niceValueResult $ pure NiceValue.zero phi bb = - fmap multiValueResult . - traverse (MultiValue.phi bb) . unMultiValueResult + fmap niceValueResult . + traverse (NiceValue.phi bb) . unNiceValueResult addPhi bb a b = Fold.sequence_ $ - liftA2 (MultiValue.addPhi bb) - (unMultiValueResult a) (unMultiValueResult b) + liftA2 (NiceValue.addPhi bb) + (unNiceValueResult a) (unNiceValueResult b) -multiValueResult :: - Result (MultiValue.T a) -> MultiValue.T (Result a) -multiValueResult = MultiValue.Cons . fmap (\(MultiValue.Cons a) -> a) +niceValueResult :: + Result (NiceValue.T a) -> NiceValue.T (Result a) +niceValueResult = NiceValue.Cons . fmap (\(NiceValue.Cons a) -> a) -unMultiValueResult :: - MultiValue.T (Result a) -> Result (MultiValue.T a) -unMultiValueResult (MultiValue.Cons x) = fmap MultiValue.Cons x +unNiceValueResult :: + NiceValue.T (Result a) -> Result (NiceValue.T a) +unNiceValueResult (NiceValue.Cons x) = fmap NiceValue.Cons x -instance (MarshalMV.C a) => MarshalMV.C (Result a) where +instance (MarshalNice.C a) => MarshalNice.C (Result a) where pack p = - case MarshalMV.pack <$> p of + case MarshalNice.pack <$> p of Result hp bp lp bl -> LLVM.consStruct hp bp lp bl - unpack = fmap MarshalMV.unpack . LLVM.uncurryStruct Result + unpack = fmap MarshalNice.unpack . LLVM.uncurryStruct Result -instance (Expr.Aggregate e mv) => Expr.Aggregate (Result e) (Result mv) where - type MultiValuesOf (Result e) = Result (Expr.MultiValuesOf e) - type ExpressionsOf (Result mv) = Result (Expr.ExpressionsOf mv) +instance (Expr.Aggregate e nv) => Expr.Aggregate (Result e) (Result nv) where + type NiceValuesOf (Result e) = Result (Expr.NiceValuesOf e) + type ExpressionsOf (Result nv) = Result (Expr.ExpressionsOf nv) bundle = traverse Expr.bundle dissect = fmap Expr.dissect @@ -163,39 +163,58 @@ flattenCode = Value.flattenCodeTraversable unfoldCode = Value.unfoldCodeTraversable -instance (MultiValue.C a) => MultiValue.C (Parameter a) where - type Repr (Parameter a) = Parameter (MultiValue.Repr a) - cons = multiValueParameter . fmap MultiValue.cons - undef = multiValueParameter $ pure MultiValue.undef - zero = multiValueParameter $ pure MultiValue.zero +instance (NiceValue.C a) => NiceValue.C (Parameter a) where + type Repr (Parameter a) = Parameter (NiceValue.Repr a) + cons = niceValueParameter . fmap NiceValue.cons + undef = niceValueParameter $ pure NiceValue.undef + zero = niceValueParameter $ pure NiceValue.zero phi bb = - fmap multiValueParameter . - traverse (MultiValue.phi bb) . unMultiValueParameter + fmap niceValueParameter . + traverse (NiceValue.phi bb) . unNiceValueParameter addPhi bb a b = Fold.sequence_ $ - liftA2 (MultiValue.addPhi bb) - (unMultiValueParameter a) (unMultiValueParameter b) + liftA2 (NiceValue.addPhi bb) + (unNiceValueParameter a) (unNiceValueParameter b) -multiValueParameter :: - Parameter (MultiValue.T a) -> MultiValue.T (Parameter a) -multiValueParameter = MultiValue.Cons . fmap (\(MultiValue.Cons a) -> a) +instance (NiceValue.Compose a) => NiceValue.Compose (Parameter a) where + type Composed (Parameter a) = Parameter (NiceValue.Composed a) + compose = niceValueParameter . fmap NiceValue.compose -unMultiValueParameter :: - MultiValue.T (Parameter a) -> Parameter (MultiValue.T a) -unMultiValueParameter (MultiValue.Cons x) = fmap MultiValue.Cons x +instance (NiceValue.Decompose a) => NiceValue.Decompose (Parameter a) where + decompose pat = + fmap (NiceValue.decompose (Universal.k1 pat)) . + unNiceValueParameter -instance (MarshalMV.C a) => MarshalMV.C (Parameter a) where +type instance + NiceValue.Decomposed f (Parameter p) = + Parameter (NiceValue.Decomposed f p) +type instance + NiceValue.PatternTuple (Parameter p) = + Parameter (NiceValue.PatternTuple p) + +niceValueParameter :: + Parameter (NiceValue.T a) -> NiceValue.T (Parameter a) +niceValueParameter = NiceValue.Cons . fmap (\(NiceValue.Cons a) -> a) + +unNiceValueParameter :: + NiceValue.T (Parameter a) -> Parameter (NiceValue.T a) +unNiceValueParameter (NiceValue.Cons x) = fmap NiceValue.Cons x + +parameterAtoms :: Parameter (NiceValue.Atom a) +parameterAtoms = pure NiceValue.atom + +instance (MarshalNice.C a) => MarshalNice.C (Parameter a) where pack p = - case MarshalMV.pack <$> p of + case MarshalNice.pack <$> p of Parameter k1 k2 ampIn ampI1 ampI2 ampLimit -> LLVM.consStruct k1 k2 ampIn ampI1 ampI2 ampLimit - unpack = fmap MarshalMV.unpack . LLVM.uncurryStruct Parameter + unpack = fmap MarshalNice.unpack . LLVM.uncurryStruct Parameter instance - (Expr.Aggregate e mv) => - Expr.Aggregate (Parameter e) (Parameter mv) where - type MultiValuesOf (Parameter e) = Parameter (Expr.MultiValuesOf e) - type ExpressionsOf (Parameter mv) = Parameter (Expr.ExpressionsOf mv) + (Expr.Aggregate e nv) => + Expr.Aggregate (Parameter e) (Parameter nv) where + type NiceValuesOf (Parameter e) = Parameter (Expr.NiceValuesOf e) + type ExpressionsOf (Parameter nv) = Parameter (Expr.ExpressionsOf nv) bundle = traverse Expr.bundle dissect = fmap Expr.dissect diff --git a/src/Synthesizer/LLVM/ForeignPtr.hs b/src/Synthesizer/LLVM/ForeignPtr.hs --- a/src/Synthesizer/LLVM/ForeignPtr.hs +++ b/src/Synthesizer/LLVM/ForeignPtr.hs @@ -13,7 +13,7 @@ module Synthesizer.LLVM.ForeignPtr where import qualified LLVM.DSL.Execution as Exec -import qualified LLVM.Extra.Multi.Value.Marshal as MarshalMV +import qualified LLVM.Extra.Nice.Value.Marshal as MarshalNice import qualified LLVM.Extra.Marshal as Marshal import qualified LLVM.ExecutionEngine as EE import qualified LLVM.Core as LLVM @@ -50,13 +50,13 @@ newParam stop start b = newInit stop (Marshal.with b start) -newParamMV :: - (MarshalMV.C b) => +newParamNice :: + (MarshalNice.C b) => Exec.Finalizer a -> - (LLVM.Ptr (MarshalMV.Struct b) -> IO (LLVM.Ptr a)) -> + (LLVM.Ptr (MarshalNice.Struct b) -> IO (LLVM.Ptr a)) -> b -> IO (MemoryPtr a) -newParamMV stop start b = - newInit stop (MarshalMV.with b start) +newParamNice stop start b = + newInit stop (MarshalNice.with b start) new :: (Marshal.C a, Marshal.Struct a ~ struct) => diff --git a/src/Synthesizer/LLVM/Frame/SerialVector.hs b/src/Synthesizer/LLVM/Frame/SerialVector.hs --- a/src/Synthesizer/LLVM/Frame/SerialVector.hs +++ b/src/Synthesizer/LLVM/Frame/SerialVector.hs @@ -21,15 +21,15 @@ import qualified Synthesizer.LLVM.Frame.SerialVector.Code as Code import Synthesizer.LLVM.Frame.SerialVector.Code - (T, fromMultiVector, toMultiVector) + (T, fromNiceVector, toNiceVector) import qualified LLVM.DSL.Expression.Vector as ExprVec import qualified LLVM.DSL.Expression as Expr import LLVM.DSL.Expression (Exp) -import qualified LLVM.Extra.Multi.Vector as MultiVector -import qualified LLVM.Extra.Multi.Value.Vector as MultiValueVec -import qualified LLVM.Extra.Multi.Value as MultiValue +import qualified LLVM.Extra.Nice.Vector as NiceVector +import qualified LLVM.Extra.Nice.Value.Vector as NiceValueVec +import qualified LLVM.Extra.Nice.Value as NiceValue import qualified LLVM.Extra.Arithmetic as A import qualified LLVM.Core as LLVM @@ -42,22 +42,22 @@ fromFixedList :: - (TypeNum.Positive n, MultiVector.C a) => + (TypeNum.Positive n, NiceVector.C a) => LLVM.FixedList (TypeNum.ToUnary n) a -> Exp (T n a) fromFixedList = fromOrdinary . Expr.cons . LLVM.vector -subsample :: (TypeNum.Positive n, MultiVector.C a) => Exp (T n a) -> Exp a +subsample :: (TypeNum.Positive n, NiceVector.C a) => Exp (T n a) -> Exp a subsample = - Expr.liftM (MultiValueVec.extract (A.zero :: LLVM.Value Word32)) . toOrdinary + Expr.liftM (NiceValueVec.extract (A.zero :: LLVM.Value Word32)) . toOrdinary -upsample :: (TypeNum.Positive n, MultiVector.C a) => Exp a -> Exp (T n a) +upsample :: (TypeNum.Positive n, NiceVector.C a) => Exp a -> Exp (T n a) upsample = fromOrdinary . ExprVec.replicate shiftUp :: - (TypeNum.Positive n, MultiVector.C x, Exp x ~ a, Exp (T n x) ~ v) => + (TypeNum.Positive n, NiceVector.C x, Exp x ~ a, Exp (T n x) ~ v) => a -> v -> (a, v) shiftUp a v = (Expr.liftM2 ((fmap fst .) . Code.shiftUp) a v, @@ -65,45 +65,45 @@ iterate :: - (TypeNum.Positive n, MultiVector.C a) => + (TypeNum.Positive n, NiceVector.C a) => (Exp a -> Exp a) -> Exp a -> Exp (T n a) iterate f = fromOrdinary . ExprVec.iterate f reverse :: - (TypeNum.Positive n, MultiVector.C a) => + (TypeNum.Positive n, NiceVector.C a) => Exp (T n a) -> Exp (T n a) reverse = - Expr.liftM (fmap fromMultiVector . MultiVector.reverse . toMultiVector) + Expr.liftM (fmap fromNiceVector . NiceVector.reverse . toNiceVector) cumulate :: - (TypeNum.Positive n, MultiVector.Additive a) => + (TypeNum.Positive n, NiceVector.Additive a) => Exp a -> Exp (T n a) -> (Exp a, Exp (T n a)) cumulate a v = (Expr.liftM2 ((fmap fst .) . Code.cumulate) a v, Expr.liftM2 ((fmap snd .) . Code.cumulate) a v) limit :: - (TypeNum.Positive n, MultiVector.Real a) => + (TypeNum.Positive n, NiceVector.Real a) => (Exp (T n a), Exp (T n a)) -> Exp (T n a) -> Exp (T n a) limit (l,u) = fromOrdinary . ExprVec.limit (toOrdinary l, toOrdinary u) . toOrdinary cmp :: - (TypeNum.Positive n, MultiVector.Comparison a) => + (TypeNum.Positive n, NiceVector.Comparison a) => LLVM.CmpPredicate -> Exp (T n a) -> Exp (T n a) -> Exp (T n Bool) cmp ord a b = fromOrdinary $ ExprVec.cmp ord (toOrdinary a) (toOrdinary b) select :: - (TypeNum.Positive n, MultiVector.Select a) => + (TypeNum.Positive n, NiceVector.Select a) => Exp (T n Bool) -> Exp (T n a) -> Exp (T n a) -> Exp (T n a) select c a b = fromOrdinary $ ExprVec.select (toOrdinary c) (toOrdinary a) (toOrdinary b) fromOrdinary :: Exp (LLVM.Vector n a) -> Exp (T n a) -fromOrdinary = Expr.lift1 MultiValue.cast +fromOrdinary = Expr.lift1 NiceValue.cast toOrdinary :: Exp (T n a) -> Exp (LLVM.Vector n a) -toOrdinary = Expr.lift1 MultiValue.cast +toOrdinary = Expr.lift1 NiceValue.cast diff --git a/src/Synthesizer/LLVM/Frame/SerialVector/Class.hs b/src/Synthesizer/LLVM/Frame/SerialVector/Class.hs --- a/src/Synthesizer/LLVM/Frame/SerialVector/Class.hs +++ b/src/Synthesizer/LLVM/Frame/SerialVector/Class.hs @@ -38,8 +38,8 @@ import qualified Synthesizer.LLVM.Frame.SerialVector.Code as SerialCode import qualified Synthesizer.LLVM.Frame.Stereo as Stereo -import qualified LLVM.Extra.Multi.Vector as MultiVector -import qualified LLVM.Extra.Multi.Value as MultiValue +import qualified LLVM.Extra.Nice.Vector as NiceVector +import qualified LLVM.Extra.Nice.Value as NiceValue import qualified LLVM.Extra.Memory as Memory import qualified LLVM.Extra.Arithmetic as A import qualified LLVM.Extra.Tuple as Tuple @@ -171,7 +171,7 @@ {- | -The type parameter @v@ shall be a @MultiVector@ or @MultiValue Serial@ +The type parameter @v@ shall be a @NiceVector@ or @NiceValue Serial@ or a wrapper around one or more such things sharing the same size. -} class (TypeNum.Positive (Size v)) => Sized v where @@ -220,32 +220,32 @@ -instance (TypeNum.Positive n) => Sized (MultiVector.T n a) where - type Size (MultiVector.T n a) = n +instance (TypeNum.Positive n) => Sized (NiceVector.T n a) where + type Size (NiceVector.T n a) = n -instance (TypeNum.Positive n, MultiVector.C a) => Read (MultiVector.T n a) where +instance (TypeNum.Positive n, NiceVector.C a) => Read (NiceVector.T n a) where - type Element (MultiVector.T n a) = MultiValue.T a - type ReadIt (MultiVector.T n a) = MultiVector.T n a + type Element (NiceVector.T n a) = NiceValue.T a + type ReadIt (NiceVector.T n a) = NiceVector.T n a - extract = MultiVector.extract + extract = NiceVector.extract readStart v = return $ Iterator v readNext (Iterator v) = - mapSnd Iterator <$> MultiVector.shiftDown MultiValue.undef v + mapSnd Iterator <$> NiceVector.shiftDown NiceValue.undef v instance - (TypeNum.Positive n, MultiVector.C a) => Write (MultiVector.T n a) where + (TypeNum.Positive n, NiceVector.C a) => Write (NiceVector.T n a) where - type WriteIt (MultiVector.T n a) = MultiVector.T n a + type WriteIt (NiceVector.T n a) = NiceVector.T n a - insert = MultiVector.insert + insert = NiceVector.insert - writeStart = return (Iterator MultiVector.undef) - writeNext x (Iterator v) = Iterator . snd <$> MultiVector.shiftDown x v + writeStart = return (Iterator NiceVector.undef) + writeNext x (Iterator v) = Iterator . snd <$> NiceVector.shiftDown x v writeStop (Iterator v) = return v -instance (TypeNum.Positive n, MultiVector.C a) => Zero (MultiVector.T n a) where +instance (TypeNum.Positive n, NiceVector.C a) => Zero (NiceVector.T n a) where writeZero = return (Iterator Tuple.zero) @@ -255,18 +255,18 @@ instance (TypeNum.Positive n) => Sized (Serial n a) where type Size (Serial n a) = n -instance (TypeNum.Positive n, MultiVector.C a) => Read (Serial n a) where +instance (TypeNum.Positive n, NiceVector.C a) => Read (Serial n a) where - type Element (Serial n a) = MultiValue.T a + type Element (Serial n a) = NiceValue.T a type ReadIt (Serial n a) = Serial n a extract = SerialCode.extract readStart v = return $ Iterator v readNext (Iterator v) = - mapSnd Iterator <$> SerialCode.shiftDown MultiValue.undef v + mapSnd Iterator <$> SerialCode.shiftDown NiceValue.undef v -instance (TypeNum.Positive n, MultiVector.C a) => Write (Serial n a) where +instance (TypeNum.Positive n, NiceVector.C a) => Write (Serial n a) where type WriteIt (Serial n a) = Serial n a @@ -276,7 +276,7 @@ writeNext x (Iterator v) = Iterator . snd <$> SerialCode.shiftDown x v writeStop (Iterator v) = return v -instance (TypeNum.Positive n, MultiVector.C a) => Zero (Serial n a) where +instance (TypeNum.Positive n, NiceVector.C a) => Zero (Serial n a) where writeZero = return (Iterator Tuple.zero) diff --git a/src/Synthesizer/LLVM/Frame/SerialVector/Code.hs b/src/Synthesizer/LLVM/Frame/SerialVector/Code.hs --- a/src/Synthesizer/LLVM/Frame/SerialVector/Code.hs +++ b/src/Synthesizer/LLVM/Frame/SerialVector/Code.hs @@ -5,7 +5,7 @@ module Synthesizer.LLVM.Frame.SerialVector.Code ( T(Cons), Value, size, fromOrdinary, toOrdinary, - fromMultiVector, toMultiVector, + fromNiceVector, toNiceVector, extract, insert, modify, assemble, dissect, assemble1, dissect1, @@ -15,12 +15,12 @@ scale, ) where -import qualified LLVM.Extra.Multi.Vector.Instance as MultiVectorInst -import qualified LLVM.Extra.Multi.Vector as MultiVector -import qualified LLVM.Extra.Multi.Value.Storable as Storable -import qualified LLVM.Extra.Multi.Value.Marshal as Marshal -import qualified LLVM.Extra.Multi.Value.Vector as MultiValueVec -import qualified LLVM.Extra.Multi.Value as MultiValue +import qualified LLVM.Extra.Nice.Vector.Instance as NiceVectorInst +import qualified LLVM.Extra.Nice.Vector as NiceVector +import qualified LLVM.Extra.Nice.Value.Storable as Storable +import qualified LLVM.Extra.Nice.Value.Marshal as Marshal +import qualified LLVM.Extra.Nice.Value.Vector as NiceValueVec +import qualified LLVM.Extra.Nice.Value as NiceValue import qualified LLVM.Extra.Arithmetic as A import qualified LLVM.Core as LLVM @@ -43,15 +43,15 @@ newtype T n a = Cons (LLVM.Vector n a) deriving (Eq, Num) -type Value n a = MultiValue.T (T n a) +type Value n a = NiceValue.T (T n a) -instance (TypeNum.Positive n, MultiVector.C a) => MultiValue.C (T n a) where - type Repr (T n a) = MultiVector.Repr n a - cons (Cons v) = fromOrdinary $ MultiValue.cons v - undef = fromOrdinary MultiValue.undef - zero = fromOrdinary MultiValue.zero - phi bb = fmap fromOrdinary . MultiValue.phi bb . toOrdinary - addPhi bb a b = MultiValue.addPhi bb (toOrdinary a) (toOrdinary b) +instance (TypeNum.Positive n, NiceVector.C a) => NiceValue.C (T n a) where + type Repr (T n a) = NiceVector.Repr n a + cons (Cons v) = fromOrdinary $ NiceValue.cons v + undef = fromOrdinary NiceValue.undef + zero = fromOrdinary NiceValue.zero + phi bb = fmap fromOrdinary . NiceValue.phi bb . toOrdinary + addPhi bb a b = NiceValue.addPhi bb (toOrdinary a) (toOrdinary b) instance (Marshal.Vector n a) => Marshal.C (T n a) where pack (Cons v) = Marshal.pack v @@ -64,113 +64,113 @@ peek ptr = Cons <$> Store.peek (castPtr ptr) instance - (TypeNum.Positive n, Storable.Vector a, MultiVector.C a) => + (TypeNum.Positive n, Storable.Vector a, NiceVector.C a) => Storable.C (T n a) where load ptr = fmap fromOrdinary $ Storable.load =<< LLVM.bitcast ptr store v ptr = Storable.store (toOrdinary v) =<< LLVM.bitcast ptr instance - (TypeNum.Positive n, MultiVector.IntegerConstant a) => - MultiValue.IntegerConstant (T n a) where - fromInteger' = fromMultiVector . MultiVector.fromInteger' + (TypeNum.Positive n, NiceVector.IntegerConstant a) => + NiceValue.IntegerConstant (T n a) where + fromInteger' = fromNiceVector . NiceVector.fromInteger' instance - (TypeNum.Positive n, MultiVector.RationalConstant a) => - MultiValue.RationalConstant (T n a) where - fromRational' = fromMultiVector . MultiVector.fromRational' + (TypeNum.Positive n, NiceVector.RationalConstant a) => + NiceValue.RationalConstant (T n a) where + fromRational' = fromNiceVector . NiceVector.fromRational' instance - (TypeNum.Positive n, MultiVector.Additive a) => - MultiValue.Additive (T n a) where - add = lift2 MultiVector.add - sub = lift2 MultiVector.sub - neg = lift1 MultiVector.neg + (TypeNum.Positive n, NiceVector.Additive a) => + NiceValue.Additive (T n a) where + add = lift2 NiceVector.add + sub = lift2 NiceVector.sub + neg = lift1 NiceVector.neg instance - (TypeNum.Positive n, MultiVector.PseudoRing a) => - MultiValue.PseudoRing (T n a) where - mul = lift2 MultiVector.mul + (TypeNum.Positive n, NiceVector.PseudoRing a) => + NiceValue.PseudoRing (T n a) where + mul = lift2 NiceVector.mul scale :: - (TypeNum.Positive n, MultiVector.PseudoRing a) => - MultiValue.T a -> Value n a -> LLVM.CodeGenFunction r (Value n a) -scale = lift1 . MultiVector.scale + (TypeNum.Positive n, NiceVector.PseudoRing a) => + NiceValue.T a -> Value n a -> LLVM.CodeGenFunction r (Value n a) +scale = lift1 . NiceVector.scale instance - (TypeNum.Positive n, MultiVector.Real a) => - MultiValue.Real (T n a) where - min = lift2 MultiVector.min - max = lift2 MultiVector.max - abs = lift1 MultiVector.abs - signum = lift1 MultiVector.signum + (TypeNum.Positive n, NiceVector.Real a) => + NiceValue.Real (T n a) where + min = lift2 NiceVector.min + max = lift2 NiceVector.max + abs = lift1 NiceVector.abs + signum = lift1 NiceVector.signum instance - (TypeNum.Positive n, MultiVector.Fraction a) => - MultiValue.Fraction (T n a) where - truncate = lift1 MultiVector.truncate - fraction = lift1 MultiVector.fraction + (TypeNum.Positive n, NiceVector.Fraction a) => + NiceValue.Fraction (T n a) where + truncate = lift1 NiceVector.truncate + fraction = lift1 NiceVector.fraction instance - (TypeNum.Positive n, MultiVector.Field a) => - MultiValue.Field (T n a) where - fdiv = lift2 MultiVector.fdiv + (TypeNum.Positive n, NiceVector.Field a) => + NiceValue.Field (T n a) where + fdiv = lift2 NiceVector.fdiv instance - (TypeNum.Positive n, MultiVector.Algebraic a) => - MultiValue.Algebraic (T n a) where - sqrt = lift1 MultiVector.sqrt + (TypeNum.Positive n, NiceVector.Algebraic a) => + NiceValue.Algebraic (T n a) where + sqrt = lift1 NiceVector.sqrt instance - (TypeNum.Positive n, MultiVector.Transcendental a) => - MultiValue.Transcendental (T n a) where - pi = fmap fromMultiVector MultiVector.pi - sin = lift1 MultiVector.sin - log = lift1 MultiVector.log - exp = lift1 MultiVector.exp - cos = lift1 MultiVector.cos - pow = lift2 MultiVector.pow + (TypeNum.Positive n, NiceVector.Transcendental a) => + NiceValue.Transcendental (T n a) where + pi = fmap fromNiceVector NiceVector.pi + sin = lift1 NiceVector.sin + log = lift1 NiceVector.log + exp = lift1 NiceVector.exp + cos = lift1 NiceVector.cos + pow = lift2 NiceVector.pow instance (TypeNum.Positive n, n ~ m, - MultiVector.NativeInteger n a ar, - MultiValue.NativeInteger a ar) => - MultiValueVec.NativeInteger (T n a) (LLVM.Vector m ar) where + NiceVector.NativeInteger n a ar, + NiceValue.NativeInteger a ar) => + NiceValueVec.NativeInteger (T n a) (LLVM.Vector m ar) where instance (TypeNum.Positive n, n ~ m, - MultiVector.NativeFloating n a ar, - MultiValue.NativeFloating a ar) => - MultiValueVec.NativeFloating (T n a) (LLVM.Vector m ar) where + NiceVector.NativeFloating n a ar, + NiceValue.NativeFloating a ar) => + NiceValueVec.NativeFloating (T n a) (LLVM.Vector m ar) where lift1 :: (Functor f) => - (MultiVector.T n a -> f (MultiVector.T m b)) -> + (NiceVector.T n a -> f (NiceVector.T m b)) -> (Value n a -> f (Value m b)) -lift1 f a = fromMultiVector <$> f (toMultiVector a) +lift1 f a = fromNiceVector <$> f (toNiceVector a) lift2 :: (Functor f) => - (MultiVector.T n a -> MultiVector.T m b -> f (MultiVector.T k c)) -> + (NiceVector.T n a -> NiceVector.T m b -> f (NiceVector.T k c)) -> (Value n a -> Value m b -> f (Value k c)) -lift2 f a b = fromMultiVector <$> f (toMultiVector a) (toMultiVector b) +lift2 f a b = fromNiceVector <$> f (toNiceVector a) (toNiceVector b) extract :: (TypeNum.Positive n, - MultiVector.C x, MultiValue.T x ~ a, Value n x ~ v) => + NiceVector.C x, NiceValue.T x ~ a, Value n x ~ v) => LLVM.Value Word32 -> v -> LLVM.CodeGenFunction r a -extract i v = MultiVector.extract i (toMultiVector v) +extract i v = NiceVector.extract i (toNiceVector v) insert :: (TypeNum.Positive n, - MultiVector.C x, MultiValue.T x ~ a, Value n x ~ v) => + NiceVector.C x, NiceValue.T x ~ a, Value n x ~ v) => LLVM.Value Word32 -> a -> v -> LLVM.CodeGenFunction r v insert i a v = - fromMultiVector <$> MultiVector.insert i a (toMultiVector v) + fromNiceVector <$> NiceVector.insert i a (toNiceVector v) modify :: (TypeNum.Positive n, - MultiVector.C x, MultiValue.T x ~ a, Value n x ~ v) => + NiceVector.C x, NiceValue.T x ~ a, Value n x ~ v) => LLVM.Value Word32 -> (a -> LLVM.CodeGenFunction r a) -> v -> LLVM.CodeGenFunction r v @@ -178,28 +178,28 @@ assemble :: - (TypeNum.Positive n, MultiVector.C a) => - [MultiValue.T a] -> + (TypeNum.Positive n, NiceVector.C a) => + [NiceValue.T a] -> LLVM.CodeGenFunction r (Value n a) -assemble = fmap fromMultiVector . MultiVector.assemble +assemble = fmap fromNiceVector . NiceVector.assemble dissect :: - (TypeNum.Positive n, MultiVector.C a) => + (TypeNum.Positive n, NiceVector.C a) => Value n a -> - LLVM.CodeGenFunction r [MultiValue.T a] -dissect = MultiVector.dissect . toMultiVector + LLVM.CodeGenFunction r [NiceValue.T a] +dissect = NiceVector.dissect . toNiceVector assemble1 :: - (TypeNum.Positive n, MultiVector.C a) => - NonEmpty.T [] (MultiValue.T a) -> + (TypeNum.Positive n, NiceVector.C a) => + NonEmpty.T [] (NiceValue.T a) -> LLVM.CodeGenFunction r (Value n a) -assemble1 = fmap fromMultiVector . MultiVector.assemble1 +assemble1 = fmap fromNiceVector . NiceVector.assemble1 dissect1 :: - (TypeNum.Positive n, MultiVector.C a) => + (TypeNum.Positive n, NiceVector.C a) => Value n a -> - LLVM.CodeGenFunction r (NonEmpty.T [] (MultiValue.T a)) -dissect1 = MultiVector.dissect1 . toMultiVector + LLVM.CodeGenFunction r (NonEmpty.T [] (NiceValue.T a)) +dissect1 = NiceVector.dissect1 . toNiceVector sizeS :: TypeNum.Positive n => Value n a -> TypeNum.Singleton n @@ -210,70 +210,70 @@ last :: - (TypeNum.Positive n, MultiVector.C a) => - Value n a -> LLVM.CodeGenFunction r (MultiValue.T a) + (TypeNum.Positive n, NiceVector.C a) => + Value n a -> LLVM.CodeGenFunction r (NiceValue.T a) last v = extract (LLVM.valueOf (size v - 1 :: Word32)) v subsample :: - (TypeNum.Positive n, MultiVector.C a) => - Value n a -> LLVM.CodeGenFunction r (MultiValue.T a) + (TypeNum.Positive n, NiceVector.C a) => + Value n a -> LLVM.CodeGenFunction r (NiceValue.T a) subsample = extract (A.zero :: LLVM.Value Word32) upsample :: - (TypeNum.Positive n, MultiVector.C a) => - MultiValue.T a -> LLVM.CodeGenFunction r (Value n a) -upsample = fmap fromOrdinary . MultiValueVec.replicate + (TypeNum.Positive n, NiceVector.C a) => + NiceValue.T a -> LLVM.CodeGenFunction r (Value n a) +upsample = fmap fromOrdinary . NiceValueVec.replicate reverse :: - (TypeNum.Positive n, MultiVector.C a) => + (TypeNum.Positive n, NiceVector.C a) => Value n a -> LLVM.CodeGenFunction r (Value n a) reverse = - fmap fromMultiVector . MultiVector.reverse . toMultiVector + fmap fromNiceVector . NiceVector.reverse . toNiceVector shiftUp :: - (TypeNum.Positive n, MultiVector.C x, - MultiValue.T x ~ a, Value n x ~ v) => + (TypeNum.Positive n, NiceVector.C x, + NiceValue.T x ~ a, Value n x ~ v) => a -> v -> LLVM.CodeGenFunction r (a, v) shiftUp a v = - mapSnd fromMultiVector <$> MultiVector.shiftUp a (toMultiVector v) + mapSnd fromNiceVector <$> NiceVector.shiftUp a (toNiceVector v) shiftUpMultiZero :: - (TypeNum.Positive n, MultiVector.C x, Value n x ~ v) => + (TypeNum.Positive n, NiceVector.C x, Value n x ~ v) => Int -> v -> LLVM.CodeGenFunction r v shiftUpMultiZero k v = - fromMultiVector <$> MultiVector.shiftUpMultiZero k (toMultiVector v) + fromNiceVector <$> NiceVector.shiftUpMultiZero k (toNiceVector v) shiftDown :: - (TypeNum.Positive n, MultiVector.C x, - MultiValue.T x ~ a, Value n x ~ v) => + (TypeNum.Positive n, NiceVector.C x, + NiceValue.T x ~ a, Value n x ~ v) => a -> v -> LLVM.CodeGenFunction r (a, v) shiftDown a v = - mapSnd fromMultiVector <$> MultiVector.shiftDown a (toMultiVector v) + mapSnd fromNiceVector <$> NiceVector.shiftDown a (toNiceVector v) iterate :: - (TypeNum.Positive n, MultiVector.C a) => - (MultiValue.T a -> LLVM.CodeGenFunction r (MultiValue.T a)) -> - MultiValue.T a -> LLVM.CodeGenFunction r (Value n a) -iterate f = fmap fromOrdinary . MultiValueVec.iterate f + (TypeNum.Positive n, NiceVector.C a) => + (NiceValue.T a -> LLVM.CodeGenFunction r (NiceValue.T a)) -> + NiceValue.T a -> LLVM.CodeGenFunction r (Value n a) +iterate f = fmap fromOrdinary . NiceValueVec.iterate f cumulate :: - (TypeNum.Positive n, MultiVector.Additive a) => - MultiValue.T a -> Value n a -> - LLVM.CodeGenFunction r (MultiValue.T a, Value n a) + (TypeNum.Positive n, NiceVector.Additive a) => + NiceValue.T a -> Value n a -> + LLVM.CodeGenFunction r (NiceValue.T a, Value n a) cumulate a = - fmap (mapSnd fromMultiVector) . MultiVector.cumulate a . toMultiVector + fmap (mapSnd fromNiceVector) . NiceVector.cumulate a . toNiceVector -fromOrdinary :: MultiValue.T (LLVM.Vector n a) -> Value n a -fromOrdinary = MultiValue.cast +fromOrdinary :: NiceValue.T (LLVM.Vector n a) -> Value n a +fromOrdinary = NiceValue.cast -toOrdinary :: Value n a -> MultiValue.T (LLVM.Vector n a) -toOrdinary = MultiValue.cast +toOrdinary :: Value n a -> NiceValue.T (LLVM.Vector n a) +toOrdinary = NiceValue.cast -fromMultiVector :: MultiVector.T n a -> Value n a -fromMultiVector = fromOrdinary . MultiVectorInst.toMultiValue +fromNiceVector :: NiceVector.T n a -> Value n a +fromNiceVector = fromOrdinary . NiceVectorInst.toNiceValue -toMultiVector :: Value n a -> MultiVector.T n a -toMultiVector = MultiVectorInst.fromMultiValue . toOrdinary +toNiceVector :: Value n a -> NiceVector.T n a +toNiceVector = NiceVectorInst.fromNiceValue . toOrdinary diff --git a/src/Synthesizer/LLVM/Frame/Stereo.hs b/src/Synthesizer/LLVM/Frame/Stereo.hs --- a/src/Synthesizer/LLVM/Frame/Stereo.hs +++ b/src/Synthesizer/LLVM/Frame/Stereo.hs @@ -12,9 +12,9 @@ Stereo.T, Stereo.cons, Stereo.left, Stereo.right, Stereo.Channel(Stereo.Left, Stereo.Right), Stereo.select, Stereo.swap, - multiValue, unMultiValue, consMultiValue, unExpression, - multiVector, unMultiVector, - multiValueSerial, unMultiValueSerial, + niceValue, unNiceValue, consNiceValue, unExpression, + niceVector, unNiceVector, + niceValueSerial, unNiceValueSerial, Stereo.arrowFromMono, Stereo.arrowFromMonoControlled, Stereo.arrowFromChannels, @@ -29,10 +29,10 @@ import qualified LLVM.DSL.Expression as Expr import qualified LLVM.DSL.Value as Value -import qualified LLVM.Extra.Multi.Vector as MultiVector -import qualified LLVM.Extra.Multi.Value.Storable as StorableMV -import qualified LLVM.Extra.Multi.Value.Marshal as MarshalMV -import qualified LLVM.Extra.Multi.Value as MultiValue +import qualified LLVM.Extra.Nice.Vector as NiceVector +import qualified LLVM.Extra.Nice.Value.Storable as StorableNice +import qualified LLVM.Extra.Nice.Value.Marshal as MarshalNice +import qualified LLVM.Extra.Nice.Value as NiceValue import qualified LLVM.Extra.Tuple as Tuple import qualified LLVM.Extra.Storable as Storable import qualified LLVM.Extra.Marshal as Marshal @@ -74,87 +74,87 @@ Tuple.addPhi bb (Stereo.left x) (Stereo.left y) Tuple.addPhi bb (Stereo.right x) (Stereo.right y) -instance (MultiValue.C a) => MultiValue.C (Stereo.T a) where - type Repr (Stereo.T a) = Stereo.T (MultiValue.Repr a) - cons = multiValue . fmap MultiValue.cons - undef = multiValue $ pure MultiValue.undef - zero = multiValue $ pure MultiValue.zero - phi bb = fmap multiValue . Trav.traverse (MultiValue.phi bb) . unMultiValue +instance (NiceValue.C a) => NiceValue.C (Stereo.T a) where + type Repr (Stereo.T a) = Stereo.T (NiceValue.Repr a) + cons = niceValue . fmap NiceValue.cons + undef = niceValue $ pure NiceValue.undef + zero = niceValue $ pure NiceValue.zero + phi bb = fmap niceValue . Trav.traverse (NiceValue.phi bb) . unNiceValue addPhi bb a b = Fold.sequence_ $ - liftA2 (MultiValue.addPhi bb) (unMultiValue a) (unMultiValue b) + liftA2 (NiceValue.addPhi bb) (unNiceValue a) (unNiceValue b) -instance (MultiValue.Compose a) => MultiValue.Compose (Stereo.T a) where - type Composed (Stereo.T a) = Stereo.T (MultiValue.Composed a) - compose = multiValue . fmap MultiValue.compose +instance (NiceValue.Compose a) => NiceValue.Compose (Stereo.T a) where + type Composed (Stereo.T a) = Stereo.T (NiceValue.Composed a) + compose = niceValue . fmap NiceValue.compose -instance (MultiValue.Decompose p) => MultiValue.Decompose (Stereo.T p) where - decompose p = liftA2 MultiValue.decompose p . unMultiValue +instance (NiceValue.Decompose p) => NiceValue.Decompose (Stereo.T p) where + decompose p = liftA2 NiceValue.decompose p . unNiceValue -type instance MultiValue.Decomposed f (Stereo.T pa) = - Stereo.T (MultiValue.Decomposed f pa) -type instance MultiValue.PatternTuple (Stereo.T pa) = - Stereo.T (MultiValue.PatternTuple pa) +type instance NiceValue.Decomposed f (Stereo.T pa) = + Stereo.T (NiceValue.Decomposed f pa) +type instance NiceValue.PatternTuple (Stereo.T pa) = + Stereo.T (NiceValue.PatternTuple pa) -multiValue :: Stereo.T (MultiValue.T a) -> MultiValue.T (Stereo.T a) -multiValue = MultiValue.Cons . fmap (\(MultiValue.Cons a) -> a) +niceValue :: Stereo.T (NiceValue.T a) -> NiceValue.T (Stereo.T a) +niceValue = NiceValue.Cons . fmap (\(NiceValue.Cons a) -> a) -unMultiValue :: MultiValue.T (Stereo.T a) -> Stereo.T (MultiValue.T a) -unMultiValue (MultiValue.Cons x) = fmap MultiValue.Cons x +unNiceValue :: NiceValue.T (Stereo.T a) -> Stereo.T (NiceValue.T a) +unNiceValue (NiceValue.Cons x) = fmap NiceValue.Cons x -consMultiValue :: MultiValue.T a -> MultiValue.T a -> MultiValue.T (Stereo.T a) -consMultiValue l r = multiValue $ Stereo.cons l r +consNiceValue :: NiceValue.T a -> NiceValue.T a -> NiceValue.T (Stereo.T a) +consNiceValue l r = niceValue $ Stereo.cons l r unExpression :: Expr.Exp (Stereo.T a) -> Stereo.T (Expr.Exp a) unExpression x = Stereo.cons - (Expr.lift1 (MultiValue.lift1 Stereo.left) x) - (Expr.lift1 (MultiValue.lift1 Stereo.right) x) + (Expr.lift1 (NiceValue.lift1 Stereo.left) x) + (Expr.lift1 (NiceValue.lift1 Stereo.right) x) -instance (MultiVector.C a) => MultiVector.C (Stereo.T a) where - type Repr n (Stereo.T a) = Stereo.T (MultiVector.Repr n a) - cons = multiVector . fmap MultiVector.cons . Stereo.sequence - undef = multiVector $ pure MultiVector.undef - zero = multiVector $ pure MultiVector.zero +instance (NiceVector.C a) => NiceVector.C (Stereo.T a) where + type Repr n (Stereo.T a) = Stereo.T (NiceVector.Repr n a) + cons = niceVector . fmap NiceVector.cons . Stereo.sequence + undef = niceVector $ pure NiceVector.undef + zero = niceVector $ pure NiceVector.zero phi bb = - fmap multiVector . Trav.traverse (MultiVector.phi bb) . unMultiVector + fmap niceVector . Trav.traverse (NiceVector.phi bb) . unNiceVector addPhi bb a b = Fold.sequence_ $ - liftA2 (MultiVector.addPhi bb) (unMultiVector a) (unMultiVector b) + liftA2 (NiceVector.addPhi bb) (unNiceVector a) (unNiceVector b) shuffle is u v = - multiVector <$> - traverse2 (MultiVector.shuffle is) (unMultiVector u) (unMultiVector v) + niceVector <$> + traverse2 (NiceVector.shuffle is) (unNiceVector u) (unNiceVector v) extract k = - fmap multiValue . Trav.traverse (MultiVector.extract k) . unMultiVector + fmap niceValue . Trav.traverse (NiceVector.extract k) . unNiceVector insert k a v = - multiVector <$> - traverse2 (MultiVector.insert k) (unMultiValue a) (unMultiVector v) + niceVector <$> + traverse2 (NiceVector.insert k) (unNiceValue a) (unNiceVector v) -multiVector :: Stereo.T (MultiVector.T n a) -> MultiVector.T n (Stereo.T a) -multiVector = MultiVector.Cons . fmap (\(MultiVector.Cons a) -> a) +niceVector :: Stereo.T (NiceVector.T n a) -> NiceVector.T n (Stereo.T a) +niceVector = NiceVector.Cons . fmap (\(NiceVector.Cons a) -> a) -unMultiVector :: MultiVector.T n (Stereo.T a) -> Stereo.T (MultiVector.T n a) -unMultiVector (MultiVector.Cons x) = fmap MultiVector.Cons x +unNiceVector :: NiceVector.T n (Stereo.T a) -> Stereo.T (NiceVector.T n a) +unNiceVector (NiceVector.Cons x) = fmap NiceVector.Cons x -multiValueSerial :: - Stereo.T (MultiValue.T (Serial.T n a)) -> - MultiValue.T (Serial.T n (Stereo.T a)) -multiValueSerial = MultiValue.Cons . fmap (\(MultiValue.Cons a) -> a) +niceValueSerial :: + Stereo.T (NiceValue.T (Serial.T n a)) -> + NiceValue.T (Serial.T n (Stereo.T a)) +niceValueSerial = NiceValue.Cons . fmap (\(NiceValue.Cons a) -> a) -unMultiValueSerial :: - MultiValue.T (Serial.T n (Stereo.T a)) -> - Stereo.T (MultiValue.T (Serial.T n a)) -unMultiValueSerial (MultiValue.Cons x) = fmap MultiValue.Cons x +unNiceValueSerial :: + NiceValue.T (Serial.T n (Stereo.T a)) -> + Stereo.T (NiceValue.T (Serial.T n a)) +unNiceValueSerial (NiceValue.Cons x) = fmap NiceValue.Cons x instance - (Expr.Aggregate e mv) => Expr.Aggregate (Stereo.T e) (Stereo.T mv) where - type MultiValuesOf (Stereo.T e) = Stereo.T (Expr.MultiValuesOf e) - type ExpressionsOf (Stereo.T mv) = Stereo.T (Expr.ExpressionsOf mv) + (Expr.Aggregate e nv) => Expr.Aggregate (Stereo.T e) (Stereo.T nv) where + type NiceValuesOf (Stereo.T e) = Stereo.T (Expr.NiceValuesOf e) + type ExpressionsOf (Stereo.T nv) = Stereo.T (Expr.ExpressionsOf nv) bundle = Trav.traverse Expr.bundle dissect = fmap Expr.dissect @@ -194,23 +194,23 @@ load = Storable.loadApplicative store = Storable.storeFoldable -instance (MarshalMV.C l) => MarshalMV.C (Stereo.T l) where - pack x = MarshalMV.pack (Stereo.left x, Stereo.right x) - unpack = uncurry Stereo.cons . MarshalMV.unpack +instance (MarshalNice.C l) => MarshalNice.C (Stereo.T l) where + pack x = MarshalNice.pack (Stereo.left x, Stereo.right x) + unpack = uncurry Stereo.cons . MarshalNice.unpack -instance (StorableMV.C l) => StorableMV.C (Stereo.T l) where - load = StorableMV.loadApplicative - store = StorableMV.storeFoldable +instance (StorableNice.C l) => StorableNice.C (Stereo.T l) where + load = StorableNice.loadApplicative + store = StorableNice.storeFoldable instance - (StorableMV.Vector l, MultiVector.C l) => - StorableMV.Vector (Stereo.T l) where + (StorableNice.Vector l, NiceVector.C l) => + StorableNice.Vector (Stereo.T l) where assembleVector p = - Trav.traverse (StorableMV.assembleVector (Stereo.left<$>p)) . + Trav.traverse (StorableNice.assembleVector (Stereo.left<$>p)) . Stereo.sequence disassembleVector p = fmap (\x -> liftA2 Stereo.cons (Stereo.left x) (Stereo.right x)) . - Trav.traverse (StorableMV.disassembleVector (Stereo.left<$>p)) + Trav.traverse (StorableNice.disassembleVector (Stereo.left<$>p)) {- @@ -239,12 +239,12 @@ -instance (MultiValue.Additive a) => MultiValue.Additive (Stereo.T a) where +instance (NiceValue.Additive a) => NiceValue.Additive (Stereo.T a) where add x y = - multiValue <$> traverse2 MultiValue.add (unMultiValue x) (unMultiValue y) + niceValue <$> traverse2 NiceValue.add (unNiceValue x) (unNiceValue y) sub x y = - multiValue <$> traverse2 MultiValue.sub (unMultiValue x) (unMultiValue y) - neg x = multiValue <$> Trav.traverse MultiValue.neg (unMultiValue x) + niceValue <$> traverse2 NiceValue.sub (unNiceValue x) (unNiceValue y) + neg x = niceValue <$> Trav.traverse NiceValue.neg (unNiceValue x) traverse2 :: diff --git a/src/Synthesizer/LLVM/Frame/StereoInterleaved.hs b/src/Synthesizer/LLVM/Frame/StereoInterleaved.hs --- a/src/Synthesizer/LLVM/Frame/StereoInterleaved.hs +++ b/src/Synthesizer/LLVM/Frame/StereoInterleaved.hs @@ -16,18 +16,18 @@ import qualified LLVM.DSL.Expression as Expr import LLVM.DSL.Expression (Exp) -import qualified LLVM.Extra.Multi.Vector as MultiVector +import qualified LLVM.Extra.Nice.Vector as NiceVector import qualified Type.Data.Num.Decimal as TypeNum interleave :: - (TypeNum.Positive n, MultiVector.C a) => + (TypeNum.Positive n, NiceVector.C a) => Stereo.T (Exp (Serial.T n a)) -> Exp (T n a) interleave = Expr.liftM StereoInt.interleave deinterleave :: - (TypeNum.Positive n, MultiVector.C a) => + (TypeNum.Positive n, NiceVector.C a) => Exp (T n a) -> Stereo.T (Exp (Serial.T n a)) deinterleave x = Stereo.cons @@ -35,11 +35,11 @@ (Expr.liftM (fmap Stereo.right . StereoInt.deinterleave) x) amplify :: - (TypeNum.Positive n, MultiVector.PseudoRing a) => + (TypeNum.Positive n, NiceVector.PseudoRing a) => Exp a -> Exp (T n a) -> Exp (T n a) amplify = Expr.liftM2 StereoInt.scale envelope :: - (TypeNum.Positive n, MultiVector.PseudoRing a) => + (TypeNum.Positive n, NiceVector.PseudoRing a) => Exp (Serial.T n a) -> Exp (T n a) -> Exp (T n a) envelope = Expr.liftM2 StereoInt.envelope diff --git a/src/Synthesizer/LLVM/Frame/StereoInterleavedCode.hs b/src/Synthesizer/LLVM/Frame/StereoInterleavedCode.hs --- a/src/Synthesizer/LLVM/Frame/StereoInterleavedCode.hs +++ b/src/Synthesizer/LLVM/Frame/StereoInterleavedCode.hs @@ -37,10 +37,10 @@ import qualified Synthesizer.LLVM.Frame.Stereo as Stereo import qualified Synthesizer.LLVM.Frame.SerialVector.Code as Serial -import qualified LLVM.Extra.Multi.Vector as MultiVector -import qualified LLVM.Extra.Multi.Value.Storable as Storable -import qualified LLVM.Extra.Multi.Value.Marshal as Marshal -import qualified LLVM.Extra.Multi.Value as MultiValue +import qualified LLVM.Extra.Nice.Vector as NiceVector +import qualified LLVM.Extra.Nice.Value.Storable as Storable +import qualified LLVM.Extra.Nice.Value.Marshal as Marshal +import qualified LLVM.Extra.Nice.Value as NiceValue import qualified LLVM.Extra.Arithmetic as A import qualified LLVM.Core as LLVM import LLVM.Core (Vector) @@ -61,7 +61,7 @@ data T n a = Cons (Vector n a) (Vector n a) -type Value n a = MultiValue.T (T n a) +type Value n a = NiceValue.T (T n a) withSize :: (TypeNum.Natural n) => (Int -> m (Value n a)) -> m (Value n a) @@ -74,41 +74,41 @@ interleave :: - (TypeNum.Positive n, MultiVector.C a) => + (TypeNum.Positive n, NiceVector.C a) => Stereo.T (Serial.Value n a) -> LLVM.CodeGenFunction r (Value n a) interleave x = - assemble . map Stereo.unMultiValue - =<< Serial.dissect (Stereo.multiValueSerial x) + assemble . map Stereo.unNiceValue + =<< Serial.dissect (Stereo.niceValueSerial x) deinterleave :: - (TypeNum.Positive n, MultiVector.C a) => + (TypeNum.Positive n, NiceVector.C a) => Value n a -> LLVM.CodeGenFunction r (Stereo.T (Serial.Value n a)) deinterleave v = - Stereo.unMultiValueSerial <$> - (Serial.assemble . map Stereo.multiValue =<< dissect v) + Stereo.unNiceValueSerial <$> + (Serial.assemble . map Stereo.niceValue =<< dissect v) fromMono :: - (TypeNum.Positive n, MultiVector.C a) => + (TypeNum.Positive n, NiceVector.C a) => Serial.Value n a -> LLVM.CodeGenFunction r (Value n a) fromMono x = assemble . map pure =<< Serial.dissect x assemble :: - (TypeNum.Positive n, MultiVector.C a) => - [Stereo.T (MultiValue.T a)] -> LLVM.CodeGenFunction r (Value n a) + (TypeNum.Positive n, NiceVector.C a) => + [Stereo.T (NiceValue.T a)] -> LLVM.CodeGenFunction r (Value n a) assemble x = withSize $ \n -> uncurry (liftA2 merge) . - mapPair (MultiVector.assemble, MultiVector.assemble) . + mapPair (NiceVector.assemble, NiceVector.assemble) . splitAt n . concatMap Fold.toList $ x dissect :: - (TypeNum.Positive n, MultiVector.C a) => - Value n a -> LLVM.CodeGenFunction r [Stereo.T (MultiValue.T a)] + (TypeNum.Positive n, NiceVector.C a) => + Value n a -> LLVM.CodeGenFunction r [Stereo.T (NiceValue.T a)] dissect v = let (v0,v1) = split v in fmap @@ -117,46 +117,46 @@ aux _ = error "odd number of stereo elements" in aux) $ liftA2 (++) - (MultiVector.dissect v0) - (MultiVector.dissect v1) + (NiceVector.dissect v0) + (NiceVector.dissect v1) -merge :: MultiVector.T n a -> MultiVector.T n a -> MultiValue.T (T n a) -merge (MultiVector.Cons a) (MultiVector.Cons b) = MultiValue.Cons (a,b) +merge :: NiceVector.T n a -> NiceVector.T n a -> NiceValue.T (T n a) +merge (NiceVector.Cons a) (NiceVector.Cons b) = NiceValue.Cons (a,b) -split :: MultiValue.T (T n a) -> (MultiVector.T n a, MultiVector.T n a) -split (MultiValue.Cons (a,b)) = (MultiVector.Cons a, MultiVector.Cons b) +split :: NiceValue.T (T n a) -> (NiceVector.T n a, NiceVector.T n a) +split (NiceValue.Cons (a,b)) = (NiceVector.Cons a, NiceVector.Cons b) merge_ :: - MultiValue.T (Vector n a) -> MultiValue.T (Vector n a) -> - MultiValue.T (T n a) -merge_ (MultiValue.Cons a) (MultiValue.Cons b) = MultiValue.Cons (a,b) + NiceValue.T (Vector n a) -> NiceValue.T (Vector n a) -> + NiceValue.T (T n a) +merge_ (NiceValue.Cons a) (NiceValue.Cons b) = NiceValue.Cons (a,b) split_ :: - MultiValue.T (T n a) -> - (MultiValue.T (Vector n a), MultiValue.T (Vector n a)) -split_ (MultiValue.Cons (a,b)) = (MultiValue.Cons a, MultiValue.Cons b) + NiceValue.T (T n a) -> + (NiceValue.T (Vector n a), NiceValue.T (Vector n a)) +split_ (NiceValue.Cons (a,b)) = (NiceValue.Cons a, NiceValue.Cons b) -instance (TypeNum.Positive n, MultiVector.C a) => MultiValue.C (T n a) where - type Repr (T n a) = (MultiVector.Repr n a, MultiVector.Repr n a) - cons (Cons v0 v1) = merge (MultiVector.cons v0) (MultiVector.cons v1) - undef = merge MultiVector.undef MultiVector.undef - zero = merge MultiVector.zero MultiVector.zero +instance (TypeNum.Positive n, NiceVector.C a) => NiceValue.C (T n a) where + type Repr (T n a) = (NiceVector.Repr n a, NiceVector.Repr n a) + cons (Cons v0 v1) = merge (NiceVector.cons v0) (NiceVector.cons v1) + undef = merge NiceVector.undef NiceVector.undef + zero = merge NiceVector.zero NiceVector.zero phi bb = fmap (uncurry merge) . - AppHT.mapPair (MultiVector.phi bb, MultiVector.phi bb) . split + AppHT.mapPair (NiceVector.phi bb, NiceVector.phi bb) . split addPhi bb a b = case (split a, split b) of ((a0,a1), (b0,b1)) -> do - MultiVector.addPhi bb a0 b0 - MultiVector.addPhi bb a1 b1 + NiceVector.addPhi bb a0 b0 + NiceVector.addPhi bb a1 b1 instance (Marshal.Vector n a) => Marshal.C (T n a) where pack (Cons v0 v1) = Marshal.pack (v0,v1) unpack = uncurry Cons . Marshal.unpack instance - (TypeNum.Positive n, MultiVector.C a, St.Storable a) => + (TypeNum.Positive n, NiceVector.C a, St.Storable a) => St.Storable (T n a) where sizeOf ~(Cons v0 v1) = St.sizeOf v0 + St.sizeOf v1 alignment ~(Cons v _) = St.alignment v @@ -191,8 +191,8 @@ This instance allows to run @arrange@ on interleaved stereo vectors. -} instance - (TypeNum.Positive n, MultiVector.Additive a) => - MultiValue.Additive (T n a) where + (TypeNum.Positive n, NiceVector.Additive a) => + NiceValue.Additive (T n a) where add = zipV merge A.add sub = zipV merge A.sub neg = mapV A.neg @@ -203,26 +203,26 @@ scale :: - (TypeNum.Positive n, MultiVector.PseudoRing a) => - MultiValue.T a -> Value n a -> LLVM.CodeGenFunction r (Value n a) + (TypeNum.Positive n, NiceVector.PseudoRing a) => + NiceValue.T a -> Value n a -> LLVM.CodeGenFunction r (Value n a) scale a v = do - av <- MultiVector.replicate a + av <- NiceVector.replicate a mapV (A.mul av) v amplify :: - (TypeNum.Positive n, MultiVector.PseudoRing a) => + (TypeNum.Positive n, NiceVector.PseudoRing a) => a -> Value n a -> LLVM.CodeGenFunction r (Value n a) -amplify a = scale (MultiValue.cons a) +amplify a = scale (NiceValue.cons a) envelope :: - (TypeNum.Positive n, MultiVector.PseudoRing a) => + (TypeNum.Positive n, NiceVector.PseudoRing a) => Serial.Value n a -> Value n a -> LLVM.CodeGenFunction r (Value n a) envelope e a = zipV merge (flip A.mul) a =<< fromMono e mapV :: (Applicative m) => - (MultiVector.T n a -> m (MultiVector.T n a)) -> + (NiceVector.T n a -> m (NiceVector.T n a)) -> Value n a -> m (Value n a) mapV f x = case split x of @@ -230,8 +230,8 @@ zipV :: (Applicative m) => (c -> c -> d) -> - (MultiVector.T n a -> - MultiVector.T n b -> + (NiceVector.T n a -> + NiceVector.T n b -> m c) -> Value n a -> Value n b -> diff --git a/src/Synthesizer/LLVM/Generator/Core.hs b/src/Synthesizer/LLVM/Generator/Core.hs --- a/src/Synthesizer/LLVM/Generator/Core.hs +++ b/src/Synthesizer/LLVM/Generator/Core.hs @@ -12,8 +12,8 @@ import qualified LLVM.DSL.Expression as Expr import LLVM.DSL.Expression (Exp) -import qualified LLVM.Extra.Multi.Value.Marshal as Marshal -import qualified LLVM.Extra.Multi.Value as MultiValue +import qualified LLVM.Extra.Nice.Value.Marshal as Marshal +import qualified LLVM.Extra.Nice.Value as NiceValue import qualified LLVM.Extra.Arithmetic as A import Control.Applicative ((<$>)) @@ -25,58 +25,58 @@ -type MV a = Sig.T (MultiValue.T a) +type Nice a = Sig.T (NiceValue.T a) -iterate :: (Marshal.C a) => (Exp a -> Exp a) -> Exp a -> MV a +iterate :: (Marshal.C a) => (Exp a -> Exp a) -> Exp a -> Nice a iterate f a = Sig.iterate (Expr.unliftM1 f) (Expr.unExp a) -- ToDo: replace by constantSharing and scanl iterateParam :: (Marshal.C a, Marshal.C b) => - (Exp b -> Exp a -> Exp a) -> Exp b -> Exp a -> MV a + (Exp b -> Exp a -> Exp a) -> Exp b -> Exp a -> Nice a iterateParam f b a = - MultiValue.snd <$> + NiceValue.snd <$> iterate (Expr.uncurry $ \bi ai -> Expr.zip bi $ f bi ai) (Expr.zip b a) ramp :: - (Marshal.C a, MultiValue.Additive a) => - Exp a -> Exp a -> MV a + (Marshal.C a, NiceValue.Additive a) => + Exp a -> Exp a -> Nice a ramp = iterateParam Expr.add parabola :: - (Marshal.C a, MultiValue.Additive a) => - Exp a -> Exp a -> Exp a -> MV a + (Marshal.C a, NiceValue.Additive a) => + Exp a -> Exp a -> Exp a -> Nice a parabola d2 d1 start = integrate start $* ramp d2 d1 integrate :: - (Marshal.C a, MultiValue.Additive a, MultiValue.T a ~ al) => + (Marshal.C a, NiceValue.Additive a, NiceValue.T a ~ al) => Exp a -> Causal.T al al integrate start = Causal.mapAccum (\a s -> (,) s <$> A.add s a) (Expr.unExp start) osci :: - (MultiValue.Fraction t, Marshal.C t) => - Exp t -> Exp t -> MV t + (NiceValue.Fraction t, Marshal.C t) => + Exp t -> Exp t -> Nice t osci phase freq = iterate (Expr.liftM2 A.incPhase freq) phase exponential :: - (Marshal.C a, MultiValue.PseudoRing a) => - Exp a -> Exp a -> MV a + (Marshal.C a, NiceValue.PseudoRing a) => + Exp a -> Exp a -> Nice a exponential = iterateParam Expr.mul exponentialBounded :: - (Marshal.C a, MultiValue.PseudoRing a, - MultiValue.Real a, MultiValue.IntegerConstant a) => - Exp a -> Exp a -> Exp a -> MV a + (Marshal.C a, NiceValue.PseudoRing a, + NiceValue.Real a, NiceValue.IntegerConstant a) => + Exp a -> Exp a -> Exp a -> Nice a exponentialBounded bound decay = iterateParam (\bk y -> case Expr.unzip bk of (b,k) -> Expr.max b $ k*y) (Expr.zip bound decay) -noise, noiseAlt :: Exp Word32 -> MV Word32 +noise, noiseAlt :: Exp Word32 -> Nice Word32 noise seed = iterate (Expr.liftReprM Rnd.nextCG) (Expr.irem seed (Expr.cons Rnd.modulus-1) + 1) diff --git a/src/Synthesizer/LLVM/Generator/Extra.hs b/src/Synthesizer/LLVM/Generator/Extra.hs --- a/src/Synthesizer/LLVM/Generator/Extra.hs +++ b/src/Synthesizer/LLVM/Generator/Extra.hs @@ -10,8 +10,8 @@ import qualified LLVM.DSL.Expression as Expr import LLVM.DSL.Expression (Exp) -import qualified LLVM.Extra.Multi.Value.Marshal as Marshal -import qualified LLVM.Extra.Multi.Value as MultiValue +import qualified LLVM.Extra.Nice.Value.Marshal as Marshal +import qualified LLVM.Extra.Nice.Value as NiceValue import Data.Word (Word) @@ -22,9 +22,9 @@ ramp, parabolaFadeIn, parabolaFadeOut, parabolaFadeInMap, parabolaFadeOutMap :: - (Marshal.C a, MultiValue.Field a, MultiValue.IntegerConstant a, - MultiValue.NativeFloating a ar) => - Exp Word -> Sig.MV a + (Marshal.C a, NiceValue.Field a, NiceValue.IntegerConstant a, + NiceValue.NativeFloating a ar) => + Exp Word -> Sig.Nice a ramp dur = Causal.take dur $* Sig.rampInf (Expr.fromIntegral dur) diff --git a/src/Synthesizer/LLVM/Generator/Render.hs b/src/Synthesizer/LLVM/Generator/Render.hs --- a/src/Synthesizer/LLVM/Generator/Render.hs +++ b/src/Synthesizer/LLVM/Generator/Render.hs @@ -5,7 +5,8 @@ {-# LANGUAGE ForeignFunctionInterface #-} module Synthesizer.LLVM.Generator.Render ( -- * type driven - RunArg, DSLArg, + Argument, DSLArg, + Run, DSL, Shape, run, runChunky, runChunkyOnVector, @@ -13,7 +14,8 @@ -- * explicit argument converters runExplicit, - build, -- ToDo: better name + function, + argument, WithShape, -- * utilities @@ -24,7 +26,7 @@ import qualified Synthesizer.LLVM.Causal.Parametric as Parametric import qualified Synthesizer.LLVM.Generator.Source as Source import Synthesizer.LLVM.Private.Render - (RunArg (DSLArg, buildArg), + (Argument (DSLArg, argument), Triple, tripleStruct, derefStartPtr, derefStopPtr) import Synthesizer.LLVM.Generator.Private (T(Cons)) @@ -39,9 +41,9 @@ import LLVM.DSL.Render.Run ((*->)) import LLVM.DSL.Expression (Exp(Exp)) -import qualified LLVM.Extra.Multi.Value.Storable as Storable -import qualified LLVM.Extra.Multi.Value.Marshal as Marshal -import qualified LLVM.Extra.Multi.Value as MultiValue +import qualified LLVM.Extra.Nice.Value.Storable as Storable +import qualified LLVM.Extra.Nice.Value.Marshal as Marshal +import qualified LLVM.Extra.Nice.Value as NiceValue import qualified LLVM.Extra.Memory as Memory import qualified LLVM.Extra.MaybeContinuation as MaybeCont import qualified LLVM.Extra.Maybe as Maybe @@ -73,7 +75,7 @@ compile :: - (Storable.C a, MultiValue.T a ~ value, + (Storable.C a, NiceValue.T a ~ value, Marshal.C param, Marshal.Struct param ~ paramStruct) => (Exp param -> T value) -> IO (LLVM.Ptr paramStruct -> Word -> Ptr a -> IO Word) @@ -92,7 +94,7 @@ return pos runAux :: - (Marshal.C p, Storable.C a, MultiValue.T a ~ value) => + (Marshal.C p, Storable.C a, NiceValue.T a ~ value) => (Exp p -> T value) -> IO (IO () -> Int -> p -> IO (SV.Vector a)) runAux sig = do fill <- compile sig @@ -104,7 +106,7 @@ return $ fromIntegral n _run :: - (Marshal.C p, Storable.C a, MultiValue.T a ~ value) => + (Marshal.C p, Storable.C a, NiceValue.T a ~ value) => (Exp p -> T value) -> IO (Int -> p -> IO (SV.Vector a)) _run = fmap ($ return ()) . runAux @@ -118,7 +120,7 @@ Memory.C global, Memory.Struct global ~ globalStruct, Triple paramStruct globalStruct stateStruct ~ triple, LLVM.IsSized local, - Storable.C a, MultiValue.T a ~ value) => + Storable.C a, NiceValue.T a ~ value) => (forall r z. (Tuple.Phi z) => pPtr -> global -> LLVM.Value (LLVM.Ptr local) -> () -> state -> MaybeCont.T r z (value, state)) -> @@ -171,7 +173,7 @@ runChunkyAux :: - (Storable.C a, MultiValue.T a ~ value, Marshal.C p) => + (Storable.C a, NiceValue.T a ~ value, Marshal.C p) => (Exp p -> T value) -> IO (IO () -> SVL.ChunkSize -> p -> IO (SVL.Vector a)) runChunkyAux sig = do paramd <- @@ -180,7 +182,7 @@ Parametric.Cons next start stop -> do (startFunc,stopFunc,fill) <- compileChunky next start stop return $ \final (SVL.ChunkSize size) p -> do - statePtr <- ForeignPtr.newParamMV stopFunc startFunc p + statePtr <- ForeignPtr.newParamNice stopFunc startFunc p let go = Unsafe.interleaveIO $ do @@ -198,14 +200,14 @@ fmap SVL.fromChunks go runChunky :: - (Storable.C a, MultiValue.T a ~ value, Marshal.C p) => + (Storable.C a, NiceValue.T a ~ value, Marshal.C p) => (Exp p -> T value) -> IO (SVL.ChunkSize -> p -> IO (SVL.Vector a)) runChunky = fmap ($ return ()) . runChunkyAux runChunkyOnVector :: - (Storable.C a, MultiValue.T a ~ al) => - (Storable.C b, MultiValue.T b ~ bl) => + (Storable.C a, NiceValue.T a ~ al) => + (Storable.C b, NiceValue.T b ~ bl) => (T al -> T bl) -> IO (SVL.ChunkSize -> SV.Vector a -> IO (SVL.Vector b)) runChunkyOnVector sig = do @@ -221,56 +223,56 @@ class Run f where type DSL f type Shape f - build :: (Marshal.C p) => Run.T (WithShape (Shape f)) p (DSL f) f + function :: (Marshal.C p) => Run.T (WithShape (Shape f)) p (DSL f) f instance (Storable.C a) => Run (SVL.Vector a) where - type DSL (SVL.Vector a) = T (MultiValue.T a) + type DSL (SVL.Vector a) = T (NiceValue.T a) type Shape (SVL.Vector a) = SVL.ChunkSize - build = + function = Run.Cons $ Compose . - fmap (\f shape create -> Unsafe.performIO $ buildIOGen f shape create) . + fmap (\f shape create -> Unsafe.performIO $ functionIOGen f shape create) . runChunkyAux instance (Storable.C a) => Run (SV.Vector a) where - type DSL (SV.Vector a) = T (MultiValue.T a) + type DSL (SV.Vector a) = T (NiceValue.T a) type Shape (SV.Vector a) = Int - build = + function = Run.Cons $ Compose . - fmap (\f shape create -> Unsafe.performIO $ buildIOGen f shape create) . + fmap (\f shape create -> Unsafe.performIO $ functionIOGen f shape create) . runAux instance (RunIO a) => Run (IO a) where type DSL (IO a) = T (DSL_IO a) type Shape (IO a) = ShapeIO a - build = buildIO + function = functionIO -instance (RunArg a, Run f) => Run (a -> f) where +instance (Argument a, Run f) => Run (a -> f) where type DSL (a -> f) = DSLArg a -> DSL f type Shape (a -> f) = Shape f - build = buildArg *-> build + function = argument *-> function class RunIO a where type DSL_IO a type ShapeIO a - buildIO :: + functionIO :: (Marshal.C p) => Run.T (WithShape (ShapeIO a)) p (T (DSL_IO a)) (IO a) instance (Storable.C a) => RunIO (SVL.Vector a) where - type DSL_IO (SVL.Vector a) = MultiValue.T a + type DSL_IO (SVL.Vector a) = NiceValue.T a type ShapeIO (SVL.Vector a) = SVL.ChunkSize - buildIO = Run.Cons $ Compose . fmap buildIOGen . runChunkyAux + functionIO = Run.Cons $ Compose . fmap functionIOGen . runChunkyAux instance (Storable.C a) => RunIO (SV.Vector a) where - type DSL_IO (SV.Vector a) = MultiValue.T a + type DSL_IO (SV.Vector a) = NiceValue.T a type ShapeIO (SV.Vector a) = Int - buildIO = Run.Cons $ Compose . fmap buildIOGen . runAux + functionIO = Run.Cons $ Compose . fmap functionIOGen . runAux -buildIOGen :: +functionIOGen :: (Monad m) => (final -> shape -> p -> m a) -> shape -> m (p, final) -> m a -buildIOGen f shape create = do (p,final) <- create; f final shape p +functionIOGen f shape create = do (p,final) <- create; f final shape p @@ -279,12 +281,12 @@ do f <- Sig.run (\n -> Sig.takeWhile (Expr.<*n) (Sig.iterate (1+) 0) <> Sig.takeWhile (Expr.<*n) (Sig.iterate (2+) 0)); f SVL.defaultChunkSize (12::Float) :: IO (SVL.Vector Float) -} run :: (Run f) => DSL f -> IO (Shape f -> f) -run = runExplicit build +run = runExplicit function {- ToDo: -Export it, but we also need to export 'build' then. -To this end we should define a nice data type for 'build'. +Export it, but we also need to export 'function' then. +To this end we should define a nice data type for 'function'. -} runExplicit :: Run.T (WithShape (Shape f)) () fdsl f -> @@ -293,6 +295,6 @@ getCompose $ Run.run builder sig _exampleExplicit :: - (Exp Float -> Exp Word -> T (MultiValue.T Float)) -> + (Exp Float -> Exp Word -> T (NiceValue.T Float)) -> IO (Int -> Float -> Word -> SV.Vector Float) -_exampleExplicit = runExplicit (Arg.primitive *-> Arg.primitive *-> build) +_exampleExplicit = runExplicit (Arg.primitive *-> Arg.primitive *-> function) diff --git a/src/Synthesizer/LLVM/Generator/Signal.hs b/src/Synthesizer/LLVM/Generator/Signal.hs --- a/src/Synthesizer/LLVM/Generator/Signal.hs +++ b/src/Synthesizer/LLVM/Generator/Signal.hs @@ -4,7 +4,7 @@ {-# LANGUAGE Rank2Types #-} module Synthesizer.LLVM.Generator.Signal ( Sig.T, - MV, + Nice, constant, fromArray, @@ -53,8 +53,8 @@ import qualified LLVM.DSL.Expression as Expr import LLVM.DSL.Expression (Exp) -import qualified LLVM.Extra.Multi.Value.Marshal as Marshal -import qualified LLVM.Extra.Multi.Value as MultiValue +import qualified LLVM.Extra.Nice.Value.Marshal as Marshal +import qualified LLVM.Extra.Nice.Value as NiceValue import qualified LLVM.Extra.Iterator as Iter import qualified LLVM.Extra.MaybeContinuation as MaybeCont import qualified LLVM.Extra.Memory as Memory @@ -79,7 +79,7 @@ -type MV a = Sig.T (MultiValue.T a) +type Nice a = Sig.T (NiceValue.T a) constant :: (Expr.Aggregate ae al, Memory.C al) => ae -> Sig.T al constant a = Sig.iterate return (Expr.bundle a) @@ -89,7 +89,7 @@ (TypeNum.Natural n, Marshal.C a) => ((n :*: LLVM.SizeOf (Marshal.Struct a)) ~ arrSize, TypeNum.Natural arrSize) => - Exp (MultiValue.Array n a) -> MV a + Exp (NiceValue.Array n a) -> Nice a fromArray arrExp = Sig.Cons (\arrPtr -> noLocalPtr $ \i -> do inRange <- MaybeCont.lift $ @@ -108,7 +108,7 @@ takeWhile :: (Expr.Aggregate ae a) => (ae -> Exp Bool) -> Sig.T a -> Sig.T a takeWhile p = - Sig.takeWhile (fmap (\(MultiValue.Cons cont) -> cont) . Expr.unliftM1 p) + Sig.takeWhile (fmap (\(NiceValue.Cons cont) -> cont) . Expr.unliftM1 p) take :: Exp Word -> Sig.T a -> Sig.T a take len = @@ -134,7 +134,7 @@ (do local <- LLVM.alloca (global,state0) <- start - ~(MultiValue.Cons nv) <- Expr.unExp n + ~(NiceValue.Cons nv) <- Expr.unExp n state1 <- Iter.mapWhileState_ (\_ s0 -> @@ -182,8 +182,8 @@ rampInf, rampSlope, parabolaFadeInInf, parabolaFadeOutInf :: - (Marshal.C a, MultiValue.Field a, MultiValue.IntegerConstant a) => - Exp a -> MV a + (Marshal.C a, NiceValue.Field a, NiceValue.IntegerConstant a) => + Exp a -> Nice a rampSlope slope = Core.ramp slope Expr.zero rampInf dur = rampSlope (Expr.recip dur) @@ -216,9 +216,9 @@ ramp, parabolaFadeIn, parabolaFadeOut, parabolaFadeInMap, parabolaFadeOutMap :: - (Marshal.C a, MultiValue.Field a, MultiValue.IntegerConstant a, - MultiValue.NativeFloating a ar) => - Exp Word -> MV a + (Marshal.C a, NiceValue.Field a, NiceValue.IntegerConstant a, + NiceValue.NativeFloating a ar) => + Exp Word -> Nice a ramp dur = take dur $ rampInf (Expr.fromIntegral dur) @@ -237,26 +237,26 @@ osci :: - (MultiValue.Fraction t, Marshal.C t) => - (forall r. MultiValue.T t -> CodeGenFunction r y) -> + (NiceValue.Fraction t, Marshal.C t) => + (forall r. NiceValue.T t -> CodeGenFunction r y) -> Exp t -> Exp t -> Sig.T y osci wave phase freq = Causal.map wave $* Core.osci phase freq exponential2 :: (Marshal.C a) => - (MultiValue.Real a) => - (MultiValue.RationalConstant a) => - (MultiValue.Transcendental a) => - Exp a -> Exp a -> MV a + (NiceValue.Real a) => + (NiceValue.RationalConstant a) => + (NiceValue.Transcendental a) => + Exp a -> Exp a -> Nice a exponential2 halfLife = Core.exponential (1 / 2 ** recip halfLife) exponentialBounded2 :: (Marshal.C a) => - (MultiValue.Real a) => - (MultiValue.RationalConstant a) => - (MultiValue.Transcendental a) => - Exp a -> Exp a -> Exp a -> MV a + (NiceValue.Real a) => + (NiceValue.RationalConstant a) => + (NiceValue.Transcendental a) => + Exp a -> Exp a -> Exp a -> Nice a exponentialBounded2 bound halfLife = Core.exponentialBounded bound (1 / 2 ** recip halfLife) @@ -279,9 +279,9 @@ towards the normal distribution according to the central limit theorem. -} noise :: - (Marshal.C a, MultiValue.Transcendental a, MultiValue.RationalConstant a, - MultiValue.NativeFloating a ar) => - Exp Word32 -> Exp a -> MV a + (Marshal.C a, NiceValue.Transcendental a, NiceValue.RationalConstant a, + NiceValue.NativeFloating a ar) => + Exp Word32 -> Exp a -> Nice a noise seed rate = let m2 = Expr.fromInteger' $ div Rnd.modulus 2 r = sqrt (3 * rate) / m2 @@ -293,13 +293,13 @@ and thus we use it, since the arguments are below 2^31. -} int31tofp :: - (MultiValue.NativeFloating a ar) => + (NiceValue.NativeFloating a ar) => Exp Word32 -> Exp a int31tofp = Expr.liftM - (MultiValue.fromIntegral <=< - (MultiValue.liftM LLVM.bitcast :: - MultiValue.T Word32 -> CodeGenFunction r (MultiValue.T Int32))) + (NiceValue.fromIntegral <=< + (NiceValue.liftM LLVM.bitcast :: + NiceValue.T Word32 -> CodeGenFunction r (NiceValue.T Int32))) adjacentNodes02 :: @@ -314,7 +314,7 @@ (return Tuple.undef)) adjacentNodes13 :: - (Marshal.C a, MultiValue.T a ~ al) => + (Marshal.C a, NiceValue.T a ~ al) => Exp a -> Sig.T al -> Sig.T (Interpolation.Nodes13 al) adjacentNodes13 yp0 = tail . @@ -325,7 +325,7 @@ return (Interpolation.Nodes13 x0 x1 x2 new, (x1, x2, new))) (do y0 <- Expr.unExp yp0 - return (MultiValue.undef, MultiValue.undef, y0))) + return (NiceValue.undef, NiceValue.undef, y0))) {- | @@ -338,8 +338,8 @@ or if the input value differs from the last processed one by a certain amount. -} interpolateConstant :: - (Memory.C a, Marshal.C b, MultiValue.IntegerConstant b, - MultiValue.Additive b, MultiValue.Comparison b) => + (Memory.C a, Marshal.C b, NiceValue.IntegerConstant b, + NiceValue.Additive b, NiceValue.Comparison b) => Exp b -> Sig.T a -> Sig.T a interpolateConstant k sig = CausalC.toSignal (Causal.quantizeLift (CausalC.fromSignal sig) $< constant k) diff --git a/src/Synthesizer/LLVM/Generator/SignalPacked.hs b/src/Synthesizer/LLVM/Generator/SignalPacked.hs --- a/src/Synthesizer/LLVM/Generator/SignalPacked.hs +++ b/src/Synthesizer/LLVM/Generator/SignalPacked.hs @@ -48,10 +48,10 @@ import qualified LLVM.DSL.Expression as Expr import LLVM.DSL.Expression (Exp) -import qualified LLVM.Extra.Multi.Vector as MultiVector -import qualified LLVM.Extra.Multi.Value.Marshal as Marshal -import qualified LLVM.Extra.Multi.Value.Vector as MultiValueVec -import qualified LLVM.Extra.Multi.Value as MultiValue +import qualified LLVM.Extra.Nice.Vector as NiceVector +import qualified LLVM.Extra.Nice.Value.Marshal as Marshal +import qualified LLVM.Extra.Nice.Value.Vector as NiceValueVec +import qualified LLVM.Extra.Nice.Value as NiceValue import qualified LLVM.Extra.Memory as Memory import qualified LLVM.Extra.MaybeContinuation as Maybe import qualified LLVM.Extra.Control as U @@ -242,8 +242,8 @@ exponential2 :: - (Marshal.Vector n a, MultiVector.Transcendental a, - MultiValue.RationalConstant a) => + (Marshal.Vector n a, NiceVector.Transcendental a, + NiceValue.RationalConstant a) => Exp a -> Exp a -> Sig.T (Serial n a) exponential2 halfLife start = withSizeRing $ \n -> Core.exponential @@ -251,9 +251,9 @@ (Serial.iterate (0.5 ** recip halfLife *) start) exponentialBounded2 :: - (Marshal.Vector n a, MultiVector.Transcendental a, - MultiValue.RationalConstant a, - MultiVector.IntegerConstant a, MultiVector.Real a) => + (Marshal.Vector n a, NiceVector.Transcendental a, + NiceValue.RationalConstant a, + NiceVector.IntegerConstant a, NiceVector.Real a) => Exp a -> Exp a -> Exp a -> Sig.T (Serial n a) exponentialBounded2 bound halfLife start = withSizeRing $ \n -> Core.exponentialBounded @@ -262,8 +262,8 @@ (Serial.iterate (0.5 ** recip halfLife *) start) osciCore :: - (Marshal.Vector n t, MultiVector.PseudoRing t, MultiVector.Fraction t, - MultiValue.IntegerConstant t) => + (Marshal.Vector n t, NiceVector.PseudoRing t, NiceVector.Fraction t, + NiceValue.IntegerConstant t) => Exp t -> Exp t -> Sig.T (Serial n t) osciCore phase freq = withSizeRing $ \n -> Core.osci @@ -271,16 +271,16 @@ (Serial.upsample (Expr.fraction (n * freq))) osci :: - (Marshal.Vector n t, MultiVector.PseudoRing t, MultiVector.Fraction t, - MultiValue.IntegerConstant t) => + (Marshal.Vector n t, NiceVector.PseudoRing t, NiceVector.Fraction t, + NiceValue.IntegerConstant t) => (forall r. Serial n t -> LLVM.CodeGenFunction r y) -> Exp t -> Exp t -> Sig.T y osci wave phase freq = Priv.map wave $ osciCore phase freq rampInf, rampSlope, parabolaFadeInInf, parabolaFadeOutInf :: - (Marshal.Vector n a, MultiVector.Field a, MultiVector.IntegerConstant a, - MultiValue.RationalConstant a) => + (Marshal.Vector n a, NiceVector.Field a, NiceVector.IntegerConstant a, + NiceValue.RationalConstant a) => Exp a -> Sig.T (Serial n a) rampSlope slope = withSizeRing $ \n -> Core.ramp @@ -307,9 +307,9 @@ For the mysterious rate parameter see 'Sig.noise'. -} noise :: - (MultiVector.NativeFloating n a ar) => - (MultiVector.PseudoRing a, MultiVector.IntegerConstant a) => - (MultiValue.Algebraic a, MultiValue.RationalConstant a) => + (NiceVector.NativeFloating n a ar) => + (NiceVector.PseudoRing a, NiceVector.IntegerConstant a) => + (NiceValue.Algebraic a, NiceValue.RationalConstant a) => (TypeNum.Positive n, TypeNum.Positive (n :*: TypeNum.D32)) => Exp Word32 -> Exp a -> Sig.T (Serial n a) noise seed rate = @@ -326,13 +326,13 @@ It would be better to use LLVM's range annotation, instead. -} int31tofp :: - (MultiVector.NativeFloating n a ar, + (NiceVector.NativeFloating n a ar, TypeNum.Positive n, TypeNum.Positive (n :*: TypeNum.D32)) => Serial n Word32 -> LLVM.CodeGenFunction r (Serial n a) int31tofp = - fmap SerialCode.fromOrdinary . MultiValueVec.fromIntegral . + fmap SerialCode.fromOrdinary . NiceValueVec.fromIntegral . SerialCode.toOrdinary . forceInt32 - <=< MultiValue.liftM LLVM.bitcast + <=< NiceValue.liftM LLVM.bitcast type Id a = a -> a diff --git a/src/Synthesizer/LLVM/Generator/Source.hs b/src/Synthesizer/LLVM/Generator/Source.hs --- a/src/Synthesizer/LLVM/Generator/Source.hs +++ b/src/Synthesizer/LLVM/Generator/Source.hs @@ -11,9 +11,9 @@ import qualified LLVM.DSL.Expression as Expr import LLVM.DSL.Expression (Exp) -import qualified LLVM.Extra.Multi.Value.Storable as Storable -import qualified LLVM.Extra.Multi.Value.Marshal as Marshal -import qualified LLVM.Extra.Multi.Value as MultiValue +import qualified LLVM.Extra.Nice.Value.Storable as Storable +import qualified LLVM.Extra.Nice.Value.Marshal as Marshal +import qualified LLVM.Extra.Nice.Value as NiceValue import qualified LLVM.Extra.MaybeContinuation as MaybeCont import qualified LLVM.Extra.Memory as Memory import qualified LLVM.Extra.Arithmetic as A @@ -31,24 +31,24 @@ import Data.Word (Word) -type T a = Sig.T (MultiValue.T a) +type T a = Sig.T (NiceValue.T a) data StorableVector a = StorableVector (Ptr a) Word storableVectorLength :: Exp (StorableVector a) -> Exp Word -storableVectorLength = Expr.lift1 (MultiValue.lift1 (\(_ptr,l) -> l)) +storableVectorLength = Expr.lift1 (NiceValue.lift1 (\(_ptr,l) -> l)) consStorableVector :: Ptr a -> Int -> StorableVector a consStorableVector p = StorableVector p . fromIntegral -instance (Storable a) => MultiValue.C (StorableVector a) where +instance (Storable a) => NiceValue.C (StorableVector a) where type Repr (StorableVector a) = (LLVM.Value (Ptr a), LLVM.Value Word) - cons (StorableVector p l) = MultiValue.Cons (LLVM.valueOf p, LLVM.valueOf l) - undef = MultiValue.undefTuple - zero = MultiValue.zeroTuple - phi = MultiValue.phiTuple - addPhi = MultiValue.addPhiTuple + cons (StorableVector p l) = NiceValue.Cons (LLVM.valueOf p, LLVM.valueOf l) + undef = NiceValue.undefTuple + zero = NiceValue.zeroTuple + phi = NiceValue.phiTuple + addPhi = NiceValue.addPhiTuple instance (Storable a) => Marshal.C (StorableVector a) where pack (StorableVector p l) = LLVM.consStruct p l @@ -64,7 +64,7 @@ p1 <- Storable.incrementPtr p0 l1 <- A.dec l0 return (y1,(p1,l1))) - (fmap (\(MultiValue.Cons (p,l)) -> (p,l)) (Expr.unExp vec)) + (fmap (\(NiceValue.Cons (p,l)) -> (p,l)) (Expr.unExp vec)) {- @@ -93,7 +93,7 @@ (LLVM.load lenPtr) valid <- A.cmp LLVM.CmpNE buffer (LLVM.valueOf nullPtr) return (valid, ((buffer,len), ()))) - (fmap (\(MultiValue.Cons it) -> (it, ())) $ Expr.unExp sig) + (fmap (\(NiceValue.Cons it) -> (it, ())) $ Expr.unExp sig) (\ _it -> return ()) flattenChunks :: (Storable.C a) => Sig.T (Chunk a) -> T a @@ -116,7 +116,7 @@ eventList :: (Marshal.C a) => - Exp (StablePtr (EventIt.T a)) -> Sig.T (Const.T (MultiValue.T a)) + Exp (StablePtr (EventIt.T a)) -> Sig.T (Const.T (NiceValue.T a)) eventList sig = Sig.Cons -- FixMe: duplicate of ConstantPiece.piecewiseConstant @@ -130,7 +130,7 @@ MaybeCont.guard =<< MaybeCont.lift (A.cmp LLVM.CmpNE len A.zero) y <- MaybeCont.lift $ Memory.load yPtr return (Const.Cons len y, ())) - (fmap (\(MultiValue.Cons it) -> (it, ())) $ Expr.unExp sig) + (fmap (\(NiceValue.Cons it) -> (it, ())) $ Expr.unExp sig) (\ _it -> return ()) lazySize :: Exp (StablePtr SizeIt.T) -> Sig.T (Const.T ()) @@ -144,5 +144,5 @@ LLVM.call nextFn stable MaybeCont.guard =<< MaybeCont.lift (A.cmp LLVM.CmpNE len A.zero) return (Const.Cons len (), ())) - (fmap (\(MultiValue.Cons it) -> (it, ())) $ Expr.unExp size) + (fmap (\(NiceValue.Cons it) -> (it, ())) $ Expr.unExp size) (\ _it -> return ()) diff --git a/src/Synthesizer/LLVM/Interpolation.hs b/src/Synthesizer/LLVM/Interpolation.hs --- a/src/Synthesizer/LLVM/Interpolation.hs +++ b/src/Synthesizer/LLVM/Interpolation.hs @@ -33,7 +33,7 @@ import qualified LLVM.DSL.Expression as Expr -import qualified LLVM.Extra.Multi.Value as MultiValue +import qualified LLVM.Extra.Nice.Value as NiceValue import qualified LLVM.Extra.Scalar as Scalar import qualified LLVM.Extra.Arithmetic as A import qualified LLVM.Extra.Tuple as Tuple @@ -58,17 +58,17 @@ data Margin nodes = Margin { marginNumber, marginOffset :: Int } deriving (Show, Eq) -singletonMargin :: MultiValue.T Int -> MultiValue.T (Margin nodes) +singletonMargin :: NiceValue.T Int -> NiceValue.T (Margin nodes) singletonMargin n = zipMargin n n unzipMargin :: - MultiValue.T (Margin nodes) -> (MultiValue.T Int, MultiValue.T Int) -unzipMargin (MultiValue.Cons (from, to)) = - (MultiValue.Cons from, MultiValue.Cons to) + NiceValue.T (Margin nodes) -> (NiceValue.T Int, NiceValue.T Int) +unzipMargin (NiceValue.Cons (from, to)) = + (NiceValue.Cons from, NiceValue.Cons to) -zipMargin :: MultiValue.T Int -> MultiValue.T Int -> MultiValue.T (Margin nodes) -zipMargin (MultiValue.Cons from) (MultiValue.Cons to) = - MultiValue.Cons (from, to) +zipMargin :: NiceValue.T Int -> NiceValue.T Int -> NiceValue.T (Margin nodes) +zipMargin (NiceValue.Cons from) (NiceValue.Cons to) = + NiceValue.Cons (from, to) marginNumberExp :: (Expr.Value val) => val (Margin nodes) -> val Int marginNumberExp = Expr.lift1 (fst . unzipMargin) @@ -76,21 +76,21 @@ marginOffsetExp :: (Expr.Value val) => val (Margin nodes) -> val Int marginOffsetExp = Expr.lift1 (snd . unzipMargin) -instance MultiValue.C (Margin nodes) where +instance NiceValue.C (Margin nodes) where type Repr (Margin nodes) = (LLVM.Value Int, LLVM.Value Int) cons (Margin start len) = - zipMargin (MultiValue.cons start) (MultiValue.cons len) - undef = singletonMargin MultiValue.undef - zero = singletonMargin MultiValue.zero + zipMargin (NiceValue.cons start) (NiceValue.cons len) + undef = singletonMargin NiceValue.undef + zero = singletonMargin NiceValue.zero phi bb a = case unzipMargin a of (a0,a1) -> - liftA2 zipMargin (MultiValue.phi bb a0) (MultiValue.phi bb a1) + liftA2 zipMargin (NiceValue.phi bb a0) (NiceValue.phi bb a1) addPhi bb a b = case (unzipMargin a, unzipMargin b) of ((a0,a1), (b0,b1)) -> do - MultiValue.addPhi bb a0 b0 - MultiValue.addPhi bb a1 b1 + NiceValue.addPhi bb a0 b0 + NiceValue.addPhi bb a1 b1 class (Applicative nodes, Traversable nodes) => C nodes where @@ -282,9 +282,9 @@ loadNodesExp :: (C nodes, Storable am) => (Value (Ptr am) -> CodeGenFunction r a) -> - MultiValue.T Int -> + NiceValue.T Int -> Value (Ptr am) -> CodeGenFunction r (nodes a) -loadNodesExp loadNode (MultiValue.Cons step) = +loadNodesExp loadNode (NiceValue.Cons step) = MS.evalStateT $ sequenceA $ pure $ loadNext loadNode step loadNodes :: @@ -307,11 +307,11 @@ indexNodesExp :: (C nodes) => - (MultiValue.T Word -> CodeGenFunction r v) -> - MultiValue.T Word -> - MultiValue.T Word -> CodeGenFunction r (nodes v) -indexNodesExp indexNode (MultiValue.Cons step) (MultiValue.Cons offset) = - indexNodes (indexNode . MultiValue.Cons) step offset + (NiceValue.T Word -> CodeGenFunction r v) -> + NiceValue.T Word -> + NiceValue.T Word -> CodeGenFunction r (nodes v) +indexNodesExp indexNode (NiceValue.Cons step) (NiceValue.Cons offset) = + indexNodes (indexNode . NiceValue.Cons) step offset indexNodes :: (C nodes) => diff --git a/src/Synthesizer/LLVM/MIDI.hs b/src/Synthesizer/LLVM/MIDI.hs --- a/src/Synthesizer/LLVM/MIDI.hs +++ b/src/Synthesizer/LLVM/MIDI.hs @@ -25,9 +25,9 @@ import LLVM.DSL.Expression (Exp) -import qualified LLVM.Extra.Multi.Value.Marshal as Marshal -import qualified LLVM.Extra.Multi.Value as MultiValue -import qualified LLVM.Extra.Multi.Vector as MultiVector +import qualified LLVM.Extra.Nice.Value.Marshal as Marshal +import qualified LLVM.Extra.Nice.Value as NiceValue +import qualified LLVM.Extra.Nice.Vector as NiceVector import qualified LLVM.Extra.Arithmetic as A import qualified LLVM.Core as LLVM @@ -38,9 +38,9 @@ frequencyFromBendModulation :: - (Marshal.C y, MultiValue.T y ~ ym, - MultiValue.PseudoRing y, MultiValue.IntegerConstant y, - MultiValue.Fraction y) => + (Marshal.C y, NiceValue.T y ~ ym, + NiceValue.PseudoRing y, NiceValue.IntegerConstant y, + NiceValue.Fraction y) => Exp y -> Causal.T (BM.T ym) ym frequencyFromBendModulation speed = frequencyFromPair Sig.osci speed @@ -50,16 +50,16 @@ frequencyFromBendModulationPacked :: (Marshal.Vector n a) => - (MultiVector.PseudoRing a, MultiVector.IntegerConstant a) => - (MultiVector.Fraction a) => - Exp a -> Causal.T (BM.T (MultiValue.T a)) (Serial.Value n a) + (NiceVector.PseudoRing a, NiceVector.IntegerConstant a) => + (NiceVector.Fraction a) => + Exp a -> Causal.T (BM.T (NiceValue.T a)) (Serial.Value n a) frequencyFromBendModulationPacked speed = frequencyFromPair SigPS.osci speed <<< Causal.map (\(BM.Cons b m) -> (SerialExp.upsample b, SerialExp.upsample m)) frequencyFromPair, _frequencyFromPair :: - (MultiValue.Additive y, + (NiceValue.Additive y, A.PseudoRing ym, A.IntegerConstant ym, A.Fraction ym) => ((forall r. ym -> LLVM.CodeGenFunction r ym) -> Exp y -> Exp y -> Sig.T ym) -> diff --git a/src/Synthesizer/LLVM/MIDI/BendModulation.hs b/src/Synthesizer/LLVM/MIDI/BendModulation.hs --- a/src/Synthesizer/LLVM/MIDI/BendModulation.hs +++ b/src/Synthesizer/LLVM/MIDI/BendModulation.hs @@ -10,8 +10,8 @@ BM.T(..), BM.deflt, BM.shift, - multiValue, - unMultiValue, + niceValue, + unNiceValue, ) where import qualified Synthesizer.MIDI.Value.BendModulation as BM @@ -19,9 +19,9 @@ import qualified LLVM.DSL.Expression as Expr -import qualified LLVM.Extra.Multi.Value.Storable as StorableMV -import qualified LLVM.Extra.Multi.Value.Marshal as MarshalMV -import qualified LLVM.Extra.Multi.Value as MultiValue +import qualified LLVM.Extra.Nice.Value.Storable as StorableNice +import qualified LLVM.Extra.Nice.Value.Marshal as MarshalNice +import qualified LLVM.Extra.Nice.Value as NiceValue import qualified LLVM.Extra.Vector as Vector import qualified LLVM.Extra.Tuple as Tuple import qualified LLVM.Extra.Storable as Storable @@ -52,35 +52,35 @@ valueOf = Tuple.valueOfFunctor -instance (Expr.Aggregate e mv) => Expr.Aggregate (BM.T e) (BM.T mv) where - type MultiValuesOf (BM.T e) = BM.T (Expr.MultiValuesOf e) - type ExpressionsOf (BM.T mv) = BM.T (Expr.ExpressionsOf mv) +instance (Expr.Aggregate e nv) => Expr.Aggregate (BM.T e) (BM.T nv) where + type NiceValuesOf (BM.T e) = BM.T (Expr.NiceValuesOf e) + type ExpressionsOf (BM.T nv) = BM.T (Expr.ExpressionsOf nv) bundle = Trav.traverse Expr.bundle dissect = fmap Expr.dissect -instance (MultiValue.C a) => MultiValue.C (BM.T a) where - type Repr (BM.T a) = BM.T (MultiValue.Repr a) - cons = multiValue . fmap MultiValue.cons - undef = multiValue $ pure MultiValue.undef - zero = multiValue $ pure MultiValue.zero - phi bb = fmap multiValue . Trav.traverse (MultiValue.phi bb) . unMultiValue +instance (NiceValue.C a) => NiceValue.C (BM.T a) where + type Repr (BM.T a) = BM.T (NiceValue.Repr a) + cons = niceValue . fmap NiceValue.cons + undef = niceValue $ pure NiceValue.undef + zero = niceValue $ pure NiceValue.zero + phi bb = fmap niceValue . Trav.traverse (NiceValue.phi bb) . unNiceValue addPhi bb a b = Fold.sequence_ $ - liftA2 (MultiValue.addPhi bb) (unMultiValue a) (unMultiValue b) + liftA2 (NiceValue.addPhi bb) (unNiceValue a) (unNiceValue b) -instance (MarshalMV.C l) => MarshalMV.C (BM.T l) where - pack (BM.Cons bend depth) = MarshalMV.pack (bend, depth) - unpack = uncurry BM.Cons . MarshalMV.unpack +instance (MarshalNice.C l) => MarshalNice.C (BM.T l) where + pack (BM.Cons bend depth) = MarshalNice.pack (bend, depth) + unpack = uncurry BM.Cons . MarshalNice.unpack -instance (StorableMV.C l) => StorableMV.C (BM.T l) where - load = StorableMV.loadApplicative - store = StorableMV.storeFoldable +instance (StorableNice.C l) => StorableNice.C (BM.T l) where + load = StorableNice.loadApplicative + store = StorableNice.storeFoldable -multiValue :: BM.T (MultiValue.T a) -> MultiValue.T (BM.T a) -multiValue = MultiValue.Cons . fmap (\(MultiValue.Cons a) -> a) +niceValue :: BM.T (NiceValue.T a) -> NiceValue.T (BM.T a) +niceValue = NiceValue.Cons . fmap (\(NiceValue.Cons a) -> a) -unMultiValue :: MultiValue.T (BM.T a) -> BM.T (MultiValue.T a) -unMultiValue (MultiValue.Cons x) = fmap MultiValue.Cons x +unNiceValue :: NiceValue.T (BM.T a) -> BM.T (NiceValue.T a) +unNiceValue (NiceValue.Cons x) = fmap NiceValue.Cons x type Struct a = LLVM.Struct (a, (a, ())) diff --git a/src/Synthesizer/LLVM/Plug/Input.hs b/src/Synthesizer/LLVM/Plug/Input.hs --- a/src/Synthesizer/LLVM/Plug/Input.hs +++ b/src/Synthesizer/LLVM/Plug/Input.hs @@ -19,9 +19,9 @@ import qualified Synthesizer.LLVM.ConstantPiece as Const -import qualified LLVM.Extra.Multi.Value.Storable as Storable -import qualified LLVM.Extra.Multi.Value.Marshal as Marshal -import qualified LLVM.Extra.Multi.Value as MultiValue +import qualified LLVM.Extra.Nice.Value.Storable as Storable +import qualified LLVM.Extra.Nice.Value.Marshal as Marshal +import qualified LLVM.Extra.Nice.Value as NiceValue import qualified LLVM.Extra.Memory as Memory import qualified LLVM.Extra.Arithmetic as A import qualified LLVM.Extra.Tuple as Tuple @@ -35,7 +35,7 @@ import Type.Base.Proxy (Proxy) import qualified Synthesizer.MIDI.PiecewiseConstant.ControllerSet as PCS -import qualified Synthesizer.Generic.Signal as SigG +import qualified Synthesizer.ChunkySize as ChunkySize import qualified Data.EventList.Relative.BodyTime as EventListBT import qualified Data.EventList.Relative.MixedTime as EventListMT import qualified Data.EventList.Relative.TimeTime as EventListTT @@ -73,11 +73,11 @@ (Marshal.C parameters, Memory.C state) => Cons (forall r. - MultiValue.T parameters -> + NiceValue.T parameters -> state -> LLVM.CodeGenFunction r (b, state)) -- compute next value (forall r. - MultiValue.T parameters -> + NiceValue.T parameters -> LLVM.CodeGenFunction r state) -- initial state (a -> IO (ioContext, parameters)) @@ -122,20 +122,20 @@ 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 - (MultiValue.uncurry $ \parameterA parameterB (sa,sb) -> + (NiceValue.uncurry $ \parameterA parameterB (sa,sb) -> liftA2 zipPair (nextA parameterA sa) (nextB parameterB sb)) - (MultiValue.uncurry $ \parameterA parameterB -> + (NiceValue.uncurry $ \parameterA parameterB -> liftA2 (,) (startA parameterA) (startB parameterB)) (\(Zip.Cons a b) -> liftA2 zipPair (createA a) (createB b)) (\(ca,cb) -> deleteA ca >> deleteB cb) -instance Default SigG.LazySize where - type Element SigG.LazySize = () +instance Default ChunkySize.LazySize where + type Element ChunkySize.LazySize = () deflt = lazySize -lazySize :: T SigG.LazySize () +lazySize :: T ChunkySize.LazySize () lazySize = ignore ignore :: T a () @@ -147,16 +147,16 @@ (const $ return ()) instance (Storable.C a) => Default (SV.Vector a) where - type Element (SV.Vector a) = MultiValue.T a + type Element (SV.Vector a) = NiceValue.T a deflt = storableVector -storableVector :: (Storable.C a) => T (SV.Vector a) (MultiValue.T a) +storableVector :: (Storable.C a) => T (SV.Vector a) (NiceValue.T a) storableVector = Cons - (\ _ (MultiValue.Cons p) -> + (\ _ (NiceValue.Cons p) -> liftA2 (,) (Storable.load p) - (MultiValue.Cons <$> Storable.incrementPtr p)) + (NiceValue.Cons <$> Storable.incrementPtr p)) return (\vec -> let (fp,ptr,_l) = SVU.unsafeToPointers vec @@ -174,7 +174,7 @@ instance (Marshal.C a, time ~ NonNegW.Int) => Default (EventListBT.T time a) where - type Element (EventListBT.T time a) = MultiValue.T a + type Element (EventListBT.T time a) = NiceValue.T a deflt = piecewiseConstant {- @@ -183,7 +183,7 @@ but here we do not accept early exit. -} piecewiseConstant :: - (Marshal.C a) => T (EventListBT.T NonNegW.Int a) (MultiValue.T a) + (Marshal.C a) => T (EventListBT.T NonNegW.Int a) (NiceValue.T a) piecewiseConstant = expandConstantPieces $ rmap @@ -193,10 +193,10 @@ (fromIntegral $ NonNegW.toNumber t :: Word, (Marshal.pack a, ()))) . EventListBT.toPairList) $ map - (\(MultiValue.Cons s) -> do + (\(NiceValue.Cons s) -> do t <- LLVM.extractvalue s TypeNum.d0 a <- LLVM.extractvalue s TypeNum.d1 - Const.Cons t . MultiValue.Cons <$> Memory.decompose a) $ + Const.Cons t . NiceValue.Cons <$> Memory.decompose a) $ storableVector expandConstantPieces :: @@ -222,11 +222,11 @@ (Marshal.C a, Marshal.Struct a ~ aStruct, LLVM.IsSized aStruct, TypeNum.Natural n, (n:*:LLVM.SizeOf aStruct) ~ arrSize, TypeNum.Natural arrSize) => - Proxy n -> T (PCS.T Int a) (MultiValue.T (MultiValue.Array n a)) + Proxy n -> T (PCS.T Int a) (NiceValue.T (NiceValue.Array n a)) controllerSet pn = controllerSetFromSV pn $ map - (\(MultiValue.Cons s) -> do + (\(NiceValue.Cons s) -> do len <- LLVM.extractvalue s TypeNum.d0 i <- LLVM.extractvalue s TypeNum.d1 a <- Memory.decompose =<< LLVM.extractvalue s TypeNum.d2 @@ -239,10 +239,10 @@ (n:*:LLVM.SizeOf aStruct) ~ arrSize, TypeNum.Natural arrSize) => Proxy n -> T (SV.Vector (EE.Stored (Marshal.Struct (Word,Word,a)))) - (LLVM.Value Word, (LLVM.Value Word, MultiValue.T a)) -> - T (PCS.T Int a) (MultiValue.T (MultiValue.Array n a)) + (LLVM.Value Word, (LLVM.Value Word, NiceValue.T a)) -> + T (PCS.T Int a) (NiceValue.T (NiceValue.Array n a)) controllerSetFromSV pn (Cons next start create delete) = Cons - (MultiValue.uncurry $ \(MultiValue.Cons (arrPtr, _)) param state0 -> do + (NiceValue.uncurry $ \(NiceValue.Cons (arrPtr, _)) param state0 -> do (length2, s2) <- C.whileLoopShared state0 (\(len0, s0) -> @@ -253,7 +253,7 @@ length3 <- A.dec length2 arr <- Memory.load =<< LLVM.bitcast arrPtr return (arr, (length3, s2))) - (MultiValue.uncurry $ \(MultiValue.Cons (_, initialTime)) param -> do + (NiceValue.uncurry $ \(NiceValue.Cons (_, initialTime)) param -> do state <- start param return (initialTime, state)) diff --git a/src/Synthesizer/LLVM/Plug/Output.hs b/src/Synthesizer/LLVM/Plug/Output.hs --- a/src/Synthesizer/LLVM/Plug/Output.hs +++ b/src/Synthesizer/LLVM/Plug/Output.hs @@ -10,9 +10,9 @@ import qualified Synthesizer.Zip as Zip -import qualified LLVM.Extra.Multi.Value.Storable as Storable -import qualified LLVM.Extra.Multi.Value.Marshal as Marshal -import qualified LLVM.Extra.Multi.Value as MultiValue +import qualified LLVM.Extra.Nice.Value.Storable as Storable +import qualified LLVM.Extra.Nice.Value.Marshal as Marshal +import qualified LLVM.Extra.Nice.Value as NiceValue import qualified LLVM.Extra.Memory as Memory import qualified LLVM.Core as LLVM @@ -33,9 +33,9 @@ (Marshal.C parameters, Memory.C state) => Cons (forall r. - MultiValue.T parameters -> a -> state -> LLVM.CodeGenFunction r state) + NiceValue.T parameters -> a -> state -> LLVM.CodeGenFunction r state) -- compute next value - (forall r. MultiValue.T parameters -> LLVM.CodeGenFunction r state) + (forall r. NiceValue.T parameters -> LLVM.CodeGenFunction r state) -- initial state (Int -> IO (ioContext, parameters)) {- initialization from IO monad @@ -65,21 +65,21 @@ 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 - (MultiValue.uncurry $ \parameterA parameterB (a,b) (sa,sb) -> + (NiceValue.uncurry $ \parameterA parameterB (a,b) (sa,sb) -> liftA2 (,) (nextA parameterA a sa) (nextB parameterB b sb)) - (MultiValue.uncurry $ \parameterA parameterB -> + (NiceValue.uncurry $ \parameterA parameterB -> liftA2 (,) (startA parameterA) (startB parameterB)) (\len -> liftA2 zipPair (createA len) (createB len)) (\len (ca,cb) -> liftA2 Zip.Cons (deleteA len ca) (deleteB len cb)) instance (Storable.C a) => Default (SV.Vector a) where - type Element (SV.Vector a) = MultiValue.T a + type Element (SV.Vector a) = NiceValue.T a deflt = storableVector -storableVector :: (Storable.C a) => T (MultiValue.T a) (SV.Vector a) +storableVector :: (Storable.C a) => T (NiceValue.T a) (SV.Vector a) storableVector = Cons - (\ _param -> MultiValue.liftM . Storable.storeNext) + (\ _param -> NiceValue.liftM . Storable.storeNext) return (\len -> do vec <- SVB.create len (const $ return ()) diff --git a/src/Synthesizer/LLVM/Private.hs b/src/Synthesizer/LLVM/Private.hs --- a/src/Synthesizer/LLVM/Private.hs +++ b/src/Synthesizer/LLVM/Private.hs @@ -1,7 +1,7 @@ module Synthesizer.LLVM.Private where import qualified LLVM.Extra.MaybeContinuation as MaybeCont -import qualified LLVM.Extra.Multi.Value as MultiValue +import qualified LLVM.Extra.Nice.Value as NiceValue import qualified LLVM.Core as LLVM @@ -10,8 +10,8 @@ import Control.Applicative (liftA2) -unbool :: MultiValue.T Bool -> LLVM.Value Bool -unbool (MultiValue.Cons b) = b +unbool :: NiceValue.T Bool -> LLVM.Value Bool +unbool (NiceValue.Cons b) = b noLocalPtr :: f -> (LLVM.Value (LLVM.Ptr (LLVM.Struct ())) -> f) noLocalPtr = const diff --git a/src/Synthesizer/LLVM/Private/Render.hs b/src/Synthesizer/LLVM/Private/Render.hs --- a/src/Synthesizer/LLVM/Private/Render.hs +++ b/src/Synthesizer/LLVM/Private/Render.hs @@ -22,9 +22,9 @@ import qualified LLVM.DSL.Execution as Exec import LLVM.DSL.Expression (Exp(Exp)) -import qualified LLVM.Extra.Multi.Value.Storable as Storable -import qualified LLVM.Extra.Multi.Value.Marshal as Marshal -import qualified LLVM.Extra.Multi.Value as MultiValue +import qualified LLVM.Extra.Nice.Value.Storable as Storable +import qualified LLVM.Extra.Nice.Value.Marshal as Marshal +import qualified LLVM.Extra.Nice.Value as NiceValue import qualified LLVM.Extra.Memory as Memory import qualified LLVM.Extra.MaybeContinuation as MaybeCont import qualified LLVM.Extra.Maybe as Maybe @@ -108,7 +108,7 @@ -} compileHandler :: (Marshal.C param, Marshal.Struct param ~ paramStruct, - Storable.C a, MultiValue.T a ~ value) => + Storable.C a, NiceValue.T a ~ value) => (Exp param -> T value) -> LLVM.CodeGenModule (LLVM.Function @@ -167,42 +167,42 @@ C.ifThenElse doDelete delete fill) -class RunArg a where +class Argument a where type DSLArg a - buildArg :: Arg.T a (DSLArg a) + argument :: Arg.T a (DSLArg a) -instance RunArg () where +instance Argument () where type DSLArg () = () - buildArg = Arg.unit + argument = Arg.unit -instance (RunArg a, RunArg b) => RunArg (a,b) where +instance (Argument a, Argument b) => Argument (a,b) where type DSLArg (a,b) = (DSLArg a, DSLArg b) - buildArg = Arg.pair buildArg buildArg + argument = Arg.pair argument argument -instance (RunArg a, RunArg b, RunArg c) => RunArg (a,b,c) where +instance (Argument a, Argument b, Argument c) => Argument (a,b,c) where type DSLArg (a,b,c) = (DSLArg a, DSLArg b, DSLArg c) - buildArg = Arg.triple buildArg buildArg buildArg + argument = Arg.triple argument argument argument -instance RunArg Float where +instance Argument Float where type DSLArg Float = Exp Float - buildArg = Arg.primitive + argument = Arg.primitive -instance RunArg Int where +instance Argument Int where type DSLArg Int = Exp Int - buildArg = Arg.primitive + argument = Arg.primitive -instance RunArg Word where +instance Argument Word where type DSLArg Word = Exp Word - buildArg = Arg.primitive + argument = Arg.primitive -instance RunArg Word32 where +instance Argument Word32 where type DSLArg Word32 = Exp Word32 - buildArg = Arg.primitive + argument = Arg.primitive -instance (RunArg a) => RunArg (Stereo.T a) where +instance (Argument a) => Argument (Stereo.T a) where type DSLArg (Stereo.T a) = Stereo.T (DSLArg a) - buildArg = - case buildArg of + argument = + case argument of Arg.Cons pass create -> Arg.Cons (fmap pass . Stereo.unExpression) @@ -213,13 +213,13 @@ instance (TypeNum.Natural n, Marshal.C a, LLVM.IsSized (Marshal.Struct a), TypeNum.Natural (n TypeNum.:*: LLVM.SizeOf (Marshal.Struct a))) => - RunArg (MultiValue.Array n a) where - type DSLArg (MultiValue.Array n a) = Exp (MultiValue.Array n a) - buildArg = Arg.primitive + Argument (NiceValue.Array n a) where + type DSLArg (NiceValue.Array n a) = Exp (NiceValue.Array n a) + argument = Arg.primitive -instance (Storable.C a) => RunArg (SV.Vector a) where - type DSLArg (SV.Vector a) = T (MultiValue.T a) - buildArg = +instance (Storable.C a) => Argument (SV.Vector a) where + type DSLArg (SV.Vector a) = T (NiceValue.T a) + argument = Arg.Cons Source.storableVector (\av -> do @@ -231,17 +231,17 @@ buffer :: SV.Vector a -> Buffer a buffer = Buffer -instance (Storable.C a) => RunArg (Buffer a) where +instance (Storable.C a) => Argument (Buffer a) where type DSLArg (Buffer a) = Exp (Source.StorableVector a) - buildArg = + argument = Arg.Cons id (\(Buffer av) -> do let (fp,ptr,l) = SVU.unsafeToPointers av return (Source.consStorableVector ptr l, touchForeignPtr fp)) -instance (Storable.C a) => RunArg (SVL.Vector a) where - type DSLArg (SVL.Vector a) = T (MultiValue.T a) - buildArg = +instance (Storable.C a) => Argument (SVL.Vector a) where + type DSLArg (SVL.Vector a) = T (NiceValue.T a) + argument = Arg.newDispose ChunkIt.new ChunkIt.dispose Source.storableVectorLazy class TimeInteger int where @@ -255,13 +255,13 @@ instance (time ~ NonNeg.T int, TimeInteger int, Marshal.C a) => - RunArg (EventList.T time a) where - type DSLArg (EventList.T time a) = T (Const.T (MultiValue.T a)) - buildArg = + Argument (EventList.T time a) where + type DSLArg (EventList.T time a) = T (Const.T (NiceValue.T a)) + argument = Arg.newDispose (EventIt.new . subdivideLong) EventIt.dispose Source.eventList -instance (a ~ SVL.ChunkSize) => RunArg (NonNegChunky.T a) where +instance (a ~ SVL.ChunkSize) => Argument (NonNegChunky.T a) where type DSLArg (NonNegChunky.T a) = T (Const.T ()) - buildArg = + argument = Arg.newDispose SizeIt.new SizeIt.dispose Source.lazySize diff --git a/src/Synthesizer/LLVM/Server/CausalPacked/Instrument.hs b/src/Synthesizer/LLVM/Server/CausalPacked/Instrument.hs --- a/src/Synthesizer/LLVM/Server/CausalPacked/Instrument.hs +++ b/src/Synthesizer/LLVM/Server/CausalPacked/Instrument.hs @@ -80,7 +80,7 @@ import qualified LLVM.DSL.Expression as Expr import LLVM.DSL.Expression (Exp, (<=*), (>*)) -import qualified LLVM.Extra.Multi.Value as MultiValue +import qualified LLVM.Extra.Nice.Value as NiceValue import qualified LLVM.Extra.Tuple as Tuple import qualified LLVM.Core as LLVM @@ -122,15 +122,15 @@ frequencyFromBendModulationPacked :: Exp Real -> - F.T inp (MultiValue.T (BM.T Real)) -> + F.T inp (NiceValue.T (BM.T Real)) -> F.T inp VectorValue frequencyFromBendModulationPacked speed fm = - MIDIL.frequencyFromBendModulationPacked speed $& (BM.unMultiValue <$> fm) + MIDIL.frequencyFromBendModulationPacked speed $& (BM.unNiceValue <$> fm) stereoFrequenciesFromDetuneBendModulation :: Exp Real -> - (F.T inp (MultiValue.T Real), - F.T inp (MultiValue.T (BM.T Real))) -> + (F.T inp (NiceValue.T Real), + F.T inp (NiceValue.T (BM.T Real))) -> F.T inp (Stereo.T VectorValue) stereoFrequenciesFromDetuneBendModulation speed (detune, freq) = Causal.envelopeStereo $& @@ -176,7 +176,7 @@ remainder) reorderEnvelopeControl :: - (Arrow arrow, CutG.Read remainder) => + (Arrow arrow, CutG.Consume remainder) => arrow (WithEnvelopeControl remainder) (Zip.T EnvelopeControl remainder) @@ -273,10 +273,10 @@ (Render.run $ wrapped $ \(Number vel) (SampleRate _sr) -> Exp.causalPacked (amplitudeFromVelocity vel) - <<^ Exp.unMultiValueParameterPacked) + <<^ Exp.unNiceValueParameterPacked) (Render.run $ wrapped $ \(Number level) (SampleRate _sr) -> - let expo = Exp.causalPacked level <<^ Exp.unMultiValueParameterPacked + let expo = Exp.causalPacked level <<^ Exp.unNiceValueParameterPacked in case threshold of Just y -> takeThreshold (Expr.cons y) . expo Nothing -> expo) @@ -309,7 +309,7 @@ zipEnvelope (env sr vel)) (Render.run $ constant frequency 10 $ \speed _sr -> - (arr Stereo.multiValue + (arr Stereo.niceValue . Causal.envelopeStereo . @@ -319,12 +319,12 @@ shapeCtrl = 1/pi + (shape-1/pi) * (Exp.causalPacked 1 - <<^ Exp.unMultiValueParameterPacked + <<^ Exp.unNiceValueParameterPacked $& shapeDecay) freqs = stereoFrequenciesFromDetuneBendModulation speed fm expo = (Causal.map Serial.upsample $& phase) * - (Exp.causalPacked 1 <<^ Exp.unMultiValueParameterPacked + (Exp.causalPacked 1 <<^ Exp.unNiceValueParameterPacked $& phaseDecay) osci :: Causal.T @@ -363,7 +363,7 @@ (Render.run $ constant frequency 10 $ \speed -> constant frequency 100 $ \lowerFreq _sr -> - (arr Stereo.multiValue + (arr Stereo.niceValue . Causal.envelopeStereo . @@ -375,7 +375,7 @@ expo = takeThreshold lowerFreq $& (Causal.map Serial.upsample $& cutoff) * - (Exp.causalPacked 1 <<^ Exp.unMultiValueParameterPacked + (Exp.causalPacked 1 <<^ Exp.unNiceValueParameterPacked $& cutoffDecay) in Causal.stereoFromMonoControlled (UniFilter.lowpass ^<< CtrlPS.process) @@ -416,7 +416,7 @@ wrapped $ \(Number vel) -> constant frequency 5 $ \speed -> constant time 1 $ \halfLife _sr -> - (arr Stereo.multiValue + (arr Stereo.niceValue . Causal.envelopeStereo . @@ -491,7 +491,7 @@ ctrl &|& stereo -type RealValue = MultiValue.T Real +type RealValue = NiceValue.T Real bellNoiseStereoFM :: IO (SampleRate Real -> Real -> Real -> @@ -553,7 +553,7 @@ CausalPS.amplifyStereo n $& freqs) - in Stereo.multiValue <$> + in Stereo.niceValue <$> (Causal.envelopeStereo $& (noiseAmp * env1) &|& @@ -599,7 +599,7 @@ - takeThreshold 1e-4 . - Exp.causalPacked amp <<^ Exp.unMultiValueParameterPacked) + Exp.causalPacked amp <<^ Exp.unNiceValueParameterPacked) (Render.run $ wrapped $ \(Number amp) (SampleRate _sr) -> Causal.fromSignal (SigPS.constant amp)) @@ -607,12 +607,12 @@ wrapped $ \(Number level) (SampleRate _sr) -> takeThreshold 0.01 . - Exp.causalPacked level <<^ Exp.unMultiValueParameterPacked) + Exp.causalPacked level <<^ Exp.unNiceValueParameterPacked) windCore :: - F.T a (MultiValue.T Real) -> - F.T a (MultiValue.T (BM.T Real)) -> + F.T a (NiceValue.T Real) -> + F.T a (NiceValue.T (BM.T Real)) -> SampleRate (Exp Real) -> F.T a (Stereo.T VectorValue) windCore reson fm = @@ -642,7 +642,7 @@ zipEnvelope (env sr vel)) (Render.run $ \sr -> F.withArgs $ \(env,(reson,fm)) -> - Stereo.multiValue <$> + Stereo.niceValue <$> Causal.envelopeStereo $& env &|& windCore reson fm sr) stringControlledEnvelope @@ -672,7 +672,7 @@ let phaserMix = Causal.map Serial.upsample $& phaserMix0 noise = windCore reson fm sr - in Stereo.multiValue <$> + in Stereo.niceValue <$> Causal.envelopeStereo $& env &|& ((Causal.envelopeStereo $& (1 - phaserMix) &|& noise) @@ -680,7 +680,7 @@ (Causal.envelopeStereo $& phaserMix &|& (Stereo.arrowFromMonoControlled CtrlPS.process $& - (Allpass.cascadeParameterUnMultiValue <$> phaserFreq) + (Allpass.unNiceValueCascadeParameter <$> phaserFreq) &|& noise))))) stringControlledEnvelope @@ -723,7 +723,7 @@ zipEnvelope (env sr vel)) (Render.run $ constant frequency 5 $ \speed _sr -> - (arr Stereo.multiValue + (arr Stereo.niceValue . Causal.envelopeStereo . @@ -835,7 +835,7 @@ (Causal.envelope . first (one + CausalPS.amplify d)) - in Stereo.multiValue <$> + in Stereo.niceValue <$> Causal.envelopeStereo $& env &|& (phaserOsci osci $& (depth &|& shape) &|& (det &|& modu)))) @@ -863,14 +863,14 @@ (Zip.arrowSecond $ arr $ transposeModulation sr (freq * Sample.period pos)))) (Render.run $ \sr (amp, smp) -> - Stereo.multiValue + Stereo.niceValue ^<< Causal.stereoFromMono (resamplingProc sr (amp, smp)) <<^ - Stereo.unMultiValue) + Stereo.unNiceValue) (Render.run $ constant frequency 3 $ \speed _sr -> - fmap Stereo.multiValue $ + fmap Stereo.niceValue $ F.withArgs $ stereoFrequenciesFromDetuneBendModulation speed) @@ -924,7 +924,7 @@ resamplingProc :: SampleRate (Exp Real) -> - (Exp Real, Sig.T (MultiValue.T Real)) -> + (Exp Real, Sig.T (NiceValue.T Real)) -> Causal.T VectorValue VectorValue resamplingProc _sr (amp, smp) = CausalPS.amplify amp @@ -985,7 +985,7 @@ makeIntegrate (Render.run $ constant frequency 3 $ \speed _sr -> - fmap Stereo.multiValue $ + fmap Stereo.niceValue $ F.withArgs $ stereoFrequenciesFromDetuneBendModulation speed) makeHelix :: @@ -995,7 +995,7 @@ Render.run $ wrapped $ \(Number amp) (Number per) (SampleRate _sr) smp -> - arr Stereo.multiValue + arr Stereo.niceValue . CausalPS.amplifyStereo amp . @@ -1008,7 +1008,7 @@ . second (CausalPS.osciCore $< 0)) . - arr (\(shape, freq) -> (,) shape <$> Stereo.unMultiValue freq) + arr (\(shape, freq) -> (,) shape <$> Stereo.unNiceValue freq) makeZigZag :: IO (SampleRate Real -> (Real, Real, Real) -> diff --git a/src/Synthesizer/LLVM/Server/CausalPacked/InstrumentPlug.hs b/src/Synthesizer/LLVM/Server/CausalPacked/InstrumentPlug.hs --- a/src/Synthesizer/LLVM/Server/CausalPacked/InstrumentPlug.hs +++ b/src/Synthesizer/LLVM/Server/CausalPacked/InstrumentPlug.hs @@ -45,7 +45,7 @@ import qualified LLVM.DSL.Expression as Expr import LLVM.DSL.Expression (Exp) -import qualified LLVM.Extra.Multi.Value as MultiValue +import qualified LLVM.Extra.Nice.Value as NiceValue import Control.Category ((.)) import Control.Applicative (liftA2, (<$>)) @@ -56,13 +56,13 @@ stereoFrequenciesFromDetuneBendModulation :: Exp Real -> - (FP.T p inp (MultiValue.T Real), - FP.T p inp (MultiValue.T (BM.T Real))) -> + (FP.T p inp (NiceValue.T Real), + FP.T p inp (NiceValue.T (BM.T Real))) -> FP.T p inp (Stereo.T VectorValue) stereoFrequenciesFromDetuneBendModulation speed (detune, freq) = Causal.envelopeStereo $& (MIDIL.frequencyFromBendModulationPacked speed $& - (BM.unMultiValue <$> freq)) + (BM.unNiceValue <$> freq)) &|& (Causal.map (fmap Serial.upsample) $& liftA2 Stereo.cons (one + detune) (one - detune)) @@ -104,7 +104,7 @@ $& zero &|& index*freq) &|& freq - in fmap Stereo.multiValue $ + in fmap Stereo.niceValue $ Causal.envelopeStereo $& FP.plug env &|& Stereo.liftApplicative osci freqs) (pingControlledEnvelope (Just 0.01)) @@ -134,7 +134,7 @@ FP.plug $ liftA2 (uncurry transposeModulation) FP.askParameter fm) speed = Causal.map Serial.upsample $& FP.plug speed0 - in fmap Stereo.multiValue $ + in fmap Stereo.niceValue $ Causal.envelopeStereo $& FP.plug env &|& Stereo.liftApplicative (helixOsci speed) freqs) stringControlledEnvelope diff --git a/src/Synthesizer/LLVM/Server/CausalPacked/Speech.hs b/src/Synthesizer/LLVM/Server/CausalPacked/Speech.hs --- a/src/Synthesizer/LLVM/Server/CausalPacked/Speech.hs +++ b/src/Synthesizer/LLVM/Server/CausalPacked/Speech.hs @@ -51,8 +51,8 @@ import qualified Synthesizer.PiecewiseConstant.Signal as PC -import qualified Synthesizer.Generic.Control as CtrlG -import qualified Synthesizer.Generic.Signal as SigG +import qualified Synthesizer.State.Control as CtrlS +import qualified Synthesizer.State.Signal as SigS import qualified Synthesizer.Plain.Filter.Recursive.Universal as UniFilter import Synthesizer.Plain.Filter.Recursive (Pole(Pole)) @@ -61,7 +61,7 @@ import qualified Data.StorableVector as SV import qualified Data.Map as Map ; import Data.Map (Map) -import qualified LLVM.Extra.Multi.Value as MultiValue +import qualified LLVM.Extra.Nice.Value as NiceValue import qualified System.Path as Path import System.Path ((), (<.>)) @@ -70,6 +70,7 @@ import Control.Category ((.)) import Control.Applicative (pure, liftA, liftA3, (<$>), (<*>)) +import qualified Data.List as List import Data.Traversable (Traversable, traverse, forM) import NumericPrelude.Numeric @@ -120,7 +121,7 @@ Gate.shorten) (CausalRender.run $ wrapped $ \(Frequency low, Frequency high) (SampleRate _sr) -> - Stereo.multiValue + Stereo.niceValue ^<< Causal.stereoFromMono (let lowpass q f = @@ -131,7 +132,7 @@ Sig.constant (UniFilter.parameter $ Pole q f) in lowpass 100 low + lowpass 20 high) <<^ - Stereo.unMultiValue) + Stereo.unNiceValue) formants :: VoiceMsg.Pitch -> Maybe (Real, Real) formants p = @@ -159,11 +160,11 @@ Nothing -> arr $ const SV.empty Just mask -> filt (Render.buffer mask) . Gate.shorten) (CausalRender.run $ \mask -> - Stereo.multiValue + Stereo.niceValue ^<< Causal.stereoFromMono (FiltNR.convolvePacked mask) <<^ - Stereo.unMultiValue) + Stereo.unNiceValue) type @@ -202,9 +203,9 @@ filtRasp maskBuf $ case sr of SampleRate r -> - SVL.cycle $ SVL.take (round $ r/20) $ - CtrlG.exponential SigG.defaultLazySize - (r/40) 1) + SVL.fromChunks $ List.repeat $ + SigS.toStrictStorableSignal (round $ r/20) $ + CtrlS.exponential (r/40) 1) . zipEnvelope (case env of @@ -217,30 +218,30 @@ . zipEnvelope (contEnv sr vel)) <*> (CausalRender.run $ \mask -> - Stereo.multiValue <$> + Stereo.niceValue <$> Causal.envelopeStereo . second (Causal.stereoFromMono (FiltNR.convolvePacked mask) - <<^ Stereo.unMultiValue)) + <<^ Stereo.unNiceValue)) <*> (CausalRender.run $ \mask env -> - Stereo.multiValue <$> + Stereo.niceValue <$> Causal.envelopeStereo . ((Causal.envelope $< SigPS.pack env) *** (Causal.stereoFromMono (FiltNR.convolvePacked mask) - <<^ Stereo.unMultiValue))) + <<^ Stereo.unNiceValue))) <*> (CausalRender.run $ constant noiseReference 1e7 $ \noiseRef _sr mask -> - Stereo.multiValue <$> + Stereo.niceValue <$> Causal.envelopeStereo $> traverse (\seed -> FiltNR.convolvePacked mask $* SigPS.noise seed noiseRef) (Stereo.cons 42 23)) <*> (CausalRender.run $ \smp -> - (\x -> Stereo.consMultiValue x x) + (\x -> Stereo.consNiceValue x x) ^<< (Causal.envelope $> SigPS.pack smp)) <*> stringControlledEnvelope @@ -435,9 +436,9 @@ plugUniFilterParameter :: Input a (Control Real) -> Input a (Control Frequency) -> - FP.T (SampleRate Real) a (UniFilter.Parameter (MultiValue.T Real)) + FP.T (SampleRate Real) a (UniFilter.Parameter (NiceValue.T Real)) plugUniFilterParameter reson freq = - fmap UniFilterL.unMultiValueParameter $ + fmap UniFilterL.unNiceValueParameter $ FP.plug $ liftA3 (\resonChunk freqChunk sr -> @@ -455,9 +456,9 @@ (Input inp (Control Real), (Input inp (Control Real), Input inp (Control Frequency))) -> Input inp StereoChunk -> - FP.T (SampleRate Real) inp (MultiValue.T (Stereo.T Vector)) + FP.T (SampleRate Real) inp (NiceValue.T (Stereo.T Vector)) singleFormant (amp, (reson, freq)) x = - Stereo.multiValue <$> + Stereo.niceValue <$> Causal.envelopeStereo $& (Causal.map Serial.upsample $& FP.plug amp) &|& @@ -465,7 +466,7 @@ (UniFilter.bandpass ^<< CtrlPS.process) $& plugUniFilterParameter reson freq &|& - (Stereo.unMultiValue <$> FP.plug x)) + (Stereo.unNiceValue <$> FP.plug x)) filterFormant :: IO (SampleRate Real -> diff --git a/src/Synthesizer/LLVM/Server/CausalPacked/SpeechExplore.hs b/src/Synthesizer/LLVM/Server/CausalPacked/SpeechExplore.hs --- a/src/Synthesizer/LLVM/Server/CausalPacked/SpeechExplore.hs +++ b/src/Synthesizer/LLVM/Server/CausalPacked/SpeechExplore.hs @@ -161,7 +161,7 @@ ^<< Ctrl.process $< - (fmap UniFilterL.unMultiValueParameter $ Sig.constant $ + (fmap UniFilterL.unNiceValueParameter $ Sig.constant $ Expr.cons $ UniFilter.parameter $ Pole q $ f / sampleRate)) formants_sch) $* Sig.noise 174373 0.02) @@ -299,7 +299,7 @@ envelope sizeInt = let size = fromIntegral sizeInt rampSize = size / 8 - in Piece.run SigG.defaultLazySize $ + in Piece.runChunks $ 0 |# (rampSize, Piece.cosine) #|- 1 -|# (size-2*rampSize, Piece.step) #|- 1 -|# (rampSize, Piece.cosine) #| (0::Float) @@ -320,7 +320,7 @@ shrink = 2*halfShrink spec = spectrum $ SVL.take (shrink*responseSize) sampled shrunkenSpec = - SigG.fromState SigG.defaultLazySize $ + SigS.toStorableSignal SVL.defaultChunkSize $ SigS.init $ SigS.cons 0 $ SigS.map SigG.sum $ SigG.sliceVertical shrink $ SVL.drop halfShrink spec env = envelope responseSize diff --git a/src/Synthesizer/LLVM/Server/Common.hs b/src/Synthesizer/LLVM/Server/Common.hs --- a/src/Synthesizer/LLVM/Server/Common.hs +++ b/src/Synthesizer/LLVM/Server/Common.hs @@ -39,7 +39,7 @@ import qualified Synthesizer.MIDI.EventList as Ev import qualified Synthesizer.PiecewiseConstant.Signal as PC import qualified Synthesizer.CausalIO.Process as PIO -import qualified Synthesizer.Generic.Signal as SigG +import qualified Synthesizer.ChunkySize as ChunkySize import qualified Sound.MIDI.Controller as Ctrl import qualified Sound.MIDI.Message.Channel.Voice as VoiceMsg @@ -48,8 +48,8 @@ import qualified LLVM.DSL.Expression as Expr import LLVM.DSL.Expression (Exp) -import qualified LLVM.Extra.Multi.Value.Marshal as Marshal -import qualified LLVM.Extra.Multi.Value as MultiValue +import qualified LLVM.Extra.Nice.Value.Marshal as Marshal +import qualified LLVM.Extra.Nice.Value as NiceValue import qualified LLVM.Extra.Memory as Memory import qualified Data.StorableVector.Lazy as SVL @@ -98,43 +98,43 @@ SampleRate f <*> SampleRate sr = SampleRate $ f sr -instance (Render.RunArg a) => Render.RunArg (SampleRate a) where +instance (Render.Argument a) => Render.Argument (SampleRate a) where type DSLArg (SampleRate a) = SampleRate (Render.DSLArg a) - buildArg = - case Render.buildArg of + argument = + case Render.argument of Arg.Cons pass create -> Arg.Cons (SampleRate . pass) (\(SampleRate sr) -> create sr) -instance (MultiValue.C a) => MultiValue.C (SampleRate a) where - type Repr (SampleRate a) = MultiValue.Repr a - cons = multiValueSampleRate . fmap MultiValue.cons - undef = multiValueSampleRate $ pure MultiValue.undef - zero = multiValueSampleRate $ pure MultiValue.zero +instance (NiceValue.C a) => NiceValue.C (SampleRate a) where + type Repr (SampleRate a) = NiceValue.Repr a + cons = niceValueSampleRate . fmap NiceValue.cons + undef = niceValueSampleRate $ pure NiceValue.undef + zero = niceValueSampleRate $ pure NiceValue.zero phi bb = - fmap multiValueSampleRate . - Trav.traverse (MultiValue.phi bb) . unMultiValueSampleRate + fmap niceValueSampleRate . + Trav.traverse (NiceValue.phi bb) . unNiceValueSampleRate addPhi bb a b = Fold.sequence_ $ - liftA2 (MultiValue.addPhi bb) - (unMultiValueSampleRate a) (unMultiValueSampleRate b) + liftA2 (NiceValue.addPhi bb) + (unNiceValueSampleRate a) (unNiceValueSampleRate b) instance (Marshal.C a) => Marshal.C (SampleRate a) where pack (SampleRate a) = Marshal.pack a unpack = SampleRate . Marshal.unpack -multiValueSampleRate :: - SampleRate (MultiValue.T a) -> MultiValue.T (SampleRate a) -multiValueSampleRate (SampleRate (MultiValue.Cons a)) = MultiValue.Cons a +niceValueSampleRate :: + SampleRate (NiceValue.T a) -> NiceValue.T (SampleRate a) +niceValueSampleRate (SampleRate (NiceValue.Cons a)) = NiceValue.Cons a -unMultiValueSampleRate :: - MultiValue.T (SampleRate a) -> SampleRate (MultiValue.T a) -unMultiValueSampleRate (MultiValue.Cons a) = SampleRate (MultiValue.Cons a) +unNiceValueSampleRate :: + NiceValue.T (SampleRate a) -> SampleRate (NiceValue.T a) +unNiceValueSampleRate (NiceValue.Cons a) = SampleRate (NiceValue.Cons a) expSampleRate :: Exp (SampleRate a) -> SampleRate (Exp a) -expSampleRate = SampleRate . Expr.lift1 MultiValue.cast +expSampleRate = SampleRate . Expr.lift1 NiceValue.cast @@ -321,11 +321,11 @@ pioApplyToLazyTime :: (Storable b) => - PIO.T SigG.LazySize (SV.Vector b) -> Ev.LazyTime -> SVL.Vector b + PIO.T ChunkySize.LazySize (SV.Vector b) -> Ev.LazyTime -> SVL.Vector b pioApplyToLazyTime proc sig = Unsafe.performIO $ do act <- PIO.runCont proc return $ SVL.fromChunks $ act (const []) $ - map (SigG.LazySize . NonNegW.toNumber) $ + map (ChunkySize.LazySize . NonNegW.toNumber) $ concatMap PC.chopLongTime $ NonNegChunky.toChunks sig diff --git a/src/Synthesizer/LLVM/Server/Packed/Instrument.hs b/src/Synthesizer/LLVM/Server/Packed/Instrument.hs --- a/src/Synthesizer/LLVM/Server/Packed/Instrument.hs +++ b/src/Synthesizer/LLVM/Server/Packed/Instrument.hs @@ -166,7 +166,7 @@ import Synthesizer.LLVM.Causal.Functional (($&), (&|&)) import qualified LLVM.DSL.Expression as Expr -import qualified LLVM.Extra.Multi.Value as MultiValue +import qualified LLVM.Extra.Nice.Value as NiceValue import LLVM.DSL.Expression (Exp) import qualified LLVM.Extra.Arithmetic as A @@ -202,72 +202,72 @@ frequencyControl :: - (MultiValue.Field a, MultiValue.RationalConstant a) => + (NiceValue.Field a, NiceValue.RationalConstant a) => SampleRate (Exp a) -> - Sig.T (Const.T (MultiValue.T a)) -> - Sig.T (Const.T (MultiValue.T a)) + Sig.T (Const.T (NiceValue.T a)) -> + Sig.T (Const.T (NiceValue.T a)) frequencyControl sr xs = Const.causalMap (frequency sr) $* xs data FrequencyControl a instance - (a ~ Exp b, MultiValue.Field b, MultiValue.RationalConstant b) => + (a ~ Exp b, NiceValue.Field b, NiceValue.RationalConstant b) => Input (FrequencyControl b) a where data InputArg (FrequencyControl b) a = - FrequencyControl (Sig.T (Const.T (MultiValue.T b))) + FrequencyControl (Sig.T (Const.T (NiceValue.T b))) type InputSource (FrequencyControl b) a = - Sig.T (Const.T (MultiValue.T b)) + Sig.T (Const.T (NiceValue.T b)) evalInput sampleRate = FrequencyControl . frequencyControl sampleRate modulation :: - (MultiValue.Field a, MultiValue.RationalConstant a) => + (NiceValue.Field a, NiceValue.RationalConstant a) => SampleRate (Exp a) -> - (Sig.T (Const.T (MultiValue.T (BM.T a))), Exp a) -> - Sig.T (Const.T (BM.T (MultiValue.T a))) + (Sig.T (Const.T (NiceValue.T (BM.T a))), Exp a) -> + Sig.T (Const.T (BM.T (NiceValue.T a))) modulation sr (fm,freq) = - transposeModulation sr freq (fmap BM.unMultiValue <$> fm) + transposeModulation sr freq (fmap BM.unNiceValue <$> fm) data Modulation a instance - (a ~ Exp b, MultiValue.Field b, MultiValue.RationalConstant b) => + (a ~ Exp b, NiceValue.Field b, NiceValue.RationalConstant b) => Input (Modulation b) a where data InputArg (Modulation b) a = - Modulation (Sig.T (Const.T (BM.T (MultiValue.T b)))) + Modulation (Sig.T (Const.T (BM.T (NiceValue.T b)))) type InputSource (Modulation b) a = - (Sig.T (Const.T (MultiValue.T (BM.T b))), Exp b) + (Sig.T (Const.T (NiceValue.T (BM.T b))), Exp b) evalInput sampleRate (fm,freq) = Modulation $ modulation sampleRate (fm,freq) detuneModulation :: - (MultiValue.Field a, MultiValue.RationalConstant a) => + (NiceValue.Field a, NiceValue.RationalConstant a) => SampleRate (Exp a) -> - (b, Sig.T (Const.T (MultiValue.T (BM.T a))), Exp a) -> - (b, Sig.T (Const.T (BM.T (MultiValue.T a)))) + (b, Sig.T (Const.T (NiceValue.T (BM.T a))), Exp a) -> + (b, Sig.T (Const.T (BM.T (NiceValue.T a)))) detuneModulation sr (det,fm,freq) = - (det, transposeModulation sr freq (fmap BM.unMultiValue <$> fm)) + (det, transposeModulation sr freq (fmap BM.unNiceValue <$> fm)) data DetuneModulation a instance - (a ~ Exp b, MultiValue.Field b, MultiValue.RationalConstant b) => + (a ~ Exp b, NiceValue.Field b, NiceValue.RationalConstant b) => Input (DetuneModulation b) a where data InputArg (DetuneModulation b) a = DetuneModulation - (Sig.T (Const.T (MultiValue.T b)), - Sig.T (Const.T (BM.T (MultiValue.T b)))) + (Sig.T (Const.T (NiceValue.T b)), + Sig.T (Const.T (BM.T (NiceValue.T b)))) type InputSource (DetuneModulation b) a = - (Sig.T (Const.T (MultiValue.T b)), - Sig.T (Const.T (MultiValue.T (BM.T b))), + (Sig.T (Const.T (NiceValue.T b)), + Sig.T (Const.T (NiceValue.T (BM.T b))), Exp b) evalInput sampleRate (det,fm,freq) = DetuneModulation $ detuneModulation sampleRate (det,fm,freq) -type RealValue = MultiValue.T Real +type RealValue = NiceValue.T Real frequencyFromBendModulation :: Exp Real -> @@ -327,7 +327,7 @@ (\osc env dec rel vcsize sr vel freq dur -> pioApply (osc sr freq) (env dec rel vcsize sr vel dur)) (CausalRender.run $ wrapped $ \(Frequency freq) (SampleRate _sr) -> - Stereo.multiValue <$> + Stereo.niceValue <$> Causal.envelopeStereo $> liftA2 Stereo.cons (SigPS.osci WaveL.saw zero (0.999*freq)) @@ -353,7 +353,7 @@ wrapped $ \(Number phase, Time decay) (Control shape) (DetuneModulation fm) -> constant frequency 10 $ \speed _sr -> - Stereo.multiValue <$> + Stereo.niceValue <$> Causal.envelopeStereo $> ((Causal.stereoFromMonoControlled (CausalPS.shapeModOsci WaveL.rationalApproxSine1) @@ -397,7 +397,7 @@ CausalPS.shapeModOsci WaveL.rationalApproxSine1) <<^ (\((p,s),f) -> (s,(p,f))) - in Stereo.multiValue <$> + in Stereo.niceValue <$> Causal.envelopeStereo $> ((Causal.stereoFromMonoControlled chanOsci $< liftA2 (,) @@ -444,7 +444,7 @@ (CausalPS.osci WaveL.approxSine4 $< zero) <<< CausalPS.amplifyStereo d)) - in Stereo.multiValue <$> + in Stereo.niceValue <$> sumNested [osci fst3 0.6 1, osci snd3 (0.02 * 50^?vel) 4, @@ -524,7 +524,7 @@ Causal.map Serial.subsample <<< CausalPS.amplify d)) - in liftA2 Stereo.consMultiValue + in liftA2 Stereo.consNiceValue (sumNested [osci fst3 0.6 (1*0.999), osci snd3 (0.02 * 50^?vel) (4*0.999), @@ -574,7 +574,7 @@ constant time 1 $ \halfLife _sr -> (let chanOsci d = CausalPS.osci WaveL.approxSine2 $> SigPS.constant (freq*d) - in Stereo.multiValue <$> + in Stereo.niceValue <$> Causal.envelopeStereo $> (liftA2 Stereo.cons (chanOsci 0.995) (chanOsci 1.005) $* (SigPS.exponential2 halfLife (vel+1) * @@ -624,7 +624,7 @@ (CausalRender.run $ wrapped $ \(Frequency freq) (SampleRate _sr) -> let osci d = SigPS.osci WaveL.saw zero (d * freq) - in Stereo.multiValue <$> + in Stereo.niceValue <$> Causal.envelopeStereo $> (liftA2 Stereo.cons (osci 1.005 + osci 0.998) @@ -641,7 +641,7 @@ wrapped $ \(Modulation fm) -> constant frequency 5 $ \speed _sr -> let osci d = (CausalPS.osci WaveL.saw $< zero) <<< CausalPS.amplify d - in Stereo.multiValue <$> + in Stereo.niceValue <$> (Causal.envelopeStereo $> (liftA2 Stereo.cons (osci 1.005 + osci 0.998) @@ -666,7 +666,7 @@ (let chanOsci d = CausalPS.osci WaveL.approxSine2 <<< second (CausalPS.amplify d) - in Stereo.multiValue <$> + in Stereo.niceValue <$> Causal.envelopeStereo $> (liftA2 Stereo.cons (chanOsci 0.995) (chanOsci 1.005) <<< @@ -734,7 +734,7 @@ wrapped $ \(Control index, Control depth) (Number vel) (DetuneModulation fm) -> constant frequency 5 $ \speed sr -> - Stereo.multiValue <$> + Stereo.niceValue <$> Causal.envelopeStereo $> (tineControlledFnProc index depth vel sr $* stereoFrequenciesFromDetuneBendModulation speed fm)) @@ -809,7 +809,7 @@ wrapped $ \(Control index, Control depth) (Control fade) (Number vel) (DetuneModulation fm) -> constant frequency 5 $ \speed sr -> - Stereo.multiValue <$> + Stereo.niceValue <$> Causal.envelopeStereo $> (fenderProc fade index depth vel sr $* stereoFrequenciesFromDetuneBendModulation speed fm)) @@ -853,7 +853,7 @@ \(Control depth1) (Control depth2) (Control depth3) (Control depth4) (Number vel) (DetuneModulation fm) -> constant frequency 5 $ \speed sr -> - Stereo.multiValue <$> + Stereo.niceValue <$> (Causal.envelopeStereo $> (Causal.stereoFromMono (CausalPS.osci WaveL.approxSine2) <<< @@ -903,7 +903,7 @@ partial amp n t = A.mul amp =<< WaveL.partial WaveL.approxSine2 n t - in Stereo.multiValue <$> + in Stereo.niceValue <$> Causal.envelopeStereo $> (Causal.stereoFromMono (CausalPS.shapeModOsci @@ -995,7 +995,7 @@ \(Control reson, Control index, Control depth) (Number vel) (DetuneModulation fm) -> constant frequency 5 $ \speed sr -> - Stereo.multiValue <$> + Stereo.niceValue <$> Causal.envelopeStereo $> (resonantFMSynthProc reson index depth vel sr $* stereoFrequenciesFromDetuneBendModulation speed fm)) @@ -1032,7 +1032,7 @@ in CausalRender.run $ wrapped $ \(Control det) (Modulation fm) -> constant frequency 5 $ \speed _sr -> - Stereo.multiValue <$> + Stereo.niceValue <$> (Causal.envelopeStereo $> (phaserOsci osci $< piecewiseConstantVector det @@ -1112,7 +1112,7 @@ in CausalRender.run $ wrapped $ \(Control det) (Control dist) (Modulation fm) -> constant frequency 5 $ \speed _sr -> - Stereo.multiValue <$> + Stereo.niceValue <$> (Causal.envelopeStereo $> (phaserOsci osci $< piecewiseConstantVector dist @@ -1156,7 +1156,7 @@ wrapped $ \(Control det) (Control depth) (Control dist) (Modulation fm) -> constant frequency 5 $ \speed _sr -> - Stereo.multiValue <$> + Stereo.niceValue <$> (Causal.envelopeStereo <<< (id &&& (phaserOsci osci @@ -1204,7 +1204,7 @@ pioApply (osc sr reson (fm, freq)) (env att sr vel dur)) (CausalRender.run $ wrapped $ \(Control reson) (Modulation fm) sr -> - Stereo.multiValue <$> + Stereo.niceValue <$> Causal.envelopeStereo $> windCore reson fm sr) softStringReleaseEnvelope @@ -1238,7 +1238,7 @@ wrapped $ \(Control phaserMix) (FrequencyControl phaserFreq) (Control reson) (Modulation fm) sr -> - Stereo.multiValue <$> + Stereo.niceValue <$> (Causal.envelopeStereo $> ((Causal.stereoFromMonoControlled (fadeProcess (arr snd) CtrlPS.process @@ -1274,7 +1274,7 @@ wrapped $ \(Frequency bright) (Time brightDec) (DetuneModulation fm) -> constant frequency 10 $ \speed -> constant frequency 100 $ \cutoff _sr -> - (Stereo.multiValue <$> + (Stereo.niceValue <$> Causal.envelopeStereo $> (Causal.stereoFromMono (UniFilter.lowpass @@ -1395,7 +1395,7 @@ wrapped $ \(Control det) (Control dist) (Modulation fm) (Signal emph) -> constant frequency 5 $ \speed _sr -> - Stereo.multiValue <$> + Stereo.niceValue <$> Causal.envelopeStereo $> (phaserOsci osci <<< @@ -1441,7 +1441,7 @@ (osc sr amp release (NonNegChunky.fromChunks (repeat 1000))))) (CausalRender.run $ wrapped $ \(Number amp) (Signal smp) (Signal dur) (SampleRate _sr) -> - Stereo.multiValue <$> + Stereo.niceValue <$> CausalPS.amplifyStereo amp <<< Causal.stereoFromMono @@ -1491,7 +1491,7 @@ pioApply (osc sr amp release) releaseFM) (CausalRender.run $ wrapped $ \(Number amp) (Signal smp) (SampleRate _sr) -> - Stereo.multiValue <$> + Stereo.niceValue <$> CausalPS.amplifyStereo amp <<< Causal.stereoFromMono diff --git a/src/Synthesizer/LLVM/Server/Scalar/Instrument.hs b/src/Synthesizer/LLVM/Server/Scalar/Instrument.hs --- a/src/Synthesizer/LLVM/Server/Scalar/Instrument.hs +++ b/src/Synthesizer/LLVM/Server/Scalar/Instrument.hs @@ -23,7 +23,7 @@ import Synthesizer.Causal.Class (($<), ($>), ($*)) import qualified LLVM.DSL.Expression as Expr -import qualified LLVM.Extra.Multi.Value as MultiValue +import qualified LLVM.Extra.Nice.Value as NiceValue import LLVM.DSL.Expression (Exp) import qualified Synthesizer.MIDI.EventList as Ev @@ -40,7 +40,7 @@ pingSig :: - SampleRate (Exp Real) -> Exp Real -> Exp Real -> Sig.T (MultiValue.T Real) + SampleRate (Exp Real) -> Exp Real -> Exp Real -> Sig.T (NiceValue.T Real) pingSig = wrapped $ \(Number vel) (Frequency freq) -> constant time 0.2 $ \halfLife _sr -> @@ -104,7 +104,7 @@ (\osc env dec rel chunkSize sr vel freq dur -> pioApply (osc sr freq) (env dec rel chunkSize sr vel dur)) (CausalRender.run $ frequency $+ \freq _sr -> - Stereo.multiValue <$> + Stereo.niceValue <$> Causal.envelopeStereo $> liftA2 Stereo.cons (Sig.osci WaveL.saw zero (0.999*freq)) @@ -140,7 +140,7 @@ constant time 1 $ \halfLife _sr -> let chanOsci d = Causal.osci WaveL.approxSine2 $> Sig.constant (freq*d) - in Stereo.multiValue <$> + in Stereo.niceValue <$> Causal.envelopeStereo $> (liftA2 Stereo.cons (chanOsci 0.995) (chanOsci 1.005) $* (Causal.envelope @@ -183,7 +183,7 @@ (\osc env sr vel freq dur -> pioApply (osc sr freq) (env 1 sr vel dur)) (CausalRender.run $ frequency $+ \freq _sr -> let osci d = Sig.osci WaveL.saw zero (d * freq) - in Stereo.multiValue <$> + in Stereo.niceValue <$> Causal.envelopeStereo $> liftA2 Stereo.cons (osci 1.005 + osci 0.998) diff --git a/src/Synthesizer/LLVM/Storable/Process.hs b/src/Synthesizer/LLVM/Storable/Process.hs --- a/src/Synthesizer/LLVM/Storable/Process.hs +++ b/src/Synthesizer/LLVM/Storable/Process.hs @@ -21,8 +21,8 @@ import qualified Data.EventList.Relative.TimeMixed as EventListTM import qualified Data.EventList.Absolute.TimeBody as AbsEventList -import qualified LLVM.Extra.Multi.Value.Storable as Storable -import qualified LLVM.Extra.Multi.Value as MultiValue +import qualified LLVM.Extra.Nice.Value.Storable as Storable +import qualified LLVM.Extra.Nice.Value as NiceValue import qualified LLVM.Extra.Arithmetic as A import qualified Type.Data.Num.Decimal as TypeNum @@ -48,7 +48,7 @@ must fit into the length of the event list. -} makeArranger :: - (Arr.Arrow arrow, Storable.C a, MultiValue.Additive a) => + (Arr.Arrow arrow, Storable.C a, NiceValue.Additive a) => IO (arrow (EventListTT.T NonNeg.Int (SV.Vector a)) (SV.Vector a)) diff --git a/src/Synthesizer/LLVM/Storable/Signal.hs b/src/Synthesizer/LLVM/Storable/Signal.hs --- a/src/Synthesizer/LLVM/Storable/Signal.hs +++ b/src/Synthesizer/LLVM/Storable/Signal.hs @@ -28,8 +28,8 @@ import qualified Number.NonNegative as NonNeg import qualified LLVM.DSL.Execution as Exec -import qualified LLVM.Extra.Multi.Value.Storable as Storable -import qualified LLVM.Extra.Multi.Value as MultiValue +import qualified LLVM.Extra.Nice.Value.Storable as Storable +import qualified LLVM.Extra.Nice.Value as NiceValue import qualified LLVM.Core as LLVM import qualified Type.Data.Num.Decimal as TypeNum @@ -96,7 +96,7 @@ makeReverser :: - (Storable.C a, MultiValue.T a ~ value) => + (Storable.C a, NiceValue.T a ~ value) => (value -> LLVM.CodeGenFunction () value) -> IO (Word -> Ptr a -> Ptr a -> IO ()) makeReverser rev = @@ -201,7 +201,7 @@ it also simplifies type inference. -} fillBuffer :: - (Storable.C a, MultiValue.T a ~ value) => + (Storable.C a, NiceValue.T a ~ value) => value -> IO (Word -> Ptr a -> IO ()) fillBuffer x = Exec.compile "constant" $ @@ -213,7 +213,7 @@ Exec.Importer (Word -> Ptr a -> Ptr a -> IO ()) makeMixer :: - (Storable.C a, MultiValue.T a ~ value) => + (Storable.C a, NiceValue.T a ~ value) => (value -> value -> LLVM.CodeGenFunction () value) -> IO (Word -> Ptr a -> Ptr a -> IO ()) makeMixer add = @@ -243,13 +243,13 @@ Same algorithm as in Synthesizer.Storable.Cut.arrangeEquidist -} makeArranger :: - (Storable.C a, MultiValue.Additive a) => + (Storable.C a, NiceValue.Additive a) => IO (SVL.ChunkSize -> EventList.T NonNeg.Int (SVL.Vector a) -> SVL.Vector a) makeArranger = do - mixer <- makeMixer MultiValue.add - fill <- fillBuffer MultiValue.zero + mixer <- makeMixer NiceValue.add + fill <- fillBuffer NiceValue.zero return $ \ (SVL.ChunkSize sz) -> let sznn = NonNeg.fromNumberMsg "arrange" sz go acc evs = diff --git a/synthesizer-llvm.cabal b/synthesizer-llvm.cabal --- a/synthesizer-llvm.cabal +++ b/synthesizer-llvm.cabal @@ -1,6 +1,6 @@ Cabal-Version: 2.2 Name: synthesizer-llvm -Version: 1.1.0.1 +Version: 1.2 License: GPL-3.0-only License-File: LICENSE Author: Henning Thielemann @@ -43,7 +43,7 @@ Tested-With: GHC==8.6.5, GHC==8.8.4, GHC==8.10.7 Tested-With: GHC==9.2.2, GHC==9.4.7, GHC==9.6.3 Build-Type: Simple -Extra-Source-Files: +Extra-Doc-Files: Changes.md Flag buildExamples @@ -59,7 +59,7 @@ default: False Source-Repository this - Tag: 1.1.0.1 + Tag: 1.2 Type: darcs Location: http://code.haskell.org/synthesizer/llvm/ @@ -70,13 +70,13 @@ Library Build-Depends: - llvm-dsl >=0.1.1 && <0.2, - llvm-extra >=0.11 && <0.13, - llvm-tf >=9.0 && <17.1, + llvm-dsl >=0.2 && <0.3, + llvm-extra >=0.12.1 && <0.14, + llvm-tf >=9.0 && <21.1, tfp >=1.0 && <1.1, vault >=0.3 && <0.4, - synthesizer-core >=0.8 && <0.9, - synthesizer-midi >=0.6 && <0.7, + synthesizer-core >=0.9 && <0.10, + synthesizer-midi >=0.7 && <0.8, midi >=0.2.1 && <0.3, storable-record >=0.0.3 && <0.1, sox >=0.2 && <0.3, @@ -86,11 +86,11 @@ non-negative >=0.1 && <0.2, non-empty >=0.2.1 && <0.4, event-list >=0.1 && <0.2, - pathtype >=0.8 && <0.9, - random >=1.0 && <1.3, - containers >=0.1 && <0.7, + pathtype >=0.8 && <0.10, + random >=1.0 && <1.4, + containers >=0.1 && <0.9, transformers >=0.2 && <0.7, - semigroups >=0.1 && <1.0, + semigroups >=0.1 && <1, utility-ht >=0.0.15 && <0.1 Build-Depends: @@ -198,7 +198,7 @@ event-list, shell-utility >=0.0 && <0.2, pathtype, - optparse-applicative >=0.11 && <0.19, + optparse-applicative >=0.11 && <0.20, containers, utility-ht, base @@ -257,6 +257,7 @@ Main-Is: Synthesizer/LLVM/Test.hs Other-Modules: Synthesizer.LLVM.LAC2011 + Synthesizer.LLVM.Experiment Synthesizer.LLVM.ExampleUtility Executable synthi-llvm-lndw @@ -283,7 +284,7 @@ utility-ht, pathtype, - synthesizer-alsa >=0.5 && <0.6, + synthesizer-alsa >=0.6 && <0.7, alsa-pcm >=0.6 && <0.7, base Else @@ -327,7 +328,7 @@ transformers, utility-ht, - synthesizer-alsa >=0.5 && <0.6, + synthesizer-alsa >=0.6 && <0.7, midi-alsa >=0.2.1 && <0.3, alsa-seq >=0.6 && <0.7, alsa-pcm >=0.6 && <0.7, diff --git a/testsuite/Test/Synthesizer/LLVM/Filter.hs b/testsuite/Test/Synthesizer/LLVM/Filter.hs --- a/testsuite/Test/Synthesizer/LLVM/Filter.hs +++ b/testsuite/Test/Synthesizer/LLVM/Filter.hs @@ -59,7 +59,7 @@ import qualified LLVM.DSL.Expression as Expr import LLVM.DSL.Expression (Exp) -import qualified LLVM.Extra.Multi.Value as MultiValue +import qualified LLVM.Extra.Nice.Value as NiceValue import qualified LLVM.Extra.Arithmetic as A import qualified LLVM.Extra.Memory as Memory @@ -110,14 +110,14 @@ (TypeNum.Natural n) => Proxy n -> Exp Float -> - Sig.T (Allpass.CascadeParameter n (MultiValue.T Float)) + Sig.T (Allpass.CascadeParameter n (NiceValue.T Float)) allpassControl order = lfoSine (Allpass.flangerParameter order) allpassPhaserCausal, allpassPhaserPipeline :: Exp Float -> - Sig.T (MultiValue.T Float) -> - Sig.T (MultiValue.T Float) + Sig.T (NiceValue.T Float) -> + Sig.T (NiceValue.T Float) allpassPhaserCausal reduct xs = Allpass.phaser $< allpassControl TypeNum.d16 reduct @@ -232,13 +232,13 @@ -diracImpulse :: Sig.T (MultiValue.T Float) +diracImpulse :: Sig.T (NiceValue.T Float) diracImpulse = Causal.delay1 one $* Sig.constant zero firstOrderConstant :: Exp Float -> - Sig.T (MultiValue.T Float) -> - Sig.T (MultiValue.T Float) + Sig.T (NiceValue.T Float) -> + Sig.T (NiceValue.T Float) firstOrderConstant cutOff xs = FirstOrder.lowpassCausal $< Sig.constant (FirstOrderCore.parameter cutOff) @@ -256,8 +256,8 @@ firstOrderCausal :: Exp Float -> - Sig.T (MultiValue.T Float) -> - Sig.T (MultiValue.T Float) + Sig.T (NiceValue.T Float) -> + Sig.T (NiceValue.T Float) firstOrderCausal reduct xs = FirstOrder.lowpassCausal $< lfoSine FirstOrder.parameter reduct @@ -307,8 +307,8 @@ secondOrderCausal :: Exp Float -> - Sig.T (MultiValue.T Float) -> - Sig.T (MultiValue.T Float) + Sig.T (NiceValue.T Float) -> + Sig.T (NiceValue.T Float) secondOrderCausal reduct xs = SecondOrder.causal $< lfoSine (SecondOrder.bandpassParameter 10) reduct @@ -335,8 +335,8 @@ secondOrderCausalPacked2 :: Exp Float -> - Sig.T (MultiValue.T Float) -> - Sig.T (MultiValue.T Float) + Sig.T (NiceValue.T Float) -> + Sig.T (NiceValue.T Float) secondOrderCausalPacked2 reduct xs = SecondOrderP.causal $< lfoSine (SecondOrderP.bandpassParameter 10) reduct @@ -362,8 +362,8 @@ universalCausal :: Exp Float -> - Sig.T (MultiValue.T Float) -> - Sig.T (UniFilter.Result (MultiValue.T Float)) + Sig.T (NiceValue.T Float) -> + Sig.T (UniFilter.Result (NiceValue.T Float)) universalCausal reduct xs = UniFilter.causal $< lfoSine (UniFilter.parameter 10) reduct @@ -404,8 +404,8 @@ (TypeNum.Natural n) => Proxy n -> Exp Float -> - Sig.T (MultiValue.T Float) -> - Sig.T (MultiValue.T Float) + Sig.T (NiceValue.T Float) -> + Sig.T (NiceValue.T Float) moogCausal order reduct xs = Moog.causal $< lfoSine (Moog.parameter order 10) reduct @@ -440,8 +440,8 @@ complexCausal :: Exp Float -> - Sig.T (MultiValue.T Float) -> - Sig.T (Stereo.T (MultiValue.T Float)) + Sig.T (NiceValue.T Float) -> + Sig.T (Stereo.T (NiceValue.T Float)) complexCausal reduct xs = ComplexFilter.causal $< lfoSine (ComplexFilter.parameter 10) reduct @@ -449,8 +449,8 @@ complexCausalPacked :: Exp Float -> - Sig.T (MultiValue.T Float) -> - Sig.T (Stereo.T (MultiValue.T Float)) + Sig.T (NiceValue.T Float) -> + Sig.T (Stereo.T (NiceValue.T Float)) complexCausalPacked reduct xs = ComplexFilterP.causal $< lfoSine (ComplexFilterP.parameter 10) reduct diff --git a/testsuite/Test/Synthesizer/LLVM/Helix.hs b/testsuite/Test/Synthesizer/LLVM/Helix.hs --- a/testsuite/Test/Synthesizer/LLVM/Helix.hs +++ b/testsuite/Test/Synthesizer/LLVM/Helix.hs @@ -24,7 +24,7 @@ import qualified LLVM.DSL.Expression as Expr import LLVM.DSL.Expression (Exp) -import qualified LLVM.Extra.Multi.Value as MultiValue +import qualified LLVM.Extra.Nice.Value as NiceValue import Foreign.Storable (Storable) @@ -70,14 +70,14 @@ staticDynamic = let len :: (Ring.C a) => a len = 1000 - noise :: Exp Word32 -> Sig.T (MultiValue.T Float) + noise :: Exp Word32 -> Sig.T (NiceValue.T Float) noise seed = Sig.noise seed 1 static, dynamic :: - ((Sig.T (MultiValue.T Float), Sig.T (MultiValue.T Float)), + ((Sig.T (NiceValue.T Float), Sig.T (NiceValue.T Float)), Exp Float, (Exp Word32, Exp (Source.StorableVector Float))) -> - Func.T inp (MultiValue.T Float) + Func.T inp (NiceValue.T Float) static ((speedSig, phaseSig), period, (_, noiseSig)) = Helix.static Interpolation.linear Interpolation.linear (Expr.roundToIntFast period) period noiseSig diff --git a/testsuite/Test/Synthesizer/LLVM/RingBufferForward.hs b/testsuite/Test/Synthesizer/LLVM/RingBufferForward.hs --- a/testsuite/Test/Synthesizer/LLVM/RingBufferForward.hs +++ b/testsuite/Test/Synthesizer/LLVM/RingBufferForward.hs @@ -21,7 +21,7 @@ import qualified LLVM.DSL.Expression as Expr -import qualified LLVM.Extra.Multi.Value as MultiValue +import qualified LLVM.Extra.Nice.Value as NiceValue import Foreign.Storable (Storable) @@ -122,7 +122,7 @@ <$> checkEquality2 limitFloat limitFloat (\(skips, k, seed) -> - (,) (MultiValue.cons True) <$> + (,) (NiceValue.cons True) <$> (RingBuffer.mapIndex k $* (RingBuffer.trackSkip (Expr.cons bufferSize) (noise seed) $* skips))) diff --git a/testsuite/Test/Synthesizer/LLVM/Utility.hs b/testsuite/Test/Synthesizer/LLVM/Utility.hs --- a/testsuite/Test/Synthesizer/LLVM/Utility.hs +++ b/testsuite/Test/Synthesizer/LLVM/Utility.hs @@ -12,7 +12,7 @@ import qualified Synthesizer.CausalIO.Process as PIO import qualified Synthesizer.Causal.Class as CausalClass -import qualified Synthesizer.Generic.Signal as SigG +import qualified Synthesizer.ChunkySize as ChunkySize import qualified Synthesizer.State.Signal as SigS import qualified Synthesizer.Zip as Zip @@ -24,8 +24,8 @@ import Data.StorableVector.Lazy (ChunkSize) import Foreign.Storable (Storable) -import qualified LLVM.Extra.Multi.Value.Storable as Storable -import qualified LLVM.Extra.Multi.Value as MultiValue +import qualified LLVM.Extra.Nice.Value.Storable as Storable +import qualified LLVM.Extra.Nice.Value as NiceValue import qualified Type.Data.Num.Decimal as TypeNum @@ -62,17 +62,17 @@ render :: - (Render.RunArg p) => - (Storable.C a, MultiValue.T a ~ al) => + (Render.Argument p) => + (Storable.C a, NiceValue.T a ~ al) => (SVL.Vector a -> sig) -> (Render.DSLArg p -> Sig.T al) -> IO (ChunkSize -> p -> sig) render limit sig = fmap (\func chunkSize -> limit . func chunkSize) $ Render.run sig render2 :: - (Render.RunArg p) => - (Storable.C a, MultiValue.T a ~ al) => - (Storable.C b, MultiValue.T b ~ bl) => + (Render.Argument p) => + (Storable.C a, NiceValue.T a ~ al) => + (Storable.C b, NiceValue.T b ~ bl) => ((SVL.Vector a, SVL.Vector b) -> sig) -> (Render.DSLArg p -> Sig.T (al, bl)) -> IO (ChunkSize -> p -> sig) render2 limit sig = do @@ -81,7 +81,7 @@ limit . mapPair (SVL.fromChunks, SVL.fromChunks) . unzip . map (\(Zip.Cons a b) -> (a,b)) $ Unsafe.performIO (PIO.runCont (proc p)) (const []) - (repeat $ SigG.LazySize chunkSize) + (repeat $ ChunkySize.LazySize chunkSize) data CheckSimilarityState a = @@ -98,8 +98,8 @@ {-# INLINE checkSimilarityState #-} checkSimilarityState :: - (Render.RunArg p) => - (RealRing.C a, Storable.C a, MultiValue.T a ~ av) => + (Render.Argument p) => + (RealRing.C a, Storable.C a, NiceValue.T a ~ av) => a -> (SVL.Vector a -> SVL.Vector a) -> (Render.DSLArg p -> Sig.T av) -> @@ -128,9 +128,9 @@ {-# INLINE checkSimilarity #-} checkSimilarity :: - (Render.RunArg p) => + (Render.Argument p) => (RealRing.C b, Storable.C b, - Storable.C a, MultiValue.T a ~ av) => + Storable.C a, NiceValue.T a ~ av) => b -> (SVL.Vector a -> SVL.Vector b) -> (Render.DSLArg p -> Sig.T av) -> @@ -144,10 +144,10 @@ (render limit gen1) checkSimilarityPacked :: - (Render.RunArg p) => + (Render.Argument p) => Float -> (SVL.Vector Float -> SVL.Vector Float) -> - (Render.DSLArg p -> Sig.T (MultiValue.T Float)) -> + (Render.DSLArg p -> Sig.T (NiceValue.T Float)) -> (Render.DSLArg p -> Sig.T (SerialCode.Value TypeNum.D4 Float)) -> IO (ChunkSize -> p -> CheckSimilarity Float) checkSimilarityPacked tol limit scalar vector = @@ -168,8 +168,8 @@ property (CheckEqualityGen x y) = QC.property (x==y) checkEquality :: - (Render.RunArg p) => - (Eq a, Storable.C a, MultiValue.T a ~ av) => + (Render.Argument p) => + (Eq a, Storable.C a, NiceValue.T a ~ av) => (SVL.Vector a -> SVL.Vector a) -> (Render.DSLArg p -> Sig.T av) -> (Render.DSLArg p -> Sig.T av) -> @@ -182,9 +182,9 @@ (render limit gen1) checkEquality2 :: - (Render.RunArg p) => - (Eq a, Storable.C a, MultiValue.T a ~ al) => - (Eq b, Storable.C b, MultiValue.T b ~ bl) => + (Render.Argument p) => + (Eq a, Storable.C a, NiceValue.T a ~ al) => + (Eq b, Storable.C b, NiceValue.T b ~ bl) => (SVL.Vector a -> SVL.Vector a) -> (SVL.Vector b -> SVL.Vector b) -> (Render.DSLArg p -> Sig.T (al,bl)) ->