module Csound.Exp(
E, RatedExp(..), RatedVar(..), onExp, Exp(..), Name,
VarType(..), Var(..), Info(..), OpcType(..), Rate(..),
Signature(..), isProcedure, isInfix, isPrefix,
Prim(..), Tab(..),
Inline(..), InlineExp(..), PreInline(..),
BoolExp, CondInfo, CondOp(..), isTrue, isFalse,
NumExp, NumOp(..)
) where
import Control.Applicative
import Data.Monoid
import Data.Traversable
import Data.Foldable hiding (concat)
import Data.Map(Map)
import qualified Data.IntMap as IM
import Data.Fix
type E = Fix RatedExp
type Name = String
data RatedExp a = RatedExp
{ ratedExpRate :: Maybe Rate
, ratedExpDepends :: Maybe a
, ratedExpExp :: Exp a
} deriving (Show, Eq, Ord)
data RatedVar = RatedVar
{ ratedVarRate :: Rate
, ratedVarId :: Int
} deriving (Show)
onExp :: (Exp a -> Exp a) -> RatedExp a -> RatedExp a
onExp f a = a{ ratedExpExp = f (ratedExpExp a) }
data VarType = LocalVar | GlobalVar
deriving (Show, Eq, Ord)
data Exp a
= ExpPrim Prim
| Tfm Info [a]
| ConvertRate Rate Rate a
| Select Rate Int a
| If (CondInfo a) a a
| ExpBool (BoolExp a)
| ExpNum (NumExp a)
| ReadVar Var
| WriteVar Var a
deriving (Show, Eq, Ord)
data Var
= Var
{ varType :: VarType
, varRate :: Rate
, varName :: Name }
| VarVerbatim
{ varRate :: Rate
, varName :: Name
} deriving (Show, Eq, Ord)
data Info = Info
{ infoName :: Name
, infoSignature :: Signature
, infoOpcType :: OpcType
, infoNextSE :: Maybe Int
} deriving (Show, Eq, Ord)
isPrefix, isInfix, isProcedure :: Info -> Bool
isPrefix = (Prefix ==) . infoOpcType
isInfix = (Infix ==) . infoOpcType
isProcedure = (Procedure ==) . infoOpcType
data OpcType = Prefix | Infix | Procedure
deriving (Show, Eq, Ord)
data Rate = Xr | Ar | Kr | Ir | Sr | Fr
deriving (Show, Eq, Ord, Enum, Bounded)
data Signature
= SingleRate (Map Rate [Rate])
| MultiRate
{ outMultiRate :: [Rate]
, inMultiRate :: [Rate] }
deriving (Show, Eq, Ord)
data Prim
= P Int
| PString Int
| PrimInt Int
| PrimDouble Double
| PrimTab Tab
| PrimString String
deriving (Show, Eq, Ord)
data Tab = Tab
{ tabSize :: Int
, tabGen :: Int
, tabArgs :: [Double]
} deriving (Show, Eq, Ord)
data Inline a b = Inline
{ inlineExp :: InlineExp a
, inlineEnv :: IM.IntMap b
} deriving (Show, Eq, Ord)
data InlineExp a
= InlinePrim Int
| InlineExp a [InlineExp a]
deriving (Show, Eq, Ord)
data PreInline a b = PreInline a [b]
deriving (Show, Eq, Ord)
type BoolExp a = PreInline CondOp a
type CondInfo a = Inline CondOp a
data CondOp
= TrueOp | FalseOp | Not | And | Or
| Equals | NotEquals | Less | Greater | LessEquals | GreaterEquals
deriving (Show, Eq, Ord)
isTrue, isFalse :: CondInfo a -> Bool
isTrue = isCondOp TrueOp
isFalse = isCondOp FalseOp
isCondOp op = maybe False (op == ) . getCondInfoOp
getCondInfoOp :: CondInfo a -> Maybe CondOp
getCondInfoOp x = case inlineExp x of
InlineExp op _ -> Just op
_ -> Nothing
type NumExp a = PreInline NumOp a
data NumOp
= Add | Sub | Neg | Mul | Div
| Pow | Mod
| Sin | Cos | Sinh | Cosh | Tan | Tanh | Sininv | Cosinv | Taninv
| Abs | Ceil | ExpOp | Floor | Frac| IntOp | Log | Log10 | Logbtwo | Round | Sqrt
| Ampdb | Ampdbfs | Dbamp | Dbfsamp
| Cpspch
deriving (Show, Eq, Ord)
instance Functor RatedExp where
fmap f (RatedExp r d a) = RatedExp r (fmap f d) (fmap f a)
instance Foldable RatedExp where
foldMap f (RatedExp _ d a) = foldMap f d <> foldMap f a
instance Traversable RatedExp where
traverse f (RatedExp r d a) = RatedExp r <$> traverse f d <*> traverse f a
instance Functor Exp where
fmap f x = case x of
ExpPrim p -> ExpPrim p
Tfm t xs -> Tfm t $ map f xs
ConvertRate ra rb a -> ConvertRate ra rb $ f a
Select r n a -> Select r n $ f a
If info a b -> If (fmap f info) (f a) (f b)
ExpBool a -> ExpBool $ fmap f a
ExpNum a -> ExpNum $ fmap f a
ReadVar v -> ReadVar v
WriteVar v a -> WriteVar v (f a)
instance Foldable Exp where
foldMap f x = case x of
ExpPrim p -> mempty
Tfm t xs -> foldMap f xs
ConvertRate ra rb a -> f a
Select r n a -> f a
If info a b -> foldMap f info <> f a <> f b
ExpBool a -> foldMap f a
ExpNum a -> foldMap f a
ReadVar v -> mempty
WriteVar v a -> f a
instance Traversable Exp where
traverse f x = case x of
ExpPrim p -> pure $ ExpPrim p
Tfm t xs -> Tfm t <$> traverse f xs
ConvertRate ra rb a -> ConvertRate ra rb <$> f a
Select r n a -> Select r n <$> f a
If info a b -> If <$> traverse f info <*> f a <*> f b
ExpBool a -> ExpBool <$> traverse f a
ExpNum a -> ExpNum <$> traverse f a
ReadVar v -> pure $ ReadVar v
WriteVar v a -> WriteVar v <$> f a
instance Functor (Inline a) where
fmap f a = a{ inlineEnv = fmap f $ inlineEnv a }
instance Foldable (Inline a) where
foldMap f a = foldMap f $ inlineEnv a
instance Traversable (Inline a) where
traverse f (Inline a b) = Inline a <$> traverse f b
instance Functor (PreInline a) where
fmap f (PreInline op as) = PreInline op $ fmap f as
instance Foldable (PreInline a) where
foldMap f (PreInline _ as) = foldMap f as
instance Traversable (PreInline a) where
traverse f (PreInline op as) = PreInline op <$> traverse f as