module Csound.Exp(
E, RatedExp(..), RatedVar, ratedVar, ratedVarRate, ratedVarId, Exp, toPrimOr, PrimOr(..), MainExp(..), Name,
InstrId(..), intInstrId, ratioInstrId,
VarType(..), Var(..), Info(..), OpcFixity(..), Rate(..),
Signature(..), isProcedure, isInfix, isPrefix,
Prim(..), LowTab(..), Tab(..), TabSize(..), TabArgs(..), TabMap, TabFi(..),
Inline(..), InlineExp(..), PreInline(..),
BoolExp, CondInfo, CondOp(..), isTrue, isFalse,
NumExp, NumOp(..), Msg(..), Note,
StringMap
) where
import Control.Applicative
import Data.Traversable
import Data.Foldable hiding (concat)
import Data.Default
import Data.Map(Map)
import qualified Data.IntMap as IM
import qualified Data.Map as M
import Data.Fix
import qualified Csound.Tfm.DeduceTypes as R(Var(..))
type Name = String
data InstrId = InstrId
{ instrIdFrac :: Maybe Int
, instrIdCeil :: Int
} deriving (Show, Eq, Ord)
intInstrId :: Int -> InstrId
intInstrId n = InstrId Nothing n
ratioInstrId :: Int -> Int -> InstrId
ratioInstrId beforeDot afterDot = InstrId (Just $ afterDot) beforeDot
type E = Fix RatedExp
data RatedExp a = RatedExp
{ ratedExpRate :: Maybe Rate
, ratedExpDepends :: Maybe a
, ratedExpExp :: Exp a
} deriving (Show, Eq, Ord, Functor, Foldable, Traversable)
type RatedVar = R.Var Rate
ratedVar :: Rate -> Int -> RatedVar
ratedVar = flip R.Var
ratedVarRate :: RatedVar -> Rate
ratedVarRate = R.varType
ratedVarId :: RatedVar -> Int
ratedVarId = R.varId
newtype PrimOr a = PrimOr { unPrimOr :: Either Prim a }
deriving (Show, Eq, Ord, Functor)
toPrimOr :: E -> PrimOr E
toPrimOr a = PrimOr $ case ratedExpExp $ unFix a of
ExpPrim (PString _) -> Right a
ExpPrim p -> Left p
_ -> Right a
type Exp a = MainExp (PrimOr a)
data MainExp 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)
| InitVar Var a
| ReadVar Var
| WriteVar Var a
| IfBegin a
| ElseIfBegin a
| ElseBegin
| IfEnd
deriving (Show, Eq, Ord, Functor, Foldable, Traversable)
data Var
= Var
{ varType :: VarType
, varRate :: Rate
, varName :: Name }
| VarVerbatim
{ varRate :: Rate
, varName :: Name
} deriving (Show, Eq, Ord)
data VarType = LocalVar | GlobalVar
deriving (Show, Eq, Ord)
data Info = Info
{ infoName :: Name
, infoSignature :: Signature
, infoOpcFixity :: OpcFixity
, infoNextSE :: Maybe Int
} deriving (Show, Eq, Ord)
isPrefix, isInfix, isProcedure :: Info -> Bool
isPrefix = (Prefix ==) . infoOpcFixity
isInfix = (Infix ==) . infoOpcFixity
isProcedure = (Procedure ==) . infoOpcFixity
data OpcFixity = 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
| PrimString String
| PrimInstrId InstrId
| PrimTab (Either Tab LowTab)
deriving (Show, Eq, Ord)
type TabMap = M.Map LowTab Int
data LowTab = LowTab
{ lowTabSize :: Int
, lowTabGen :: Int
, lowTabArgs :: [Double]
} deriving (Show, Eq, Ord)
data Tab
= TabExp E
| Tab
{ tabSize :: TabSize
, tabGen :: Int
, tabArgs :: TabArgs
} deriving (Show, Eq, Ord)
instance Default TabSize where
def = SizeDegree
{ hasGuardPoint = False
, sizeDegree = 0 }
data TabSize
= SizePlain Int
| SizeDegree
{ hasGuardPoint :: Bool
, sizeDegree :: Int
} deriving (Show, Eq, Ord)
data TabArgs
= ArgsPlain [Double]
| ArgsRelative [Double]
deriving (Show, Eq, Ord)
data TabFi = TabFi
{ tabFiBase :: Int
, tabFiGens :: IM.IntMap Int }
data Msg = Msg
type Note = [Prim]
type StringMap = M.Map String Int
data Inline a b = Inline
{ inlineExp :: InlineExp a
, inlineEnv :: IM.IntMap b
} deriving (Show, Eq, Ord, Functor, Foldable, Traversable)
data InlineExp a
= InlinePrim Int
| InlineExp a [InlineExp a]
deriving (Show, Eq, Ord)
data PreInline a b = PreInline a [b]
deriving (Show, Eq, Ord, Functor, Foldable, Traversable)
type BoolExp a = PreInline CondOp a
type CondInfo a = Inline CondOp a
data CondOp
= TrueOp | FalseOp | And | Or
| Equals | NotEquals | Less | Greater | LessEquals | GreaterEquals
deriving (Show, Eq, Ord)
isTrue, isFalse :: CondInfo a -> Bool
isTrue = isCondOp TrueOp
isFalse = isCondOp FalseOp
isCondOp :: CondOp -> CondInfo a -> Bool
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
| Ceil | Floor | Frac | Round | IntOp
| Abs | ExpOp | Log | Log10 | Logbtwo | Sqrt
| Ampdb | Ampdbfs | Dbamp | Dbfsamp
| Cent | Cpsmidinn | Cpsoct | Cpspch | Octave | Octcps | Octmidinn | Octpch | Pchmidinn | Pchoct | Semitone
deriving (Show, Eq, Ord)
instance Foldable PrimOr where foldMap = foldMapDefault
instance Traversable PrimOr where
traverse f x = case unPrimOr x of
Left p -> pure $ PrimOr $ Left p
Right a -> PrimOr . Right <$> f a