csound-expression-dynamic 0.0.0 → 0.0.1

raw patch · 6 files changed

+39/−16 lines, 6 files

Files

• csound-expression-dynamic.cabal +1/−1
• src/Csound/Dynamic/Build.hs +0/−7
• src/Csound/Dynamic/Render/Instr.hs +11/−6
• src/Csound/Dynamic/Render/Pretty.hs +16/−0
• src/Csound/Dynamic/Types/Dep.hs +1/−1
• src/Csound/Dynamic/Types/Exp.hs +10/−1

@@ -1,5 +1,5 @@ Name:          csound-expression-dynamic-Version:       0.0.0+Version:       0.0.1 Cabal-Version: >= 1.6 License:       BSD3 License-file:  LICENSE

@@ -5,9 +5,6 @@     toExp, onExp,       -- * Rates-    -- | Updating rates-    setRate, -       -- * Queries     getRates, isMultiOutSignature, getPrimUnsafe, @@ -136,10 +133,6 @@                        select cellId rate expr = withRate rate $ Select rate cellId (PrimOr $ Right expr) --- rate coversion--setRate :: Rate -> E -> E-setRate r a = Fix $ (\x -> x { ratedExpRate = Just r }) $ unFix a  getRates :: MainExp a -> [Rate] getRates (Tfm info _) = case infoSignature info of

@@ -132,13 +132,13 @@ 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 $ mergeWithPrimOrBy (flip ratedVar) xs (ratesFromSignature curRate (infoSignature i))+    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         ReadVar v -> ReadVar v     WriteVar v a -> WriteVar v $ rec1 (varRate v) a-    InitVar v a -> InitVar v $ rec1 (varRate v) a+    InitVar v a -> InitVar v $ rec1 Ir a -- rec1 (varRate v) a     ExpPrim p -> ExpPrim p     IfBegin _ -> rec2 condRate expr     ElseIfBegin _ -> rec2 condRate expr@@ -160,10 +160,15 @@           rec1 r = fmap (ratedVar r)            msg txt = "Csound.Dynamic.Render.Instr.rateExp: " ++ txt -           --mergeWithPrimOrBy :: (a -> b -> c) -> [PrimOr a] -> [b] -> [PrimOr c]-mergeWithPrimOrBy cons = zipWith (\primOr b -> fmap (flip cons b) primOr)+mergeWithPrimOr :: [Rate] -> [PrimOr Int] -> [PrimOr (Var Rate)]+mergeWithPrimOr = zipWith phi+    where +        phi r (PrimOr x) = PrimOr $ case x of+            Left  p -> Left $ updateVarTargetRate r p +            Right n -> Right $ ratedVar r n+        updateVarTargetRate r p = case p of+            PrimVar _ v -> PrimVar r v+            _           -> p  

@@ -58,6 +58,22 @@     PrimInt n -> int n     PrimDouble d -> double d     PrimString s -> dquotes $ text s+    PrimVar targetRate v -> ppConverter targetRate (varRate v) $ ppVar v+    where+        ppConverter dst src t +            | dst == src = t            +            | dst == Ar && src == Kr = a(t) +            | dst == Ar && src == Ir = a(k(t))            +            | dst == Kr  = k(t)+            | dst == Ir && src == Kr = i(t)+            | dst == Ir && src == Ar = i(k(t))+            | otherwise = t+            where +                tfm ch v = hcat [char ch, parens v]    +                a = tfm 'a'+                k = tfm 'k'+                i = tfm 'i'+      ppGen :: Int -> Gen -> Doc ppGen tabId ft = char 'f' 

@@ -111,7 +111,7 @@ readOnlyVar v = noRate $ ReadVar v  initVar :: Monad m => Var -> E -> DepT m ()-initVar v x = depT_ $ noRate $ InitVar v $ toPrimOr x+initVar v x = depT_ $ setRate Ir $ noRate $ InitVar v $ toPrimOr x  appendVarBy :: Monad m => (E -> E -> E) -> Var -> E -> DepT m () appendVarBy op v x = writeVar v . op x =<< readVar v

@@ -2,7 +2,7 @@ {-# Language DeriveFunctor, DeriveFoldable, DeriveTraversable #-} module Csound.Dynamic.Types.Exp(     E, RatedExp(..), isEmptyExp, RatedVar, ratedVar, ratedVarRate, ratedVarId, -    ratedExp, noRate, withRate,+    ratedExp, noRate, withRate, setRate,     Exp, toPrimOr, PrimOr(..), MainExp(..), Name,      InstrId(..), intInstrId, ratioInstrId, stringInstrId,     VarType(..), Var(..), Info(..), OpcFixity(..), Rate(..), @@ -86,7 +86,11 @@ withRate :: Rate -> Exp E -> E withRate r = ratedExp (Just r) +-- rate coversion +setRate :: Rate -> E -> E+setRate r a = Fix $ (\x -> x { ratedExpRate = Just r }) $ unFix a+ -- | It's a primitive value or something else. It's used for inlining -- of the constants (primitive values). newtype PrimOr a = PrimOr { unPrimOr :: Either Prim a }@@ -98,7 +102,9 @@ toPrimOr a = PrimOr $ case ratedExpExp $ unFix a of     ExpPrim (PString _) -> Right a     ExpPrim p -> Left p+    ReadVar v | noDeps -> Left (PrimVar (varRate v) v)     _         -> Right a+    where noDeps = isNothing $ ratedExpDepends $ unFix a  -- Expressions with inlining. type Exp a = MainExp (PrimOr a)@@ -208,6 +214,9 @@     | PrimDouble Double      | PrimString String      | PrimInstrId InstrId+    | PrimVar +        { primVarTargetRate :: Rate +        , primVar           :: Var }     deriving (Show, Eq, Ord)  -- Gen routine.