{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# Language TypeFamilies, TypeSynonymInstances, FlexibleInstances #-}
-- | Boolean instances
module Csound.Dynamic.Build.Logic(
    when1, whens,
    ifExp,
    ifElseBlock,
    -- ifBegin, ifEnd, elseBegin,
    untilBlock,
    whileBlock,
    whileEnd,
    condInfo
) where

import Control.Monad
import Control.Monad.Trans.State.Strict (State, state, evalState, get, put, execStateT)
import qualified Data.IntMap as IM(fromList)

import Data.Boolean
import Csound.Dynamic.Types
import Csound.Dynamic.Build(onExp, toExp)
import Data.List qualified as List
import Control.Monad.Trans.Class (lift)

ifT :: forall m . Monad m => IfRate -> E -> DepT m () -> DepT m () -> DepT m ()
ifT :: forall (m :: * -> *).
Monad m =>
IfRate -> E -> DepT m () -> DepT m () -> DepT m ()
ifT IfRate
ifRate E
check DepT m ()
th DepT m ()
el = do
  E
thBlock <- DepT m () -> DepT m E
forall (m :: * -> *). Monad m => DepT m () -> DepT m E
execNoDeps DepT m ()
th
  E
elBlock <- DepT m () -> DepT m E
forall (m :: * -> *). Monad m => DepT m () -> DepT m E
execNoDeps DepT m ()
el
  E -> DepT m ()
forall (m :: * -> *). Monad m => E -> DepT m ()
depT_ (E -> DepT m ()) -> E -> DepT m ()
forall a b. (a -> b) -> a -> b
$ Exp E -> E
noRate (Exp E -> E) -> Exp E -> E
forall a b. (a -> b) -> a -> b
$
    IfRate
-> CondInfo (PrimOr E)
-> CodeBlock (PrimOr E)
-> CodeBlock (PrimOr E)
-> Exp E
forall a.
IfRate -> CondInfo a -> CodeBlock a -> CodeBlock a -> MainExp a
IfElseBlock IfRate
ifRate (E -> CondInfo (PrimOr E)
condInfo (E -> CondInfo (PrimOr E)) -> E -> CondInfo (PrimOr E)
forall a b. (a -> b) -> a -> b
$ IfRate -> E -> E
setIfRate IfRate
ifRate E
check) (PrimOr E -> CodeBlock (PrimOr E)
forall a. a -> CodeBlock a
CodeBlock (PrimOr E -> CodeBlock (PrimOr E))
-> PrimOr E -> CodeBlock (PrimOr E)
forall a b. (a -> b) -> a -> b
$ Either Prim E -> PrimOr E
forall a. Either Prim a -> PrimOr a
PrimOr (Either Prim E -> PrimOr E) -> Either Prim E -> PrimOr E
forall a b. (a -> b) -> a -> b
$ E -> Either Prim E
forall a b. b -> Either a b
Right E
thBlock) (PrimOr E -> CodeBlock (PrimOr E)
forall a. a -> CodeBlock a
CodeBlock (PrimOr E -> CodeBlock (PrimOr E))
-> PrimOr E -> CodeBlock (PrimOr E)
forall a b. (a -> b) -> a -> b
$ Either Prim E -> PrimOr E
forall a. Either Prim a -> PrimOr a
PrimOr (Either Prim E -> PrimOr E) -> Either Prim E -> PrimOr E
forall a b. (a -> b) -> a -> b
$ E -> Either Prim E
forall a b. b -> Either a b
Right E
elBlock)

ifT1, untilT, whileT :: Monad m => IfRate -> E -> DepT m () -> DepT m ()

ifT1 :: forall (m :: * -> *).
Monad m =>
IfRate -> E -> DepT m () -> DepT m ()
ifT1 = (IfRate -> CondInfo (PrimOr E) -> CodeBlock (PrimOr E) -> Exp E)
-> IfRate -> E -> DepT m () -> DepT m ()
forall (m :: * -> *).
Monad m =>
(IfRate -> CondInfo (PrimOr E) -> CodeBlock (PrimOr E) -> Exp E)
-> IfRate -> E -> DepT m () -> DepT m ()
ifT1By IfRate -> CondInfo (PrimOr E) -> CodeBlock (PrimOr E) -> Exp E
forall a. IfRate -> CondInfo a -> CodeBlock a -> MainExp a
IfBlock
untilT :: forall (m :: * -> *).
Monad m =>
IfRate -> E -> DepT m () -> DepT m ()
untilT = (IfRate -> CondInfo (PrimOr E) -> CodeBlock (PrimOr E) -> Exp E)
-> IfRate -> E -> DepT m () -> DepT m ()
forall (m :: * -> *).
Monad m =>
(IfRate -> CondInfo (PrimOr E) -> CodeBlock (PrimOr E) -> Exp E)
-> IfRate -> E -> DepT m () -> DepT m ()
ifT1By IfRate -> CondInfo (PrimOr E) -> CodeBlock (PrimOr E) -> Exp E
forall a. IfRate -> CondInfo a -> CodeBlock a -> MainExp a
UntilBlock
whileT :: forall (m :: * -> *).
Monad m =>
IfRate -> E -> DepT m () -> DepT m ()
whileT = (IfRate -> CondInfo (PrimOr E) -> CodeBlock (PrimOr E) -> Exp E)
-> IfRate -> E -> DepT m () -> DepT m ()
forall (m :: * -> *).
Monad m =>
(IfRate -> CondInfo (PrimOr E) -> CodeBlock (PrimOr E) -> Exp E)
-> IfRate -> E -> DepT m () -> DepT m ()
ifT1By IfRate -> CondInfo (PrimOr E) -> CodeBlock (PrimOr E) -> Exp E
forall a. IfRate -> CondInfo a -> CodeBlock a -> MainExp a
WhileBlock

execNoDeps :: Monad m => DepT m () -> DepT m E
execNoDeps :: forall (m :: * -> *). Monad m => DepT m () -> DepT m E
execNoDeps DepT m ()
block = StateT LocalHistory m E -> DepT m E
forall (m :: * -> *) a. StateT LocalHistory m a -> DepT m a
DepT (StateT LocalHistory m E -> DepT m E)
-> StateT LocalHistory m E -> DepT m E
forall a b. (a -> b) -> a -> b
$ do
  LocalHistory
st <- StateT LocalHistory m LocalHistory
forall (m :: * -> *) s. Monad m => StateT s m s
get
  LocalHistory
st1 <- m LocalHistory -> StateT LocalHistory m LocalHistory
forall (m :: * -> *) a. Monad m => m a -> StateT LocalHistory m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m LocalHistory -> StateT LocalHistory m LocalHistory)
-> m LocalHistory -> StateT LocalHistory m LocalHistory
forall a b. (a -> b) -> a -> b
$ StateT LocalHistory m () -> LocalHistory -> m LocalHistory
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT (DepT m () -> StateT LocalHistory m ()
forall (m :: * -> *) a. DepT m a -> StateT LocalHistory m a
unDepT DepT m ()
block) (LocalHistory
st { expDependency = noRate Starts })
  LocalHistory -> StateT LocalHistory m ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (LocalHistory -> StateT LocalHistory m ())
