csound-expression-dynamic 0.0.7 → 0.1.0
raw patch · 5 files changed
+55/−20 lines, 5 files
Files
- csound-expression-dynamic.cabal +3/−2
- src/Csound/Dynamic/Render/Instr.hs +16/−4
- src/Csound/Dynamic/Tfm/DeduceTypes.hs +1/−1
- src/Csound/Dynamic/Types/Dep.hs +29/−12
- src/Csound/Dynamic/Types/Exp.hs +6/−1
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