csound-expression-dynamic 0.3.0 → 0.3.2

raw patch · 9 files changed

+244/−230 lines, 9 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• csound-expression-dynamic.cabal +9/−8
• src/Csound/Dynamic/Build.hs +18/−18
• src/Csound/Dynamic/Render.hs +5/−5
• src/Csound/Dynamic/Render/Instr.hs +47/−47
• src/Csound/Dynamic/Types.hs +1/−1
• src/Csound/Dynamic/Types/CsdFile.hs +3/−3
• src/Csound/Dynamic/Types/Dep.hs +19/−19
• src/Csound/Dynamic/Types/Exp.hs +73/−73
• src/Csound/Dynamic/Types/Flags.hs +69/−56

@@ -1,5 +1,5 @@ Name:          csound-expression-dynamic-Version:       0.3.0+Version:       0.3.2 Cabal-Version: >= 1.6 License:       BSD3 License-file:  LICENSE@@ -11,7 +11,7 @@ Category:      Music, Sound Maintainer:    <anton.kholomiov@gmail.com> -Description:   +Description:  Homepage:        https://github.com/anton-k/csound-expression-dynamic Bug-Reports:     https://github.com/anton-k/csound-expression-dynamic/issues@@ -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,         Boolean >= 0.1.0, data-fix, data-fix-cse >= 0.0.2, hashable   Hs-Source-Dirs:      src/   Exposed-Modules:@@ -34,21 +34,22 @@     Csound.Dynamic.Types.Exp     Csound.Dynamic.Types.Dep     Csound.Dynamic.Types.CsdFile-    Csound.Dynamic.Types.Flags    +    Csound.Dynamic.Types.Flags      Csound.Dynamic.Build     Csound.Dynamic.Build.Numeric     Csound.Dynamic.Build.Logic      Csound.Dynamic.Render-  ++    Csound.Dynamic.Render.Instr+    Csound.Dynamic.Render.Pretty   Other-Modules:     Csound.Dynamic.Tfm.DeduceTypes     Csound.Dynamic.Tfm.Liveness     Csound.Dynamic.Tfm.UnfoldMultiOuts-    Csound.Dynamic.Render.Pretty-    Csound.Dynamic.Render.Instr-     ++   