-> LocalHistory -> StateT LocalHistory m ()
forall a b. (a -> b) -> a -> b
$ LocalHistory
st1 { expDependency = expDependency st }
  E -> StateT LocalHistory m E
forall a. a -> StateT LocalHistory m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LocalHistory -> E
expDependency LocalHistory
st1)

ifT1By :: Monad m
  => (IfRate -> CondInfo (PrimOr E) -> CodeBlock (PrimOr E) -> Exp E)
  -> IfRate -> E -> DepT m () -> DepT m ()
ifT1By :: forall (m :: * -> *).
Monad m =>
(IfRate -> CondInfo (PrimOr E) -> CodeBlock (PrimOr E) -> Exp E)
-> IfRate -> E -> DepT m () -> DepT m ()
ifT1By IfRate -> CondInfo (PrimOr E) -> CodeBlock (PrimOr E) -> Exp E
cons IfRate
ifRate E
check DepT m ()
codeBlock = do
  E
block <- DepT m () -> DepT m E
forall (m :: * -> *). Monad m => DepT m () -> DepT m E
execNoDeps DepT m ()
codeBlock
  E -> DepT m ()
forall (m :: * -> *). Monad m => E -> DepT m ()
depT_ (E -> DepT m ()) -> E -> DepT m ()
forall a b. (a -> b) -> a -> b
$ Exp E -> E
noRate (Exp E -> E) -> Exp E -> E
forall a b. (a -> b) -> a -> b
$ IfRate -> CondInfo (PrimOr E) -> CodeBlock (PrimOr E) -> Exp E
cons IfRate
ifRate (E -> CondInfo (PrimOr E)
condInfo (E -> CondInfo (PrimOr E)) -> E -> CondInfo (PrimOr E)
forall a b. (a -> b) -> a -> b
$ IfRate -> E -> E
setIfRate IfRate
ifRate E
check) (PrimOr E -> CodeBlock (PrimOr E)
forall a. a -> CodeBlock a
CodeBlock (PrimOr E -> CodeBlock (PrimOr E))
-> PrimOr E -> CodeBlock (PrimOr E)
forall a b. (a -> b) -> a -> b
$ Either Prim E -> PrimOr E
forall a. Either Prim a -> PrimOr a
PrimOr (Either Prim E -> PrimOr E) -> Either Prim E -> PrimOr E
forall a b. (a -> b) -> a -> b
$ E -> Either Prim E
forall a b. b -> Either a b
Right E
block)

