packages feed

csound-expression-dynamic 0.0.7 → 0.1.0

raw patch · 5 files changed

+55/−20 lines, 5 files

Files

csound-expression-dynamic.cabal view
@@ -1,5 +1,5 @@ Name:          csound-expression-dynamic-Version:       0.0.7+Version:       0.1.0 Cabal-Version: >= 1.6 License:       BSD3 License-file:  LICENSE@@ -42,7 +42,7 @@     Csound.Dynamic.Build.Logic      Csound.Dynamic.Render-+     Other-Modules:     Csound.Dynamic.Tfm.DeduceTypes     Csound.Dynamic.Tfm.Liveness@@ -50,5 +50,6 @@     Csound.Dynamic.Render.Pretty     Csound.Dynamic.Render.Instr      +  
src/Csound/Dynamic/Render/Instr.hs view
@@ -1,6 +1,6 @@ module Csound.Dynamic.Render.Instr(     renderInstr, renderInstrBody-) where+) where   import Control.Arrow(second) import Control.Monad.Trans.State.Strict@@ -27,14 +27,18 @@ renderInstr a = ppInstr (instrName a) $ renderInstrBody (instrBody a)  renderInstrBody :: E -> Doc-renderInstrBody = P.vcat . flip evalState 0 -    . mapM (uncurry ppStmt . clearEmptyResults) . collectRates . toDag +renderInstrBody a +  | null dag  = P.empty+  | otherwise = render dag+    where +      dag = toDag a+      render = P.vcat . flip evalState 0 . mapM (uncurry ppStmt . clearEmptyResults) . collectRates   ------------------------------------------------------------- -- E -> Dag  toDag :: E -> Dag RatedExp -toDag expr = fromDag $ cse $ trimByArgLength expr+toDag expr = filterDepCases $ fromDag $ cse $ trimByArgLength expr  trimByArgLength :: E -> E trimByArgLength = cata $ \x -> Fix x{ ratedExpExp = phi $ ratedExpExp x }@@ -57,6 +61,14 @@  ----------------------------------------------------------- -- Dag -> Dag++filterDepCases :: Dag RatedExp -> Dag RatedExp+filterDepCases = filter (not . isDepCase . snd)+  where isDepCase x = case ratedExpExp x of+          Starts  -> True+          Seq _ _ -> True+          Ends _  -> True+          _       -> False  ----------------------------------------------------------- -- deduces types
src/Csound/Dynamic/Tfm/DeduceTypes.hs view
@@ -95,7 +95,7 @@     let typeMap = IM.fromList $ fmap lineType lines'     lastId <- readSTRef freshIds     return (reverse $ processLine typeMap =<< lines', lastId)-    where n = length as+    where n = succ $ if (null as) then 0 else (fst $ last as)           processLine typeMap line = fmap (mkConvert spec) (lineConverts line) ++ [(a, fmap (lookupVar typeMap) b)]               where (a, b) = lineStmt line             
src/Csound/Dynamic/Types/Dep.hs view
@@ -1,8 +1,8 @@ -- | Dependency tracking module Csound.Dynamic.Types.Dep(-    DepT(..), runDepT, LocalHistory(..),    +    DepT(..), LocalHistory(..), runDepT, execDepT, evalDepT,        -- * Dependencies-    depT, depT_, mdepT, stripDepT, stmtOnlyT, execDepT,+    depT, depT_, mdepT, stripDepT, stmtOnlyT,       -- * Variables     newLocalVar, newLocalVars,@@ -27,11 +27,12 @@ newtype DepT m a = DepT { unDepT :: StateT LocalHistory m a }  data LocalHistory = LocalHistory-    { expDependency :: Maybe E+    { expDependency :: E+    , newLineNum    :: Int     , newLocalVarId :: Int }  instance Default LocalHistory where-    def = LocalHistory Nothing 0+    def = LocalHistory start 0 0  instance Monad m => Functor (DepT m) where     fmap = liftM @@ -46,19 +47,35 @@  instance MonadTrans DepT where     lift ma = DepT $ lift ma-   -runDepT :: DepT m a -> m (a, LocalHistory)-runDepT a = runStateT (unDepT a) def -execDepT :: Monad m => DepT m a -> m E-execDepT a = liftM (maybe emptyE id . expDependency . snd) $ runDepT a+runDepT :: (Functor m, Monad m) => DepT m a -> m (a, LocalHistory)+runDepT a = runStateT (unDepT $ a) def +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+ -- dependency tracking +start :: E+start = noRate Starts++depends :: E -> E -> E+depends a1 a2 = noRate $ Seq (toPrimOr a1) (toPrimOr a2)++end :: Monad m => E -> DepT m ()+end a = depT_ $ noRate $ Ends (toPrimOr a)+ depT :: Monad m => E -> DepT m E-depT a = DepT $ StateT $ \s -> do-    let x = Fix $ (unFix a) { ratedExpDepends = expDependency s }-    return (x, s { expDependency = Just x })    +depT a = DepT $ do+    s <- get+    let a1 = Fix $ (unFix a) { ratedExpDepends = Just (newLineNum s) }+    put $ s { +        newLineNum = succ $ newLineNum s, +        expDependency = depends (expDependency s) a1 }+    return a1      depT_ :: (Monad m) => E -> DepT m () depT_ = fmap (const ()) . depT
src/Csound/Dynamic/Types/Exp.hs view
@@ -27,6 +27,7 @@ import qualified Csound.Dynamic.Tfm.DeduceTypes as R(Var(..))   type Name = String+type LineNum = Int  -- | An instrument identifier data InstrId @@ -55,7 +56,7 @@     { ratedExpRate      :: Maybe Rate                -- ^ Rate (can be undefined or Nothing,          -- it means that rate should be deduced automatically from the context)-    , ratedExpDepends   :: Maybe a          +    , ratedExpDepends   :: Maybe LineNum                   -- ^ Dependency (it is used for expressions with side effects,         -- value contains the privious statement)     , ratedExpExp       :: Exp a    @@ -140,6 +141,10 @@     | UntilEnd     -- | Verbatim stmt     | Verbatim String+    -- | Dependency tracking+    | Starts+    | Seq a a+    | Ends a     deriving (Show, Eq, Ord, Functor, Foldable, Traversable)    isEmptyExp :: E -> Bool