@@ -1,8 +1,8 @@ module Csound.Dynamic.Build (-    +     -- * Expression tree     -- | Working with expression tree-    toExp, onExp, +    toExp, onExp,      -- * Rates     -- * Queries@@ -10,7 +10,7 @@      -- * Constructors     -- | Basic constructors-    prim, opcPrefix, oprPrefix, oprInfix, +    prim, opcPrefix, oprPrefix, oprInfix,     numExp1, numExp2,     tfm, tfmNoInlineArgs, pn, withInits,     double, int, str, verbatim, instrIdE,@@ -18,7 +18,7 @@      -- ** Opcodes constructors     Spec1, spec1, opcs, opcsNoInlineArgs, opr1, opr1k, infOpr, oprBy,-    Specs, specs, MultiOut, mopcs, mo, +    Specs, specs, MultiOut, mopcs, mo,      -- * Global init statements     setSr, setKsmps, setNchnls, setNchnls_i, setKr, setZeroDbfs,@@ -37,9 +37,9 @@  ------------------------------------------------ -- basic constructors-  + prim :: Prim -> E-prim = noRate . ExpPrim +prim = noRate . ExpPrim  opcPrefix :: Name -> Signature -> Info opcPrefix name signature = Info name signature Opcode@@ -65,8 +65,8 @@  tfmNoInlineArgs :: Info -> [E] -> E tfmNoInlineArgs info args = noRate $ Tfm info $ fmap (PrimOr . Right) args-            -inlineVar :: Var -> E        ++inlineVar :: Var -> E inlineVar = Fix . RatedExp Nothing Nothing . ReadVar  pn :: Int -> E@@ -131,7 +131,7 @@ infOpr name a b = tfm (oprInfix name $ spec1 [(Ar, [Ar, Ar]), (Kr, [Kr, Kr]), (Ir, [Ir, Ir])]) [a, b]  numExp1 :: NumOp -> E -> E-numExp1 op x = noRate $ ExpNum $ fmap toPrimOr $ PreInline op [x] +numExp1 op x = noRate $ ExpNum $ fmap toPrimOr $ PreInline op [x]  numExp2 :: NumOp -> E -> E -> E numExp2 op a b = noRate $ ExpNum $ fmap toPrimOr $ PreInline op [a, b]@@ -148,22 +148,22 @@ type Specs = ([Rate], [Rate])  specs :: Specs -> Signature-specs = uncurry MultiRate +specs = uncurry MultiRate  mopcs :: Name -> Specs -> [E] -> MultiOut [E] mopcs name signature as = \numOfOuts -> mo numOfOuts $ tfm (opcPrefix name $ specs signature) as  mo :: Int -> E -> [E] mo n e = zipWith (\cellId r -> select cellId r e') [0 ..] outRates-    where outRates = take n $ getRates $ toExp e          +    where outRates = take n $ getRates $ toExp e           e' = onExp (setMultiRate outRates) e-          -          setMultiRate rates (Tfm info xs) = Tfm (info{ infoSignature = MultiRate rates ins }) xs ++          setMultiRate rates (Tfm info xs) = Tfm (info{ infoSignature = MultiRate rates ins }) xs               where ins = case infoSignature info of                         MultiRate _ a -> a-                        _ -> error "Tuple.hs: multiOutsSection -- should be multiOut expression" -          setMultiRate _ _ = error "Tuple.hs: multiOutsSection -- argument should be Tfm-expression"  -            +                        _ -> error "Tuple.hs: multiOutsSection -- should be multiOut expression"+          setMultiRate _ _ = error "Tuple.hs: multiOutsSection -- argument should be Tfm-expression"+           select cellId rate expr = withRate rate $ Select rate cellId (PrimOr $ Right expr)  @@ -173,7 +173,7 @@     _ -> error "Build.hs:getRates - argument should be multiOut" getRates _ = error "Build.hs:getRates - argument should be Tfm-expression" -    + isMultiOutSignature :: Signature -> Bool isMultiOutSignature x = case x of     MultiRate _ _ -> True@@ -198,7 +198,7 @@ -- global inits  setSr, setKsmps, setNchnls, setNchnls_i, setKr :: Monad m => Int -> DepT m ()-    + setZeroDbfs :: Monad m => Double -> DepT m  ()  setGlobal :: (Monad m, Show a) => String -> a -> DepT m  ()

@@ -1,5 +1,5 @@ module Csound.Dynamic.Render(-    renderCsd      +    renderCsd ) where  import qualified Text.PrettyPrint.Leijen as P@@ -9,7 +9,7 @@ import Csound.Dynamic.Types  renderCsd :: Csd -> String-renderCsd a = show $ ppCsdFile +renderCsd a = show $ ppCsdFile     (renderFlags $ csdFlags a)     (renderOrc $ csdOrc a)     (renderSco   $ csdSco a)@@ -25,8 +25,8 @@         instrExprs  = fmap renderInstr (orcInstruments a)  renderSco :: Sco -> Doc-renderSco a = vcatSep +renderSco a = vcatSep     [ P.vcat $ fmap (uncurry ppGen)   $ scoGens a-    , maybe P.empty ppTotalDur $ scoTotalDur a    -    , P.vcat $ fmap (uncurry ppNotes) $ scoNotes a ]    +    , maybe P.empty ppTotalDur $ scoTotalDur a+    , P.vcat $ fmap (uncurry ppNotes) $ scoNotes a ] 

@@ -1,6 +1,6 @@ module Csound.Dynamic.Render.Instr(     renderInstr, renderInstrBody-) where +) where  import Control.Arrow(second) import Control.Monad.Trans.State.Strict@@ -27,17 +27,17 @@ renderInstr a = ppInstr (instrName a) $ renderInstrBody (instrBody a)  renderInstrBody :: E -> Doc-renderInstrBody a +renderInstrBody a   | null dag  = P.empty   | otherwise = render dag-    where +    where       dag = toDag a-      render = P.vcat . flip evalState 0 . mapM (uncurry ppStmt . clearEmptyResults) . collectRates +      render = P.vcat . flip evalState 0 . mapM (uncurry ppStmt . clearEmptyResults) . collectRates  ------------------------------------------------------------- -- E -> Dag -toDag :: E -> Dag RatedExp +toDag :: E -> Dag RatedExp toDag expr = filterDepCases $ fromDag $ cseFramed getFrameInfo $ trimByArgLength expr  getFrameInfo :: RatedExp a -> FrameInfo@@ -45,14 +45,14 @@     -- Imperative If-then-else     IfBegin _ _   -> StartFrame --     ElseIfBegin _ -> NextFrame-    ElseBegin     -> NextFrame +    ElseBegin     -> NextFrame     IfEnd         -> StopFrame     -- looping constructions     UntilBegin _ -> StartFrame     UntilEnd     -> StopFrame     WhileBegin _ -> StartFrame     WhileRefBegin _ -> StartFrame-    WhileEnd     -> StopFrame    +    WhileEnd     -> StopFrame     _            -> NoFrame  @@ -63,16 +63,16 @@             _ -> x           trimInfo signature args = case signature of             SingleRate tab -> SingleRate $ fmap trim tab-            MultiRate outs ins -> MultiRate outs (trim ins)        -            where trim = take (length args)    -                  +            MultiRate outs ins -> MultiRate outs (trim ins)+            where trim = take (length args)+ clearEmptyResults :: ([RatedVar], Exp RatedVar) -> ([RatedVar], Exp RatedVar) clearEmptyResults (res, expr) = (filter ((/= Xr) . ratedVarRate) res, expr)-        + collectRates :: Dag RatedExp -> [([RatedVar], Exp RatedVar)] collectRates dag = fmap (second ratedExpExp) res2     where res2 = liveness lastFreshId1 res1-          (res1, lastFreshId1)= unfoldMultiOuts unfoldSpec lastFreshId dag1  +          (res1, lastFreshId1)= unfoldMultiOuts unfoldSpec lastFreshId dag1           (dag1, lastFreshId) = rateGraph dag  -----------------------------------------------------------@@ -94,13 +94,13 @@      where (stmts, lastId) = deduceTypes algSpec dag            algSpec = TypeGraph mkConvert' defineType' -           mkConvert' a = (to, RatedExp Nothing Nothing $ +           mkConvert' a = (to, RatedExp Nothing Nothing $                    ConvertRate (ratedVarRate to) (ratedVarRate from) $ PrimOr $ Right from)                where from = convertFrom a                      to   = convertTo   a             defineType' (outVar, expr) desiredRates = (ratesForConversion, (outVar', expr'))-               where possibleRate = deduceRate desiredRates expr +               where possibleRate = deduceRate desiredRates expr                      ratesForConversion = filter (not . flip coherentRates possibleRate) desiredRates                      expr' = RatedExp Nothing Nothing $ rateExp possibleRate $ ratedExpExp expr                      outVar' = ratedVar possibleRate outVar@@ -108,21 +108,21 @@ ---------------------------------------------------------- -- unfolds multiple rates -unfoldSpec :: UnfoldMultiOuts RatedExp Rate +unfoldSpec :: UnfoldMultiOuts RatedExp Rate unfoldSpec = UnfoldMultiOuts getSelector' getParentTypes'     where getSelector' x = case ratedExpExp x of-                Select _ order (PrimOr (Right parent)) -> Just $ Selector parent order +                Select _ order (PrimOr (Right parent)) -> Just $ Selector parent order                 _ -> Nothing           getParentTypes' x = case ratedExpExp x of-                Tfm i _ -> if (isMultiOutSignature $ infoSignature i) -                           then Just (getRates $ ratedExpExp x) -                           else Nothing +                Tfm i _ -> if (isMultiOutSignature $ infoSignature i)+                           then Just (getRates $ ratedExpExp x)+                           else Nothing                 _ -> Nothing  coherentRates :: Rate -> Rate -> Bool coherentRates to from = case (to, from) of     (a, b)  | a == b    -> True-    (Xr, _)             -> True   +    (Xr, _)             -> True     (Kr, Ir)            -> True     _                   -> False @@ -131,22 +131,22 @@     ExpPrim _ -> case desiredRates of         [Sr] -> Sr         _ -> Ir-       +     Tfm info _ -> case infoSignature info of         MultiRate _ _ -> Xr-        SingleRate tab -> +        SingleRate tab ->             let r1 = tfmNoRate (infoName info) desiredRates tab             in  case ratedExpRate expr of                     Just r | M.member r tab -> r                     Just _ -> r1                     Nothing -> r1-                        +     ExpNum _ -> case ratedExpRate expr of         Just r  -> r         Nothing -> case maximum (Ar : desiredRates) of             Xr -> Ar             r -> r-    +     Select rate _ _ -> rate     If _ _ _ -> case head $ sort desiredRates of         Xr -> Ar@@ -156,27 +156,27 @@     ReadMacrosString _ -> Sr     ReadMacrosDouble _ -> Ir     ReadMacrosInt _ -> Ir-    _  -> Xr    +    _  -> Xr     where tfmNoRate name rates tab = case sort rates of-              [Xr]  -> tfmNoRate name [Ar] tab                +              [Xr]  -> tfmNoRate name [Ar] tab               Xr:as -> tfmNoRate name as tab-              as | any (== Ir) as  -> fromJust $ find (flip M.member tab) (Ir : as ++ [minBound .. maxBound])         -              as -> fromJust $ find (flip M.member tab) (as ++ [minBound .. maxBound])         +              as | any (== Ir) as  -> fromJust $ find (flip M.member tab) (Ir : as ++ [minBound .. maxBound])+              as -> fromJust $ find (flip M.member tab) (as ++ [minBound .. maxBound]) -rateExp :: Rate -> Exp Int -> Exp RatedVar +rateExp :: Rate -> Exp Int -> Exp RatedVar rateExp curRate expr = case expr of     ExpPrim (P n) | curRate == Sr -> ExpPrim (PString n)     Tfm i xs -> Tfm i $ mergeWithPrimOr (ratesFromSignature curRate (infoSignature i)) xs-    Select rate pid a -> Select rate pid (fmap (ratedVar Xr) a)    -    If p t e -> If (rec2 condRate p) (rec1 curRate t) (rec1 curRate e) -    ExpNum _ -> rec2 curRate expr    -    +    Select rate pid a -> Select rate pid (fmap (ratedVar Xr) a)+    If p t e -> If (rec2 condRate p) (rec1 curRate t) (rec1 curRate e)+    ExpNum _ -> rec2 curRate expr+     ReadVar v -> ReadVar v     WriteVar v a -> WriteVar v $ rec1 (varRate v) a-    InitVar v a -> InitVar v $ rec1 Ir a -- rec1 (varRate v) a    -    +    InitVar v a -> InitVar v $ rec1 Ir a -- rec1 (varRate v) a+     ReadArr v as -> ReadArr v $ arrIndex v as-    WriteArr v as b -> WriteArr v (arrIndex v as) (rec1 (varRate v) b)    +    WriteArr v as b -> WriteArr v (arrIndex v as) (rec1 (varRate v) b)     WriteInitArr v as b -> WriteInitArr v (arrIndex v as) (rec1 Ir b)     InitArr v as -> InitArr v $ fmap (rec1 Ir) as     TfmArr isInit v i xs -> TfmArr isInit v i $ mergeWithPrimOr (ratesFromSignature curRate (infoSignature i)) xs@@ -184,14 +184,14 @@     ExpPrim p -> ExpPrim p     IfBegin rootRate _ -> rec2 rootRate expr     UntilBegin _ -> rec2 condRate expr-    WhileBegin _ -> rec2 condRate expr    +    WhileBegin _ -> rec2 condRate expr     WhileRefBegin var -> WhileRefBegin var --    ElseIfBegin _ -> rec2 condRate expr     ElseBegin -> ElseBegin     IfEnd -> IfEnd     UntilEnd -> UntilEnd-    WhileEnd -> WhileEnd    -    EmptyExp -> EmptyExp    +    WhileEnd -> WhileEnd+    EmptyExp -> EmptyExp     Verbatim a -> Verbatim a     InitMacrosString name initValue -> InitMacrosString name initValue     InitMacrosDouble name initValue -> InitMacrosDouble name initValue@@ -199,30 +199,30 @@     ReadMacrosDouble name -> ReadMacrosDouble name     ReadMacrosInt name -> ReadMacrosInt name     ExpBool _           -> error $ msg "ExpBool expression should be substituted"-    ConvertRate _ _ _   -> error $ msg "ConvertRate couldn't be here. It's introduced on the later stages of processing" +    ConvertRate _ _ _   -> error $ msg "ConvertRate couldn't be here. It's introduced on the later stages of processing"     where ratesFromSignature rate signature = case signature of               SingleRate table -> table M.! rate               MultiRate _ rs   -> rs            condRate :: Rate           condRate = max Kr curRate -- Kr-          -          rec2 r = fmap (fmap (ratedVar r))  ++          rec2 r = fmap (fmap (ratedVar r))           rec1 r = fmap (ratedVar r)            arrIndex v as = fmap (rec1 (arrIndexVarRate v)) as -          msg txt = "Csound.Dynamic.Render.Instr.rateExp: " ++ txt -         -arrIndexVarRate v = case varRate v of    +          msg txt = "Csound.Dynamic.Render.Instr.rateExp: " ++ txt++arrIndexVarRate v = case varRate v of     Ir -> Ir     _  -> Kr  mergeWithPrimOr :: [Rate] -> [PrimOr Int] -> [PrimOr (Var Rate)] mergeWithPrimOr = zipWith phi-    where +    where         phi r (PrimOr x) = PrimOr $ case x of-            Left  p -> Left $ updateVarTargetRate r p +            Left  p -> Left $ updateVarTargetRate r p             Right n -> Right $ ratedVar r n         updateVarTargetRate r p = case p of             PrimVar _ v -> PrimVar r v