------------------------------------------------------
-- imperative if-then-else

setIfRate :: IfRate -> E -> E
setIfRate :: IfRate -> E -> E
setIfRate IfRate
rate = Rate -> E -> E
setRate (IfRate -> Rate
fromIfRate IfRate
rate)

when1 :: Monad m => IfRate -> E -> DepT m () -> DepT m ()
when1 :: forall (m :: * -> *).
Monad m =>
IfRate -> E -> DepT m () -> DepT m ()
when1 IfRate
ifRate E
p DepT m ()
body = DepT m () -> DepT m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (DepT m () -> DepT m ()) -> DepT m () -> DepT m ()
forall a b. (a -> b) -> a -> b
$ IfRate -> E -> DepT m () -> DepT m ()
forall (m :: * -> *).
Monad m =>
IfRate -> E -> DepT m () -> DepT m ()
ifT1 IfRate
ifRate E
p DepT m ()
body

whens :: Monad m => IfRate -> [(E, DepT m ())] -> DepT m () -> DepT m ()
whens :: forall (m :: * -> *).
Monad m =>
IfRate -> [(E, DepT m ())] -> DepT m () -> DepT m ()
whens IfRate
rate [(E, DepT m ())]
bodies DepT m ()
el =
  DepT m () -> DepT m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (DepT m () -> DepT m ()) -> DepT m () -> DepT m ()
forall a b. (a -> b) -> a -> b
$ (DepT m () -> (E, DepT m ()) -> DepT m ())
-> DepT m () -> [(E, DepT m ())] -> DepT m ()
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' DepT m () -> (E, DepT m ()) -> DepT m ()
go DepT m ()
el ([(E, DepT m ())] -> [(E, DepT m ())]
forall a. [a] -> [a]
List.reverse [(E, DepT m ())]
bodies)
  where
    go :: DepT m () -> (E, DepT m ()) -> DepT m ()
