csound-expression-dynamic 0.3.2 → 0.3.3
raw patch · 5 files changed
+234/−110 lines, 5 filesdep ~wl-pprintPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: wl-pprint
API changes (from Hackage documentation)
Files
- csound-expression-dynamic.cabal +2/−2
- src/Csound/Dynamic/Build/Numeric.hs +43/−28
- src/Csound/Dynamic/Types/Dep.hs +4/−0
- src/Csound/Dynamic/Types/Exp.hs +6/−4
- src/Csound/Dynamic/Types/Flags.hs +179/−76
csound-expression-dynamic.cabal view
@@ -1,5 +1,5 @@ Name: csound-expression-dynamic-Version: 0.3.2+Version: 0.3.3 Cabal-Version: >= 1.6 License: BSD3 License-file: LICENSE@@ -24,7 +24,7 @@ Library Ghc-Options: -Wall Build-Depends:- base >= 4, base < 5, data-default, containers, array, transformers >= 0.3, wl-pprint,+ base >= 4, base < 5, data-default, containers, array, transformers >= 0.3, wl-pprint >= 1.2.1, Boolean >= 0.1.0, data-fix, data-fix-cse >= 0.0.2, hashable Hs-Source-Dirs: src/ Exposed-Modules:
src/Csound/Dynamic/Build/Numeric.hs view
@@ -1,11 +1,13 @@ {-# OPTIONS_GHC -fno-warn-orphans #-}-{-# Language TypeSynonymInstances, FlexibleInstances #-}+{-# Language TypeSynonymInstances, FlexibleInstances, CPP #-} -- | Numeric instances module Csound.Dynamic.Build.Numeric(- ceilE, floorE, roundE, intE, fracE + ceilE, floorE, roundE, intE, fracE ) where -import Data.Monoid+#if !MIN_VERSION_base(4,11,0)+import Data.Monoid (Monoid(..))+#endif import Csound.Dynamic.Types.Exp import Csound.Dynamic.Build(toExp, prim, opr1, numExp1)@@ -13,41 +15,54 @@ --------------------------------------------- -- monoid +#if MIN_VERSION_base(4,11,0)+instance Semigroup E where+ x <> y = x + y+ instance Monoid E where mempty = 0++#else++instance Monoid E where+ mempty = 0 mappend = (+) +#endif+++ -------------------------------------------- -- numeric instances -instance Num E where - (+) a b +instance Num E where+ (+) a b | isZero a = b | isZero b = a | otherwise = biOpt (+) Add a b- - (*) a b ++ (*) a b | isZero a || isZero b = fromDouble 0 | otherwise = biOpt (*) Mul a b- - (-) a b ++ (-) a b | isZero a = negate b | isZero b = a- | otherwise = biOpt (-) Sub a b - + | otherwise = biOpt (-) Sub a b+ negate = unOpt negate (numExp1 Neg)- + fromInteger = fromDouble . fromInteger abs = unOpt abs (opr1 "abs") signum = undefined instance Fractional E where- (/) a b + (/) a b | isZero a = fromDouble 0- | isZero b = error "csound (/): division by zero" + | isZero b = error "csound (/): division by zero" | otherwise = biOpt (/) Div a b - fromRational = fromDouble . fromRational + fromRational = fromDouble . fromRational instance Floating E where pi = fromDouble pi@@ -74,26 +89,26 @@ enumError :: String -> a enumError name = error $ name ++ " -- is defined only for literals"- + instance Enum E where succ = (+1) pred = \x -> x - 1 toEnum = fromDouble . fromIntegral- fromEnum = error "fromEnum is not defined for Csound values" - enumFrom a = a : enumFrom (a+1) + fromEnum = error "fromEnum is not defined for Csound values"+ enumFrom a = a : enumFrom (a+1) enumFromThen a b = a : enumFromThen (a + b) b- + enumFromTo a b = case (toNumOpt a, toNumOpt b) of (Left x, Left y) -> fmap fromDouble $ enumFromTo x y _ -> enumError "[a .. b]"- + enumFromThenTo a b c = case (toNumOpt a, toNumOpt b, toNumOpt c) of (Left x, Left y, Left z) -> fmap fromDouble $ enumFromThenTo x y z _ -> enumError "[a, b .. c]"- - ++ instance Real E where toRational = error "instance of the Real is not defined for Csound values. It's here only for other classes."- + instance Integral E where quot a b = intE $ (intE a) / (intE b) rem a b = (a `quot` b) * b - a@@ -107,7 +122,7 @@ -- Optimizations for constants -- -- If an arithmetic expression contains constants we can execute--- it and render as constant. We check wether all arguments +-- it and render as constant. We check wether all arguments -- are constants. If it's so we apply some numeric function and -- propogate a constant value. @@ -117,7 +132,7 @@ _ -> Right x fromNumOpt :: Either Double E -> E-fromNumOpt = either (prim . PrimDouble) id +fromNumOpt = either (prim . PrimDouble) id expNum :: NumExp E -> E expNum = noRate . ExpNum . fmap toPrimOr@@ -140,13 +155,13 @@ where noOpt2 x y = expNum $ PreInline op [x, y] doubleToInt :: (Double -> Int) -> (E -> E) -> E -> E-doubleToInt fun = unOpt (fromIntegral . fun) +doubleToInt fun = unOpt (fromIntegral . fun) -- arithmetic mod' :: E -> E -> E mod' = biOpt (\a b -> fromIntegral $ mod (floor a :: Int) (floor b)) Mod- + -- other functions ceilE, floorE, fracE, intE, roundE :: E -> E@@ -154,6 +169,6 @@ ceilE = doubleToInt ceiling (opr1 "ceil") floorE = doubleToInt floor (opr1 "floor") roundE = doubleToInt round (opr1 "round")-fracE = unOpt (snd . (properFraction :: (Double -> (Int, Double)))) (opr1 "frac") +fracE = unOpt (snd . (properFraction :: (Double -> (Int, Double)))) (opr1 "frac") intE = doubleToInt truncate (opr1 "int")
src/Csound/Dynamic/Types/Dep.hs view
@@ -1,3 +1,4 @@+{-# Language CPP #-} -- | Dependency tracking module Csound.Dynamic.Types.Dep( DepT(..), LocalHistory(..), runDepT, execDepT, evalDepT,@@ -17,7 +18,10 @@ initMacrosDouble, initMacrosString, initMacrosInt ) where +#if __GLASGOW_HASKELL__ < 710 import Control.Applicative+#endif+ import Control.Monad.Trans.Class import Control.Monad.Trans.State.Strict import Control.Monad(ap, liftM, zipWithM_)
src/Csound/Dynamic/Types/Exp.hs view
@@ -2,7 +2,9 @@ {-# Language DeriveFunctor, DeriveFoldable, DeriveTraversable, DeriveGeneric,- TypeSynonymInstances, FlexibleInstances #-}+ TypeSynonymInstances, FlexibleInstances,+ TemplateHaskell,+ CPP #-} module Csound.Dynamic.Types.Exp( E, RatedExp(..), isEmptyExp, RatedVar, ratedVar, ratedVarRate, ratedVarId, ratedExp, noRate, withRate, setRate,@@ -18,7 +20,9 @@ IsArrInit, ArrSize, ArrIndex ) where +#if __GLASGOW_HASKELL__ < 710 import Control.Applicative+#endif import GHC.Generics (Generic) import Data.Traversable@@ -263,7 +267,7 @@ where head' xs = case xs of [] -> Nothing- x:_ -> Just x+ value:_ -> Just value -- Primitive values data Prim@@ -392,6 +396,4 @@ -- separate p-param for strings (we need it to read strings from global table) -- Csound doesn't permits us to use more than four string params so we need to -- keep strings in the global table and use `strget` to read them--
src/Csound/Dynamic/Types/Flags.hs view
@@ -1,3 +1,4 @@+{-# Language CPP #-} -- | Csound's command line flags. See original documentation for detailed overview: <http://www.csounds.com/manual/html/CommandFlagsCategory.html> module Csound.Dynamic.Types.Flags( Flags(..),@@ -51,21 +52,37 @@ instance Default Flags where def = Flags def def def def def def def def def def ++#if MIN_VERSION_base(4,11,0)+instance Semigroup Flags where+ x <> y = x `mappendFlags` y+ instance Monoid Flags where- mempty = def- mappend a b = Flags- { audioFileOutput = mappend (audioFileOutput a) (audioFileOutput b)- , idTags = mappend (idTags a) (idTags b)- , rtaudio = rtaudio a <|> rtaudio b- , pulseAudio = pulseAudio a <|> pulseAudio b- , midiIO = mappend (midiIO a) (midiIO b)- , midiRT = mappend (midiRT a) (midiRT b)- , rtmidi = rtmidi a <|> rtmidi b- , displays = mappend (displays a) (displays b)- , config = mappend (config a) (config b)- , flagsVerbatim = mappend (flagsVerbatim a) (flagsVerbatim b)- }+ mempty = def +#else++instance Monoid Flags where+ mempty = def+ mappend = mappendFlags++#endif++mappendFlags :: Flags -> Flags -> Flags+mappendFlags a b = Flags+ { audioFileOutput = mappend (audioFileOutput a) (audioFileOutput b)+ , idTags = mappend (idTags a) (idTags b)+ , rtaudio = rtaudio a <|> rtaudio b+ , pulseAudio = pulseAudio a <|> pulseAudio b+ , midiIO = mappend (midiIO a) (midiIO b)+ , midiRT = mappend (midiRT a) (midiRT b)+ , rtmidi = rtmidi a <|> rtmidi b+ , displays = mappend (displays a) (displays b)+ , config = mappend (config a) (config b)+ , flagsVerbatim = mappend (flagsVerbatim a) (flagsVerbatim b)+ }++ -- Audio file output data AudioFileOutput = AudioFileOutput@@ -81,17 +98,31 @@ instance Default AudioFileOutput where def = AudioFileOutput def def def def False False def +#if MIN_VERSION_base(4,11,0)+instance Semigroup AudioFileOutput where+ x <> y = x `mappendAudioFileOutput` y+ instance Monoid AudioFileOutput where- mempty = def- mappend a b = AudioFileOutput- { formatSamples = formatSamples a <|> formatSamples b- , formatType = formatType a <|> formatType b- , output = output a <|> output b- , input = input a <|> input b- , nosound = mappendBool (nosound a) (nosound b)- , nopeaks = mappendBool (nopeaks a) (nopeaks b)- , dither = dither a <|> dither b }+ mempty = def +#else++instance Monoid AudioFileOutput where+ mempty = def+ mappend = mappendAudioFileOutput++#endif++mappendAudioFileOutput :: AudioFileOutput -> AudioFileOutput -> AudioFileOutput+mappendAudioFileOutput a b = AudioFileOutput+ { formatSamples = formatSamples a <|> formatSamples b+ , formatType = formatType a <|> formatType b+ , output = output a <|> output b+ , input = input a <|> input b+ , nosound = mappendBool (nosound a) (nosound b)+ , nopeaks = mappendBool (nopeaks a) (nopeaks b)+ , dither = dither a <|> dither b }+ data FormatHeader = NoHeader | RewriteHeader deriving (Eq, Show, Read) @@ -124,16 +155,30 @@ instance Default IdTags where def = IdTags def def def def def def +#if MIN_VERSION_base(4,11,0)+instance Semigroup IdTags where+ x <> y = x `mappendIdTags` y+ instance Monoid IdTags where- mempty = def- mappend a b = IdTags- { idArtist = idArtist a <|> idArtist b- , idComment = idComment a <|> idComment b- , idCopyright = idCopyright a <|> idCopyright b- , idDate = idDate a <|> idDate b- , idSoftware = idSoftware a <|> idSoftware b- , idTitle = idTitle a <|> idTitle b }+ mempty = def +#else++instance Monoid IdTags where+ mempty = def+ mappend = mappendIdTags++#endif++mappendIdTags :: IdTags -> IdTags -> IdTags+mappendIdTags a b = IdTags+ { idArtist = idArtist a <|> idArtist b+ , idComment = idComment a <|> idComment b+ , idCopyright = idCopyright a <|> idCopyright b+ , idDate = idDate a <|> idDate b+ , idSoftware = idSoftware a <|> idSoftware b+ , idTitle = idTitle a <|> idTitle b }+ -- Realtime Audio Input/Output data Rtaudio@@ -165,15 +210,30 @@ instance Default MidiIO where def = MidiIO def def def False False ++#if MIN_VERSION_base(4,11,0)+instance Semigroup MidiIO where+ x <> y = x `mappendMidiIO` y+ instance Monoid MidiIO where- mempty = def- mappend a b = MidiIO- { midiFile = midiFile a <|> midiFile b- , midiOutFile = midiOutFile a <|> midiOutFile b- , muteTracks = muteTracks a <|> muteTracks b- , rawControllerMode = mappendBool (rawControllerMode a) (rawControllerMode b)- , terminateOnMidi = mappendBool (terminateOnMidi a) (terminateOnMidi b) }+ mempty = def +#else++instance Monoid MidiIO where+ mempty = def+ mappend = mappendMidiIO++#endif++mappendMidiIO :: MidiIO -> MidiIO -> MidiIO+mappendMidiIO a b = MidiIO+ { midiFile = midiFile a <|> midiFile b+ , midiOutFile = midiOutFile a <|> midiOutFile b+ , muteTracks = muteTracks a <|> muteTracks b+ , rawControllerMode = mappendBool (rawControllerMode a) (rawControllerMode b)+ , terminateOnMidi = mappendBool (terminateOnMidi a) (terminateOnMidi b) }+ -- MIDI Realtime Input/Ouput data MidiRT = MidiRT@@ -191,18 +251,32 @@ def = MidiRT def def def def def def def def +#if MIN_VERSION_base(4,11,0)+instance Semigroup MidiRT where+ x <> y = x `mappendMidiRT` y+ instance Monoid MidiRT where- mempty = def- mappend a b = MidiRT- { midiDevice = midiDevice a <|> midiDevice b- , midiKey = midiKey a <|> midiKey b- , midiKeyCps = midiKeyCps a <|> midiKeyCps b- , midiKeyOct = midiKeyOct a <|> midiKeyOct b- , midiKeyPch = midiKeyPch a <|> midiKeyPch b- , midiVelocity = midiVelocity a <|> midiVelocity b- , midiVelocityAmp = midiVelocityAmp a <|> midiVelocityAmp b- , midiOutDevice = midiOutDevice a <|> midiOutDevice b }+ mempty = def +#else++instance Monoid MidiRT where+ mempty = def+ mappend = mappendMidiRT++#endif++mappendMidiRT :: MidiRT -> MidiRT -> MidiRT+mappendMidiRT a b = MidiRT+ { midiDevice = midiDevice a <|> midiDevice b+ , midiKey = midiKey a <|> midiKey b+ , midiKeyCps = midiKeyCps a <|> midiKeyCps b+ , midiKeyOct = midiKeyOct a <|> midiKeyOct b+ , midiKeyPch = midiKeyPch a <|> midiKeyPch b+ , midiVelocity = midiVelocity a <|> midiVelocity b+ , midiVelocityAmp = midiVelocityAmp a <|> midiVelocityAmp b+ , midiOutDevice = midiOutDevice a <|> midiOutDevice b }+ data Rtmidi = PortMidi | AlsaMidi | AlsaSeq | CoreMidi | MmeMidi | WinmmeMidi | VirtualMidi | NoRtmidi deriving (Eq, Show, Read) @@ -234,23 +308,38 @@ False False def +#if MIN_VERSION_base(4,11,0)+instance Semigroup Displays where+ x <> y = x `mappendDisplays` y+ instance Monoid Displays where- mempty = def- mappend a b = Displays- { csdLineNums = csdLineNums a <|> csdLineNums b- , displayMode = displayMode a <|> displayMode b- , displayHeartbeat = displayHeartbeat a <|> displayHeartbeat b- , messageLevel = messageLevel a <|> messageLevel b- , mAmps = mAmps a <|> mAmps b- , mRange = mRange a <|> mRange b- , mWarnings = mWarnings a <|> mWarnings b- , mDb = mDb a <|> mDb b- , mColours = mColours a <|> mColours b- , mBenchmarks = mBenchmarks a <|> mBenchmarks b- , msgColor = mappendBool (msgColor a) (msgColor b)- , displayVerbose = mappendBool (displayVerbose a) (displayVerbose b)- , listOpcodes = listOpcodes a <|> listOpcodes b }+ mempty = def +#else++instance Monoid Displays where+ mempty = def+ mappend = mappendDisplays++#endif+++mappendDisplays :: Displays -> Displays -> Displays+mappendDisplays a b = Displays+ { csdLineNums = csdLineNums a <|> csdLineNums b+ , displayMode = displayMode a <|> displayMode b+ , displayHeartbeat = displayHeartbeat a <|> displayHeartbeat b+ , messageLevel = messageLevel a <|> messageLevel b+ , mAmps = mAmps a <|> mAmps b+ , mRange = mRange a <|> mRange b+ , mWarnings = mWarnings a <|> mWarnings b+ , mDb = mDb a <|> mDb b+ , mColours = mColours a <|> mColours b+ , mBenchmarks = mBenchmarks a <|> mBenchmarks b+ , msgColor = mappendBool (msgColor a) (msgColor b)+ , displayVerbose = mappendBool (displayVerbose a) (displayVerbose b)+ , listOpcodes = listOpcodes a <|> listOpcodes b }+ -- Performance Configuration and Control data Config = Config@@ -273,21 +362,35 @@ False def def def def +#if MIN_VERSION_base(4,11,0)+instance Semigroup Config where+ x <> y = x `mappendConfig` y+ instance Monoid Config where- mempty = def- mappend a b = Config- { hwBuf = hwBuf a <|> hwBuf b- , ioBuf = ioBuf a <|> ioBuf b- , newKr = newKr a <|> newKr b- , newSr = newSr a <|> newSr b- , scoreIn = scoreIn a <|> scoreIn b- , omacro = omacro a <|> omacro b- , smacro = smacro a <|> smacro b- , setSched = mappendBool (setSched a) (setSched b)- , schedNum = schedNum a <|> schedNum b- , strsetN = strsetN a <|> strsetN b- , skipSeconds = skipSeconds a <|> skipSeconds b- , setTempo = setTempo a <|> setTempo b }+ mempty = def++#else++instance Monoid Config where+ mempty = def+ mappend = mappendConfig++#endif++mappendConfig :: Config -> Config -> Config+mappendConfig a b = Config+ { hwBuf = hwBuf a <|> hwBuf b+ , ioBuf = ioBuf a <|> ioBuf b+ , newKr = newKr a <|> newKr b+ , newSr = newSr a <|> newSr b+ , scoreIn = scoreIn a <|> scoreIn b+ , omacro = omacro a <|> omacro b+ , smacro = smacro a <|> smacro b+ , setSched = mappendBool (setSched a) (setSched b)+ , schedNum = schedNum a <|> schedNum b+ , strsetN = strsetN a <|> strsetN b+ , skipSeconds = skipSeconds a <|> skipSeconds b+ , setTempo = setTempo a <|> setTempo b } ---------------------------------------------------- -- rendering