@@ -5,7 +5,7 @@     module Csound.Dynamic.Types.Flags,     module Csound.Dynamic.Types.CsdFile -) where +) where  import Csound.Dynamic.Types.Exp import Csound.Dynamic.Types.Dep

@@ -1,5 +1,5 @@ -- | The Csound file-module Csound.Dynamic.Types.CsdFile(            +module Csound.Dynamic.Types.CsdFile(     Csd(..), Flags, Orc(..), Sco(..), Plugin(..), Instr(..), InstrBody,     CsdEvent, csdEventStart, csdEventDur, csdEventContent, csdEventTotalDur,     intInstr, alwaysOn@@ -14,7 +14,7 @@     , csdOrc     :: Orc     , csdSco     :: Sco     , csdPlugins :: [Plugin]-    } +    }  data Orc = Orc     { orcHead           :: InstrBody@@ -28,7 +28,7 @@     , instrBody :: InstrBody     } -data Sco = Sco +data Sco = Sco     { scoTotalDur   :: Maybe Double     , scoGens       :: [(Int, Gen)]     , scoNotes      :: [(InstrId, [CsdEvent])]  }

@@ -1,8 +1,8 @@ -- | Dependency tracking module Csound.Dynamic.Types.Dep(-    DepT(..), LocalHistory(..), runDepT, execDepT, evalDepT,   +    DepT(..), LocalHistory(..), runDepT, execDepT, evalDepT,     -- * Dependencies-    depT, depT_, mdepT, stripDepT, stmtOnlyT, +    depT, depT_, mdepT, stripDepT, stmtOnlyT,      -- * Variables     newLocalVar, newLocalVars,@@ -12,8 +12,8 @@     newLocalArrVar, newTmpArrVar,     readArr, readOnlyArr, writeArr, writeInitArr, initArr, appendArrBy, -    -- * Read macros    -    readMacrosDouble, readMacrosInt, readMacrosString, +    -- * Read macros+    readMacrosDouble, readMacrosInt, readMacrosString,     initMacrosDouble, initMacrosString, initMacrosInt ) where @@ -27,10 +27,10 @@  import Csound.Dynamic.Types.Exp --- | Csound's synonym for 'IO'-monad. 'Dep' means Side Effect. +-- | Csound's synonym for 'IO'-monad. 'Dep' means Side Effect. -- You will bump into 'Dep' trying to read and write to delay lines,--- making random signals or trying to save your audio to file. --- Instrument is expected to return a value of @Dep [Sig]@. +-- making random signals or trying to save your audio to file.+-- Instrument is expected to return a value of @Dep [Sig]@. -- So it's okay to do some side effects when playing a note. newtype DepT m a = DepT { unDepT :: StateT LocalHistory m a } @@ -43,7 +43,7 @@     def = LocalHistory start 0 0  instance Monad m => Functor (DepT m) where-    fmap = liftM +    fmap = liftM  instance Monad m => Applicative (DepT m) where     pure = return@@ -61,7 +61,7 @@  evalDepT :: (Functor m, Monad m) => DepT m a -> m a evalDepT a = evalStateT (unDepT $ a) def-   + execDepT :: (Functor m, Monad m) => DepT m () -> m E execDepT a = fmap expDependency $ execStateT (unDepT $ a) def @@ -80,10 +80,10 @@ depT a = DepT $ do     s <- get     let a1 = Fix $ (unFix a) { ratedExpDepends = Just (newLineNum s) }-    put $ s { -        newLineNum = succ $ newLineNum s, +    put $ s {+        newLineNum = succ $ newLineNum s,         expDependency = depends (expDependency s) a1 }-    return a1    +    return a1  depT_ :: (Monad m) => E -> DepT m () depT_ = fmap (const ()) . depT@@ -92,13 +92,13 @@ mdepT mas = \n -> mapM depT $ ( $ n) mas  stripDepT :: Monad m => DepT m a -> m a-stripDepT (DepT a) = evalStateT a def +stripDepT (DepT a) = evalStateT a def  stmtOnlyT :: Monad m => Exp E -> DepT m () stmtOnlyT stmt = depT_ $ noRate stmt -emptyE :: E -emptyE = noRate $ EmptyExp +emptyE :: E+emptyE = noRate $ EmptyExp  -- local variables @@ -117,7 +117,7 @@ newVar :: Monad m => Rate -> DepT m Var newVar rate = DepT $ do     s <- get-    let v = Var LocalVar rate (show $ newLocalVarId s)    +    let v = Var LocalVar rate (show $ newLocalVarId s)     put $ s { newLocalVarId = succ $ newLocalVarId s }     return v @@ -127,7 +127,7 @@ -- generic funs  writeVar :: Monad m => Var -> E -> DepT m ()-writeVar v x = depT_ $ noRate $ WriteVar v $ toPrimOr x +writeVar v x = depT_ $ noRate $ WriteVar v $ toPrimOr x  readVar :: Monad m => Var -> DepT m E readVar v = depT $ noRate $ ReadVar v@@ -172,7 +172,7 @@ initArr :: Monad m => Var -> [E] -> DepT m () initArr v xs = depT_ $ noRate $ InitArr v $ fmap toPrimOr xs -appendArrBy :: Monad m => (E -> E -> E) -> Var -> [E] -> E -> DepT m () +appendArrBy :: Monad m => (E -> E -> E) -> Var -> [E] -> E -> DepT m () appendArrBy op v ixs x = writeArr v ixs . op x =<< readArr v ixs  --------------------------------------------------@@ -202,4 +202,4 @@ initMacrosBy :: Monad m => (String -> a -> Exp E) -> String -> a -> DepT m () initMacrosBy maker name value = depT_ $ noRate $ maker name value -   +