go DepT m ()
res (E
check, DepT m ()
th) = IfRate -> E -> DepT m () -> DepT m () -> DepT m ()
forall (m :: * -> *).
Monad m =>
IfRate -> E -> DepT m () -> DepT m () -> DepT m ()
ifT IfRate
rate E
check DepT m ()
th DepT m ()
res

ifElseBlock :: Monad m => IfRate -> E -> DepT m (CodeBlock E) -> DepT m (CodeBlock E) -> DepT m ()
ifElseBlock :: forall (m :: * -> *).
Monad m =>
IfRate
-> E -> DepT m (CodeBlock E) -> DepT m (CodeBlock E) -> DepT m ()
ifElseBlock IfRate
rate E
p DepT m (CodeBlock E)
th DepT m (CodeBlock E)
el = DepT m () -> DepT m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (DepT m () -> DepT m ()) -> DepT m () -> DepT m ()
forall a b. (a -> b) -> a -> b
$ IfRate
-> E -> DepT m (CodeBlock E) -> DepT m (CodeBlock E) -> DepT m ()
forall (m :: * -> *).
Monad m =>
IfRate
-> E -> DepT m (CodeBlock E) -> DepT m (CodeBlock E) -> DepT m ()
ifElseBlock IfRate
rate E
p DepT m (CodeBlock E)
th DepT m (CodeBlock E)
el

untilBlock :: Monad m => IfRate -> E -> DepT m () -> DepT m ()
untilBlock :: forall (m :: * -> *).
Monad m =>
IfRate -> E -> DepT m () -> DepT m ()
untilBlock IfRate
ifRate E
p DepT m ()
body = DepT m () -> DepT m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (DepT m () -> DepT m ()) -> DepT m () -> DepT m ()
forall a b. (a -> b) -> a -> b
$ IfRate -> E -> DepT m () -> DepT m ()
forall (m :: * -> *).
Monad m =>
IfRate -> E -> DepT m () -> DepT m ()
untilT IfRate
ifRate E
p DepT m ()
body

whileBlock :: Monad m => IfRate -> E -> DepT m () -> DepT m ()
whileBlock :: forall (m :: * -> *).
Monad m =>
IfRate -> E -> DepT m () -> DepT m ()
whileBlock IfRate
ifRate E
p DepT m ()
body = DepT m () -> DepT m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (DepT m () -> DepT m ()) -> DepT m () -> DepT m ()
forall a b. (a -> b) -> a -> b
$ IfRate -> E -> DepT m () -> DepT m ()
forall (m :: * -> *).
Monad m =>
IfRate -> E -> DepT m () -> DepT m ()
whileT IfRate
ifRate E
p DepT m ()
body

whileEnd :: Monad m => DepT m ()
whileEnd :: forall (m :: * -> *). Monad m => DepT m ()
whileEnd = Exp E -> DepT m ()
forall (m :: * -> *). Monad m => Exp E -> DepT m ()
stmtOnlyT Exp E
forall a. MainExp a
WhileEnd

instance Boolean E where
    true :: E
true = CondOp -> E
boolOp0 CondOp
TrueOp
    false :: E
false = CondOp -> E
boolOp0 CondOp
FalseOp
    notB :: E -> E
notB = E -> E
notE
    &&* :: E -> E -> E
(&&*) = CondOp -> E -> E -> E
boolOp2 CondOp
And
    ||* :: E -> E -> E
(||*) = CondOp -> E -> E -> E
boolOp2 CondOp
Or

-- instances

type instance BooleanOf E = E

instance EqB E where
    ==* :: forall bool. (bool ~ BooleanOf E) => E -> E -> bool
(==*) = CondOp -> E -> E -> E
boolOp2 CondOp
Equals
    /=* :: forall bool. (bool ~ BooleanOf E) => E -> E -> bool
(/=*) = CondOp -> E -> E -> E
boolOp2 CondOp
NotEquals

instance OrdB E where
    <* :: forall bool. (bool ~ BooleanOf E) => E -> E -> bool
(<*) = CondOp -> E -> E -> E
boolOp2 CondOp
Less
    >* :: forall bool. (bool ~ BooleanOf E) => E -> E -> bool
(>*) = CondOp -> E -> E -> E
boolOp2 CondOp
Greater
    <=* :: forall bool. (bool ~ BooleanOf E) => E -> E -> bool
(<=*) = CondOp -> E -> E -> E
boolOp2 CondOp
LessEquals
    >=* :: forall bool. (bool ~ BooleanOf E) => E -> E -> bool
(>=*) = CondOp -> E -> E -> E
boolOp2 CondOp
GreaterEquals

--------------------------------------------------------------------------
-- if-then-else
--
-- performs inlining of the boolean expressions

boolExp :: a -> [b] -> PreInline a b
boolExp :: forall a b. a -> [b] -> PreInline a b
boolExp = a -> [b] -> PreInline a b
forall a b. a -> [b] -> PreInline a b
PreInline

ifExp :: IfRate -> E -> E -> E -> E
ifExp :: IfRate -> E -> E -> E -> E
ifExp IfRate
ifRate E
c = CondInfo (PrimOr E) -> E -> E -> E
mkCond (E -> CondInfo (PrimOr E)
condInfo (IfRate -> E -> E
setIfRate IfRate
ifRate E
c))
  where
    mkCond :: CondInfo (PrimOr E) -> E -> E -> E
    mkCond :: CondInfo (PrimOr E) -> E -> E -> E
mkCond CondInfo (PrimOr E)
pr E
th E
el
      | CondInfo (PrimOr E) -> Bool
forall a. CondInfo a -> Bool
isTrue CondInfo (PrimOr E)
pr = E
th
      | CondInfo (PrimOr E) -> Bool
forall a. CondInfo a -> Bool
isFalse CondInfo (PrimOr E)
pr = E
el
      | Bool
otherwise = Exp E -> E
noRate (Exp E -> E) -> Exp E -> E
forall a b. (a -> b) -> a -> b
$ IfRate -> CondInfo (PrimOr E) -> PrimOr E -> PrimOr E -> Exp E
forall a. IfRate -> CondInfo a -> a -> a -> MainExp a
If IfRate
ifRate CondInfo (PrimOr E)
pr (E -> PrimOr E
toPrimOr E
th) (E -> PrimOr E
toPrimOr E
el)

condInfo :: E -> CondInfo (PrimOr E)
condInfo :: E -> CondInfo (PrimOr E)
condInfo E
p = PrimOr E -> CondInfo (PrimOr E)
go (PrimOr E -> CondInfo (PrimOr E))
-> PrimOr E -> CondInfo (PrimOr E)
forall a b. (a -> b) -> a -> b
$ E -> PrimOr E
toPrimOr E
p
  where
    go :: PrimOr E -> CondInfo (PrimOr E)
    go :: PrimOr E -> CondInfo (PrimOr E)
go PrimOr E
expr = (\(InlineExp CondOp
a, [(Int, PrimOr E)]
b) -> InlineExp CondOp -> IntMap (PrimOr E) -> CondInfo (PrimOr E)
forall op arg. InlineExp op -> IntMap arg -> Inline op arg
Inline InlineExp CondOp
a ([(Int, PrimOr E)] -> IntMap (PrimOr E)
forall a. [(Int, a)] -> IntMap a
IM.fromList [(Int, PrimOr E)]
b)) ((InlineExp CondOp, [(Int, PrimOr E)]) -> CondInfo (PrimOr E))
-> (InlineExp CondOp, [(Int, PrimOr E)]) -> CondInfo (PrimOr E)
forall a b. (a -> b) -> a -> b
$ State Int (InlineExp CondOp, [(Int, PrimOr E)])
-> Int -> (InlineExp CondOp, [(Int, PrimOr E)])
forall s a. State s a -> s -> a
evalState (PrimOr E -> State Int (InlineExp CondOp, [(Int, PrimOr E)])
condInfo' PrimOr E
expr) Int
0

    condInfo' :: PrimOr E -> State Int (InlineExp CondOp, [(Int, PrimOr E)])
    condInfo' :: PrimOr E -> State Int (InlineExp CondOp, [(Int, PrimOr E)])