@@ -1,19 +1,19 @@ -- | Main types-{-# Language -        DeriveFunctor, DeriveFoldable, DeriveTraversable, -        DeriveGeneric, +{-# Language+        DeriveFunctor, DeriveFoldable, DeriveTraversable,+        DeriveGeneric,         TypeSynonymInstances, FlexibleInstances #-} module Csound.Dynamic.Types.Exp(-    E, RatedExp(..), isEmptyExp, RatedVar, ratedVar, ratedVarRate, ratedVarId, +    E, RatedExp(..), isEmptyExp, RatedVar, ratedVar, ratedVarRate, ratedVarId,     ratedExp, noRate, withRate, setRate,-    Exp, toPrimOr, toPrimOrTfm, PrimOr(..), MainExp(..), Name, +    Exp, toPrimOr, toPrimOrTfm, PrimOr(..), MainExp(..), Name,     InstrId(..), intInstrId, ratioInstrId, stringInstrId,-    VarType(..), Var(..), Info(..), OpcFixity(..), Rate(..), -    Signature(..), isInfix, isPrefix,    +    VarType(..), Var(..), Info(..), OpcFixity(..), Rate(..),+    Signature(..), isInfix, isPrefix,     Prim(..), Gen(..), GenId(..),     Inline(..), InlineExp(..), PreInline(..),-    BoolExp, CondInfo, CondOp(..), isTrue, isFalse,    -    NumExp, NumOp(..), Note,    +    BoolExp, CondInfo, CondOp(..), isTrue, isFalse,+    NumExp, NumOp(..), Note,     MultiOut,     IsArrInit, ArrSize, ArrIndex ) where@@ -31,19 +31,19 @@ import qualified Data.IntMap as IM import Data.Fix -import qualified Csound.Dynamic.Tfm.DeduceTypes as R(Var(..)) +import qualified Csound.Dynamic.Tfm.DeduceTypes as R(Var(..))  type Name = String type LineNum = Int  -- | An instrument identifier-data InstrId -    = InstrId +data InstrId+    = InstrId     { instrIdFrac :: Maybe Int     , instrIdCeil :: Int }-    | InstrLabel String +    | InstrLabel String     deriving (Show, Eq, Ord, Generic)-    + -- | Constructs an instrument id with the integer. intInstrId :: Int -> InstrId intInstrId n = InstrId Nothing n@@ -58,18 +58,18 @@  -- | The inner representation of csound expressions. type E = Fix RatedExp-    + instance Hashable E where     hashWithSalt s x = s `hashWithSalt` cata hash x -data RatedExp a = RatedExp -    { ratedExpRate      :: Maybe Rate       -        -- ^ Rate (can be undefined or Nothing, +data RatedExp a = RatedExp+    { ratedExpRate      :: Maybe Rate+        -- ^ Rate (can be undefined or Nothing,         -- it means that rate should be deduced automatically from the context)-    , ratedExpDepends   :: Maybe LineNum          +    , ratedExpDepends   :: Maybe LineNum         -- ^ Dependency (it is used for expressions with side effects,         -- value contains the privious statement)-    , ratedExpExp       :: Exp a    +    , ratedExpExp       :: Exp a         -- ^ Main expression     } deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic) @@ -93,7 +93,7 @@  noRate :: Exp E -> E noRate = ratedExp Nothing-  + withRate :: Rate -> Exp E -> E withRate r = ratedExp (Just r) @@ -115,7 +115,7 @@     ExpPrim p  -> Left p     ReadVar v | noDeps -> Left (PrimVar (varRate v) v)     _         -> Right a-    where +    where         noDeps = isNothing $ ratedExpDepends $ unFix a  -- | Constructs PrimOr values from the expressions. It does inlining in@@ -126,7 +126,7 @@     ExpPrim p | (r == Ir || r == Sr) -> Left p     ReadVar v | noDeps -> Left (PrimVar (varRate v) v)     _         -> Right a-    where +    where         noDeps = isNothing $ ratedExpDepends $ unFix a  @@ -134,18 +134,18 @@ type Exp a = MainExp (PrimOr a)  -- Csound expressions-data MainExp a     +data MainExp a     = EmptyExp     -- | Primitives     | ExpPrim Prim-    -- | Application of the opcode: we have opcode information (Info) and the arguments [a] +    -- | Application of the opcode: we have opcode information (Info) and the arguments [a]     | Tfm Info [a]     -- | Rate conversion     | ConvertRate Rate Rate a     -- | Selects a cell from the tuple, here argument is always a tuple (result of opcode that returns several outputs)     | Select Rate Int a     -- | if-then-else-    | If (CondInfo a) a a    +    | If (CondInfo a) a a     -- | Boolean expressions (rendered in infix notation in the Csound)     | ExpBool (BoolExp a)     -- | Numerical expressions (rendered in infix notation in the Csound)@@ -153,9 +153,9 @@     -- | Reading/writing a named variable     | InitVar Var a     | ReadVar Var-    | WriteVar Var a  +    | WriteVar Var a     -- | Arrays-    | InitArr Var (ArrSize a)    +    | InitArr Var (ArrSize a)     | ReadArr Var (ArrIndex a)     | WriteArr Var (ArrIndex a) a     | WriteInitArr Var (ArrIndex a) a@@ -184,7 +184,7 @@     | ReadMacrosInt String     | ReadMacrosDouble String     | ReadMacrosString String-    deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)  +    deriving (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)  type IsArrInit = Bool type ArrSize a = [a]@@ -195,35 +195,35 @@     where re = unFix e  -- Named variable-data Var +data Var     = Var         { varType :: VarType    -- global / local         , varRate :: Rate-        , varName :: Name } -    | VarVerbatim +        , varName :: Name }+    | VarVerbatim         { varRate :: Rate-        , varName :: Name        -        } deriving (Show, Eq, Ord, Generic)       -        +        , varName :: Name+        } deriving (Show, Eq, Ord, Generic)+ -- Variables can be global (then we have to prefix them with `g` in the rendering) or local. data VarType = LocalVar | GlobalVar     deriving (Show, Eq, Ord, Generic)  -- Opcode information.-data Info = Info +data Info = Info     -- Opcode name-    { infoName          :: Name     +    { infoName          :: Name     -- Opcode type signature     , infoSignature     :: Signature     -- Opcode can be infix or prefix     , infoOpcFixity     :: OpcFixity-    } deriving (Show, Eq, Ord, Generic)           -  +    } deriving (Show, Eq, Ord, Generic)+ isPrefix, isInfix :: Info -> Bool  isPrefix = (Prefix ==) . infoOpcFixity isInfix  = (Infix  ==) . infoOpcFixity- + -- Opcode fixity data OpcFixity = Prefix | Infix | Opcode     deriving (Show, Eq, Ord, Generic)@@ -232,55 +232,55 @@ data Rate   -- rate:     ----------------------------     = Xr    -- audio or control (and I use it for opcodes that produce no output, ie procedures)-    | Ar    -- audio -    | Kr    -- control -    | Ir    -- init (constants)    +    | Ar    -- audio+    | Kr    -- control+    | Ir    -- init (constants)     | Sr    -- strings     | Fr    -- spectrum (for pvs opcodes)-    | Wr    -- special spectrum +    | Wr    -- special spectrum     | Tvar  -- I don't understand what it is (fix me) used with Fr     deriving (Show, Eq, Ord, Enum, Bounded, Generic)-    + -- Opcode type signature. Opcodes can produce single output (SingleRate) or multiple outputs (MultiRate).--- In Csound opcodes are often have several signatures. That is one opcode name can produce signals of the +-- In Csound opcodes are often have several signatures. That is one opcode name can produce signals of the -- different rate (it depends on the type of the outputs). Here we assume (to make things easier) that--- opcodes that MultiRate-opcodes can produce only the arguments of the same type. -data Signature +-- opcodes that MultiRate-opcodes can produce only the arguments of the same type.+data Signature     -- For SingleRate-opcodes type signature is the Map from output rate to the rate of the arguments.     -- With it we can deduce the type of the argument from the type of the output.-    = SingleRate (Map Rate [Rate]) -    -- For MultiRate-opcodes Map degenerates to the singleton. We have only one link. +    = SingleRate (Map Rate [Rate])+    -- For MultiRate-opcodes Map degenerates to the singleton. We have only one link.     -- It contains rates for outputs and inputs.-    | MultiRate -        { outMultiRate :: [Rate] -        , inMultiRate  :: [Rate] } +    | MultiRate+        { outMultiRate :: [Rate]+        , inMultiRate  :: [Rate] }     deriving (Show, Eq, Ord)  instance Hashable Signature where     hashWithSalt s x = case x of         SingleRate m -> s `hashWithSalt` (0 :: Int) `hashWithSalt` (hash $ fmap (\b -> (take 5 b)) $ head' $ toList m)         MultiRate a b -> s `hashWithSalt` (1 :: Int) `hashWithSalt` (hash $ take 5 a) `hashWithSalt` (hash $ take 5 b)-        where +        where             head' xs = case xs of                 [] -> Nothing                 x:_ -> Just x  -- Primitive values-data Prim +data Prim     -- instrument p-arguments-    = P Int -    | PString Int       -- >> p-string (read p-string notes at the bottom of the file): -    | PrimInt Int -    | PrimDouble Double -    | PrimString String +    = P Int+    | PString Int       -- >> p-string (read p-string notes at the bottom of the file):+    | PrimInt Int+    | PrimDouble Double+    | PrimString String     | PrimInstrId InstrId-    | PrimVar -        { primVarTargetRate :: Rate +    | PrimVar+        { primVarTargetRate :: Rate         , primVar           :: Var }     deriving (Show, Eq, Ord, Generic)  -- Gen routine.-data Gen = Gen +data Gen = Gen     { genSize    :: Int     , genId      :: GenId     , genArgs    :: [Double]@@ -296,15 +296,15 @@ ------------------------------------------------------------ -- types for arithmetic and boolean expressions -data Inline a b = Inline +data Inline a b = Inline     { inlineExp :: InlineExp a-    , inlineEnv :: IM.IntMap b    +    , inlineEnv :: IM.IntMap b     } deriving (Show, Eq, Ord, Functor, Foldable, Traversable)  instance (Hashable a, Hashable b) => Hashable (Inline a b) where-    hashWithSalt s (Inline a m) = s `hashWithSalt` (hash a) `hashWithSalt` (hash $ IM.toList m) +    hashWithSalt s (Inline a m) = s `hashWithSalt` (hash a) `hashWithSalt` (hash $ IM.toList m) --- Inlined expression. +-- Inlined expression. data InlineExp a     = InlinePrim Int     | InlineExp a [InlineExp a]@@ -320,10 +320,10 @@ type CondInfo a = Inline CondOp a  -- Conditional operators-data CondOp  +data CondOp     = TrueOp | FalseOp | And | Or     | Equals | NotEquals | Less | Greater | LessEquals | GreaterEquals-    deriving (Show, Eq, Ord, Generic)    +    deriving (Show, Eq, Ord, Generic)  isTrue, isFalse :: CondInfo a -> Bool @@ -342,7 +342,7 @@  type NumExp a = PreInline NumOp a -data NumOp = Add | Sub | Neg | Mul | Div | Pow | Mod +data NumOp = Add | Sub | Neg | Mul | Div | Pow | Mod     deriving (Show, Eq, Ord, Generic)  -------------------------------------------------------@@ -386,10 +386,10 @@  -------------------------------------------------------------- -- comments--- --- p-string  -----    separate p-param for strings (we need it to read strings from global table) +-- p-string+--+--    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 

@@ -9,7 +9,7 @@      -- * Realtime Audio Input/Output     Rtaudio(..), PulseAudio(..),-       +     -- * MIDI File Input/Ouput     MidiIO(..), @@ -44,15 +44,16 @@     , midiRT            :: MidiRT     , rtmidi            :: Maybe Rtmidi     , displays          :: Displays-    , config            :: Config -    , flagsVerbatim     :: Maybe String }+    , config            :: Config+    , flagsVerbatim     :: Maybe String+    } deriving (Eq, Show, Read)  instance Default Flags where     def = Flags def def def def def def def def def def  instance Monoid Flags where     mempty = def-    mappend a b = Flags +    mappend a b = Flags         { audioFileOutput   = mappend (audioFileOutput a) (audioFileOutput b)         , idTags            = mappend (idTags a) (idTags b)         , rtaudio           = rtaudio a <|> rtaudio b@@ -62,7 +63,8 @@         , rtmidi            = rtmidi a <|> rtmidi b         , displays          = mappend (displays a) (displays b)         , config            = mappend (config a) (config b)-        , flagsVerbatim     = mappend (flagsVerbatim a) (flagsVerbatim b) }+        , flagsVerbatim     = mappend (flagsVerbatim a) (flagsVerbatim b)+        }  -- Audio file output @@ -73,14 +75,15 @@     , input             :: Maybe String     , nosound           :: Bool     , nopeaks           :: Bool-    , dither            :: Maybe Dither }+    , dither            :: Maybe Dither+    } deriving (Eq, Show, Read)  instance Default AudioFileOutput where     def = AudioFileOutput def def def def False False def- + instance Monoid AudioFileOutput where     mempty = def-    mappend a b = AudioFileOutput +    mappend a b = AudioFileOutput         { formatSamples     = formatSamples a <|> formatSamples b         , formatType        = formatType a <|> formatType b         , output            = output a <|> output b@@ -90,38 +93,40 @@         , dither            = dither a <|> dither b }  data FormatHeader = NoHeader | RewriteHeader+    deriving (Eq, Show, Read) -data FormatSamples -    = Bit24 | Alaw | Uchar | Schar +data FormatSamples+    = Bit24 | Alaw | Uchar | Schar     | FloatSamples | Ulaw | Short | Long-    deriving (Show)+    deriving (Eq, Show, Read)  data Dither = Triangular | Uniform-    deriving (Show)+    deriving (Eq, Show, Read) -data FormatType +data FormatType     = Aiff | Au | Avr | Caf | Flac | Htk     | Ircam | Mat4 | Mat5 | Nis | Paf | Pvf-    | Raw | Sd2 | Sds | Svx | Voc | W64 +    | Raw | Sd2 | Sds | Svx | Voc | W64     | Wav | Wavex | Xi-    deriving (Show)+    deriving (Eq, Show, Read)  -- Output file id tags -data IdTags = IdTags +data IdTags = IdTags     { idArtist      :: Maybe String     , idComment     :: Maybe String     , idCopyright   :: Maybe String     , idDate        :: Maybe String     , idSoftware    :: Maybe String-    , idTitle       :: Maybe String }+    , idTitle       :: Maybe String+    } deriving (Eq, Show, Read)  instance Default IdTags where     def = IdTags def def def def def def  instance Monoid IdTags where     mempty = def-    mappend a b = IdTags +    mappend a b = IdTags         { idArtist      = idArtist a <|> idArtist b         , idComment     = idComment a <|> idComment b         , idCopyright   = idCopyright a <|> idCopyright b@@ -131,35 +136,38 @@  -- Realtime Audio Input/Output -data Rtaudio -    = PortAudio | Alsa -    | Jack +data Rtaudio+    = PortAudio | Alsa+    | Jack         { jackClient    :: String         , jackInport    :: String-        , jackOutport   :: String } +        , jackOutport   :: String }     | Mme | CoreAudio     | NoRtaudio+    deriving (Eq, Show, Read)  data PulseAudio = PulseAudio     { paServer  :: String     , paOutput  :: String-    , paInput   :: String }+    , paInput   :: String+    } deriving (Eq, Show, Read)  -- MIDI File Input/Ouput -data MidiIO = MidiIO +data MidiIO = MidiIO     { midiFile          :: Maybe String     , midiOutFile       :: Maybe String     , muteTracks        :: Maybe String     , rawControllerMode :: Bool-    , terminateOnMidi   :: Bool }+    , terminateOnMidi   :: Bool+    } deriving (Eq, Show, Read)  instance Default MidiIO where     def = MidiIO def def def False False  instance Monoid MidiIO where     mempty = def-    mappend a b = MidiIO +    mappend a b = MidiIO         { midiFile          = midiFile a <|> midiFile b         , midiOutFile       = midiOutFile a <|> midiOutFile b         , muteTracks        = muteTracks a <|> muteTracks b@@ -176,15 +184,16 @@     , midiKeyPch        :: Maybe Int     , midiVelocity      :: Maybe Int     , midiVelocityAmp   :: Maybe Int-    , midiOutDevice     :: Maybe String }-   +    , midiOutDevice     :: Maybe String+    } deriving (Eq, Show, Read)+ instance Default MidiRT where     def = MidiRT def def def def                  def def def def  instance Monoid MidiRT where     mempty = def-    mappend a b = MidiRT +    mappend a b = MidiRT         { midiDevice        = midiDevice a <|> midiDevice b         , midiKey           = midiKey a <|> midiKey b         , midiKeyCps        = midiKeyCps a <|> midiKeyCps b@@ -195,6 +204,7 @@         , midiOutDevice     = midiOutDevice a <|> midiOutDevice b }  data Rtmidi = PortMidi | AlsaMidi | AlsaSeq | CoreMidi | MmeMidi | WinmmeMidi | VirtualMidi | NoRtmidi+    deriving (Eq, Show, Read)  -- Display @@ -211,12 +221,14 @@     , mBenchmarks       :: Maybe Int     , msgColor          :: Bool     , displayVerbose    :: Bool-    , listOpcodes       :: Maybe Int }+    , listOpcodes       :: Maybe Int+    } deriving (Eq, Show, Read)  data DisplayMode = NoDisplay | PostScriptDisplay | AsciiDisplay+    deriving (Eq, Show, Read)  instance Default Displays where-    def = Displays def (Just NoDisplay) +    def = Displays def (Just NoDisplay)             def def def def             def def def def             False False@@ -224,7 +236,7 @@  instance Monoid Displays where     mempty = def-    mappend a b = Displays +    mappend a b = Displays         { csdLineNums       = csdLineNums a <|> csdLineNums b         , displayMode       = displayMode a <|> displayMode b         , displayHeartbeat  = displayHeartbeat a <|> displayHeartbeat b@@ -237,7 +249,7 @@         , mBenchmarks       = mBenchmarks a <|> mBenchmarks b         , msgColor          = mappendBool (msgColor a) (msgColor b)         , displayVerbose    = mappendBool (displayVerbose a) (displayVerbose b)-        , listOpcodes       = listOpcodes a <|> listOpcodes b }        +        , listOpcodes       = listOpcodes a <|> listOpcodes b }  -- Performance Configuration and Control @@ -253,12 +265,13 @@     , schedNum      :: Maybe Int     , strsetN       :: Maybe (Int, String)     , skipSeconds   :: Maybe Double-    , setTempo      :: Maybe Int }+    , setTempo      :: Maybe Int+    } deriving (Eq, Show, Read)  instance Default Config where     def = Config def def def def def def def                  False-                 def def def def   +                 def def def def  instance Monoid Config where     mempty = def@@ -284,8 +297,8 @@ p = (fmap pretty . )  pe :: Pretty b => (a -> b) -> (a -> Maybe Doc)-pe f = phi . f -    where phi x  +pe f = phi . f+    where phi x             | null (show res)   = Nothing             | otherwise         = Just res             where res = pretty x@@ -293,7 +306,7 @@ bo :: String -> (a -> Bool) -> (a -> Maybe Doc) bo property extract a     | extract a = Just $ text property-    | otherwise = Nothing    +    | otherwise = Nothing  mp :: (String -> String) -> (a -> Maybe String) -> (a -> Maybe Doc) mp f a = p (fmap f . a)@@ -306,7 +319,7 @@  p2 :: String -> String -> String p2 pref x = ('-' : '-' : pref) ++ ('=' : x)-   + p3 :: String -> String -> String p3 pref x = ('-' : '+' : pref) ++ ('=' : x) @@ -315,19 +328,19 @@  instance Pretty Flags where     pretty = fields-        [ pe audioFileOutput -        , pe idTags +        [ pe displays+        , pe config+        , pe audioFileOutput+        , pe idTags         , p  rtaudio         , p  pulseAudio+        , p  rtmidi         , pe midiIO         , pe midiRT-        , p  rtmidi-        , pe displays-        , pe config         , p  flagsVerbatim ]  instance Pretty AudioFileOutput where-    pretty = fields +    pretty = fields         [ pSamplesAndType . (\x -> (formatSamples x, formatType x))         , mp (p2 "output") output         , mp (p2 "input")  input@@ -355,18 +368,18 @@     pretty = pretty . p2 "dither" . show  instance Pretty IdTags where-    pretty = fields +    pretty = fields         [ mp (p3' "id_artist")       idArtist         , mp (p3' "id_comment")      idComment         , mp (p3' "id_copyright")    idCopyright         , mp (p3' "id_date")         idDate         , mp (p3' "id_software")     idSoftware         , mp (p3' "id_title")        idTitle ]-        where +        where             p3' a b = fmap substSpaces $ p3 a b             substSpaces x                 | isSpace x = '_'-                | otherwise = x  +                | otherwise = x  instance Pretty Rtaudio where     pretty x = case x of@@ -376,9 +389,9 @@         Alsa  -> rt "alsa"         CoreAudio -> rt "auhal"         NoRtaudio   -> rt "0"-        where +        where             rt = text . p3 "rtaudio"-            jackFields name ins outs = hsep +            jackFields name ins outs = hsep                 [ text $ p3 "jack_client" name                 , text $ p3 "jack_inportname" ins                 , text $ p3 "jack_outportname" outs ]@@ -390,7 +403,7 @@         , p3 "input_stream" $ paInput a ]  instance Pretty MidiIO where-    pretty = fields +    pretty = fields         [ mp (p2 "midifile") midiFile         , mp (p2 "midioutfile") midiOutFile         , mp (p3 "mute_tracks") muteTracks@@ -407,7 +420,7 @@         , mi (p2 "midi-velocity")       midiVelocity         , mi (p2 "midi-velocity-amp")   midiVelocityAmp         , mp (p1 "Q")                   midiOutDevice ]-    + instance Pretty Rtmidi where     pretty x = text $ p3 "rtmidi" $ case x of         VirtualMidi -> "virtual"@@ -421,7 +434,7 @@  instance Pretty Displays where     pretty = fields-        [ mi (p2 "csd-line-nums")   csdLineNums +        [ mi (p2 "csd-line-nums")   csdLineNums         , p                         displayMode         , mi (p2 "heartbeat")       displayHeartbeat         , mi (p2 "messagelevel")    messageLevel@@ -440,9 +453,9 @@         NoDisplay           -> "--nodisplays"         PostScriptDisplay   -> "--postscriptdisplay"         AsciiDisplay        -> "--asciidisplay"-        + instance Pretty Config where-    pretty = fields +    pretty = fields         [ mi (p2 "hardwarebufsamps")    hwBuf         , mi (p2 "iobufsamps")          ioBuf         , mi (p2 "control-rate")        newKr@@ -465,7 +478,7 @@ -- utilities  firstToLower :: String -> String-firstToLower x = case x of +firstToLower x = case x of     a:as -> toLower a : as     []   -> []