condInfo' PrimOr E
e = State Int (InlineExp CondOp, [(Int, PrimOr E)])
-> ((CondOp, [PrimOr E])
    -> State Int (InlineExp CondOp, [(Int, PrimOr E)]))
-> Maybe (CondOp, [PrimOr E])
-> State Int (InlineExp CondOp, [(Int, PrimOr E)])
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (PrimOr E -> State Int (InlineExp CondOp, [(Int, PrimOr E)])
forall {m :: * -> *} {b} {op}.
Monad m =>
b -> StateT Int m (InlineExp op, [(Int, b)])
onLeaf PrimOr E
e) (PrimOr E
-> (CondOp, [PrimOr E])
-> State Int (InlineExp CondOp, [(Int, PrimOr E)])
forall {p}.
p
-> (CondOp, [PrimOr E])
-> State Int (InlineExp CondOp, [(Int, PrimOr E)])
onExpr PrimOr E
e) (Maybe (CondOp, [PrimOr E])
 -> State Int (InlineExp CondOp, [(Int, PrimOr E)]))
-> Maybe (CondOp, [PrimOr E])
-> State Int (InlineExp CondOp, [(Int, PrimOr E)])
forall a b. (a -> b) -> a -> b
$ PrimOr E -> Maybe (CondOp, [PrimOr E])
parseNode PrimOr E
e

    onLeaf :: b -> StateT Int m (InlineExp op, [(Int, b)])
onLeaf b
e = (Int -> ((InlineExp op, [(Int, b)]), Int))
-> StateT Int m (InlineExp op, [(Int, b)])
forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state ((Int -> ((InlineExp op, [(Int, b)]), Int))
 -> StateT Int m (InlineExp op, [(Int, b)]))
-> (Int -> ((InlineExp op, [(Int, b)]), Int))
-> StateT Int m (InlineExp op, [(Int, b)])
forall a b. (a -> b) -> a -> b
$ \Int
n -> ((Int -> InlineExp op
forall op. Int -> InlineExp op
InlinePrim Int
n, [(Int
n, b
e)]), Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)

    onExpr :: p
-> (CondOp, [PrimOr E])
-> State Int (InlineExp CondOp, [(Int, PrimOr E)])
onExpr  p
_ (CondOp
op, [PrimOr E]
args) = ([(InlineExp CondOp, [(Int, PrimOr E)])]
 -> (InlineExp CondOp, [(Int, PrimOr E)]))
-> StateT Int Identity [(InlineExp CondOp, [(Int, PrimOr E)])]
-> State Int (InlineExp CondOp, [(Int, PrimOr E)])
forall a b.
(a -> b) -> StateT Int Identity a -> StateT Int Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(InlineExp CondOp, [(Int, PrimOr E)])]
-> (InlineExp CondOp, [(Int, PrimOr E)])
mkNode (StateT Int Identity [(InlineExp CondOp, [(Int, PrimOr E)])]
 -> State Int (InlineExp CondOp, [(Int, PrimOr E)]))
-> StateT Int Identity [(InlineExp CondOp, [(Int, PrimOr E)])]
-> State Int (InlineExp CondOp, [(Int, PrimOr E)])
forall a b. (a -> b) -> a -> b
$ (PrimOr E -> State Int (InlineExp CondOp, [(Int, PrimOr E)]))
-> [PrimOr E]
-> StateT Int Identity [(InlineExp CondOp, [(Int, PrimOr E)])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM PrimOr E -> State Int (InlineExp CondOp, [(Int, PrimOr E)])
condInfo' [PrimOr E]
args
        where mkNode :: [(InlineExp CondOp, [(Int, PrimOr E)])]
-> (InlineExp CondOp, [(Int, PrimOr E)])
mkNode [(InlineExp CondOp, [(Int, PrimOr E)])]
as = (CondOp -> [InlineExp CondOp] -> InlineExp CondOp
forall op. op -> [InlineExp op] -> InlineExp op
InlineExp CondOp
op (((InlineExp CondOp, [(Int, PrimOr E)]) -> InlineExp CondOp)
-> [(InlineExp CondOp, [(Int, PrimOr E)])] -> [InlineExp CondOp]
forall a b. (a -> b) -> [a] -> [b]
map (InlineExp CondOp, [(Int, PrimOr E)]) -> InlineExp CondOp
forall a b. (a, b) -> a
fst [(InlineExp CondOp, [(Int, PrimOr E)])]
as), [[(Int, PrimOr E)]] -> [(Int, PrimOr E)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(Int, PrimOr E)]] -> [(Int, PrimOr E)])
-> [[(Int, PrimOr E)]] -> [(Int, PrimOr E)]
forall a b. (a -> b) -> a -> b
$ ((InlineExp CondOp, [(Int, PrimOr E)]) -> [(Int, PrimOr E)])
-> [(InlineExp CondOp, [(Int, PrimOr E)])] -> [[(Int, PrimOr E)]]
forall a b. (a -> b) -> [a] -> [b]
map (InlineExp CondOp, [(Int, PrimOr E)]) -> [(Int, PrimOr E)]
forall a b. (a, b) -> b
snd [(InlineExp CondOp, [(Int, PrimOr E)])]
as)

    parseNode :: PrimOr E -> Maybe (CondOp, [PrimOr E])
    parseNode :: PrimOr E -> Maybe (CondOp, [PrimOr E])
parseNode PrimOr E
x = case PrimOr (Exp E) -> Either Prim (Exp E)
forall a. PrimOr a -> Either Prim a
unPrimOr (PrimOr (Exp E) -> Either Prim (Exp E))
-> PrimOr (Exp E) -> Either Prim (Exp E)
forall a b. (a -> b) -> a -> b
$ (E -> Exp E) -> PrimOr E -> PrimOr (Exp E)
forall a b. (a -> b) -> PrimOr a -> PrimOr b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap E -> Exp E
toExp PrimOr E
x of
      Right (ExpBool (PreInline CondOp
op [PrimOr E]
args)) -> (CondOp, [PrimOr E]) -> Maybe (CondOp, [PrimOr E])
forall a. a -> Maybe a
Just (CondOp
op, [PrimOr E]
args)
      Either Prim (Exp E)
_ -> Maybe (CondOp, [PrimOr E])
forall a. Maybe a
Nothing

--------------------------------------------------------------------------------
-- constructors for boolean expressions

boolOps :: CondOp -> [E] -> E
boolOps :: CondOp -> [E] -> E
boolOps CondOp
op [E]
as = Exp E -> E
noRate (Exp E -> E) -> Exp E -> E
forall a b. (a -> b) -> a -> b
$ PreInline CondOp (PrimOr E) -> Exp E
forall a. BoolExp a -> MainExp a
ExpBool (PreInline CondOp (PrimOr E) -> Exp E)
-> PreInline CondOp (PrimOr E) -> Exp E
forall a b. (a -> b) -> a -> b
$ CondOp -> [PrimOr E] -> PreInline CondOp (PrimOr E)
forall a b. a -> [b] -> PreInline a b
boolExp CondOp
op ([PrimOr E] -> PreInline CondOp (PrimOr E))
-> [PrimOr E] -> PreInline CondOp (PrimOr E)
forall a b. (a -> b) -> a -> b
$ (E -> PrimOr E) -> [E] -> [PrimOr E]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap E -> PrimOr E
toPrimOr [E]
as

boolOp0 :: CondOp -> E
boolOp2 :: CondOp -> E -> E -> E

boolOp0 :: CondOp -> E
boolOp0 CondOp
op = CondOp -> [E] -> E
boolOps CondOp
op []

boolOp2 :: CondOp -> E -> E -> E
boolOp2 CondOp
op E
a E
b = CondOp -> [E] -> E
boolOps CondOp
op [E
a, E
b]

-----------------------------------------------------------------------------
-- no support for not in csound so we perform not-elimination
notE :: E -> E
notE :: E -> E
notE E
x = (Exp E -> Exp E) -> E -> E
onExp Exp E -> Exp E
forall {f :: * -> *}. Functor f => MainExp (f E) -> MainExp (f E)
phi E
x
    where phi :: MainExp (f E) -> MainExp (f E)
phi (ExpBool (PreInline CondOp
op [f E]
args)) = PreInline CondOp (f E) -> MainExp (f E)
forall a. BoolExp a -> MainExp a
ExpBool (PreInline CondOp (f E) -> MainExp (f E))
-> PreInline CondOp (f E) -> MainExp (f E)
forall a b. (a -> b) -> a -> b
$ case CondOp
op of
            CondOp
TrueOp            -> CondOp -> [f E] -> PreInline CondOp (f E)
forall a b. a -> [b] -> PreInline a b
boolExp CondOp
FalseOp        []
            CondOp
FalseOp           -> CondOp -> [f E] -> PreInline CondOp (f E)
forall a b. a -> [b] -> PreInline a b
boolExp CondOp
TrueOp         []
            CondOp
And               -> CondOp -> [f E] -> PreInline CondOp (f E)
forall a b. a -> [b] -> PreInline a b
boolExp CondOp
Or             ([f E] -> PreInline CondOp (f E))
-> [f E] -> PreInline CondOp (f E)
forall a b. (a -> b) -> a -> b
$ (f E -> f E) -> [f E] -> [f E]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((E -> E) -> f E -> f E
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap E -> E
notE) [f E]
args
            CondOp
Or                -> CondOp -> [f E] -> PreInline CondOp (f E)
forall a b. a -> [b] -> PreInline a b
boolExp CondOp
And            ([f E] -> PreInline CondOp (f E))
-> [f E] -> PreInline CondOp (f E)
forall a b. (a -> b) -> a -> b
$ (f E -> f E) -> [f E] -> [f E]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((E -> E) -> f E -> f E
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap E -> E
notE) [f E]
args
            CondOp
Equals            -> CondOp -> [f E] -> PreInline CondOp (f E)
forall a b. a -> [b] -> PreInline a b
boolExp CondOp
NotEquals      [f E]
args
            CondOp
NotEquals         -> CondOp -> [f E] -> PreInline CondOp (f E)
forall a b. a -> [b] -> PreInline a b
boolExp CondOp
Equals         [f E]
args
            CondOp
Less              -> CondOp -> [f E] -> PreInline CondOp (f E)
forall a b. a -> [b] -> PreInline a b
boolExp CondOp
GreaterEquals  [f E]
args
            CondOp
Greater           -> CondOp -> [f E] -> PreInline CondOp (f E)
forall a b. a -> [b] -> PreInline a b
boolExp CondOp
LessEquals     [f E]
args
            CondOp
LessEquals        -> CondOp -> [f E] -> PreInline CondOp (f E)
forall a b. a -> [b] -> PreInline a b
boolExp CondOp
Greater        [f E]
args
            CondOp
GreaterEquals     -> CondOp -> [f E] -> PreInline CondOp (f E)
forall a b. a -> [b] -> PreInline a b
boolExp CondOp
Less           [f E]
args

          phi MainExp (f E)
_ = [Char] -> MainExp (f E)
forall a. HasCallStack => [Char] -> a
error [Char]
"Logic.hs:notE - expression is not Boolean"