module Csound.Dynamic.Render.Pretty(
    Doc, vcatSep,
    ppCsdFile, ppGen, ppNotes, ppInstr, ppStmt, ppTotalDur
) where

import Control.Monad.Trans.State.Strict
import Data.Char(toLower)
import qualified Data.IntMap as IM

import Text.PrettyPrint.Leijen
import Csound.Dynamic.Types
import qualified Csound.Dynamic.Tfm.DeduceTypes as R(Var(..))

vcatSep :: [Doc] -> Doc
vcatSep :: [Doc] -> Doc
vcatSep = [Doc] -> Doc
vcat ([Doc] -> Doc) -> ([Doc] -> [Doc]) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
line

binaries, unaries :: String -> [Doc] -> Doc

binaries :: String -> [Doc] -> Doc
binaries String
op [Doc]
as = String -> Doc -> Doc -> Doc
binary String
op ([Doc]
as [Doc] -> Int -> Doc
forall a. [a] -> Int -> a
!! Int
0) ([Doc]
as [Doc] -> Int -> Doc
forall a. [a] -> Int -> a
!! Int
1)
unaries :: String -> [Doc] -> Doc
unaries  String
op [Doc]
as = String -> Doc -> Doc
unary  String
op ([Doc]
as [Doc] -> Int -> Doc
forall a. [a] -> Int -> a
!! Int
0)

binary :: String -> Doc -> Doc -> Doc
binary :: String -> Doc -> Doc -> Doc
binary String
op Doc
a Doc
b = Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc
a Doc -> Doc -> Doc
<+> String -> Doc
text String
op Doc -> Doc -> Doc
<+> Doc
b

unary :: String -> Doc -> Doc
unary :: String -> Doc -> Doc
unary String
op Doc
a = Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
op Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
a

func :: String -> Doc -> Doc
func :: String -> Doc -> Doc
func String
op Doc
a = String -> Doc
text String
op Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens Doc
a

ppCsdFile :: Doc -> Doc -> Doc -> [Plugin] -> Doc
ppCsdFile :: Doc -> Doc -> Doc -> [Plugin] -> Doc
ppCsdFile Doc
flags Doc
orc Doc
sco [Plugin]
plugins =
    String -> Doc -> Doc
tag String
"CsoundSynthesizer" (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcatSep [
        String -> Doc -> Doc
tag String
"CsOptions" Doc
flags,
        String -> Doc -> Doc
tag String
"CsInstruments" Doc
orc,
        String -> Doc -> Doc
tag String
"CsScore" Doc
sco,
        [Plugin] -> Doc
ppPlugins [Plugin]
plugins
        ]

ppPlugins :: [Plugin] -> Doc
ppPlugins :: [Plugin] -> Doc
ppPlugins [Plugin]
plugins = [Doc] -> Doc
vcatSep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Plugin -> Doc) -> [Plugin] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Plugin String
name String
body) -> String -> Doc -> Doc
tag String
name (String -> Doc
text String
body)) [Plugin]
plugins

tag :: String -> Doc -> Doc
tag :: String -> Doc -> Doc
tag String
name Doc
content = [Doc] -> Doc
vcatSep [
    Char -> Doc
char Char
'<' Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
name Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Char -> Doc
char Char
'>',
    Doc
content,
    String -> Doc
text String
"</" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
name Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Char -> Doc
char Char
'>']

ppNotes :: InstrId -> [CsdEvent] -> Doc
ppNotes :: InstrId -> [CsdEvent] -> Doc
ppNotes InstrId
instrId = [Doc] -> Doc
vcat ([Doc] -> Doc) -> ([CsdEvent] -> [Doc]) -> [CsdEvent] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CsdEvent -> Doc) -> [CsdEvent] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (InstrId -> CsdEvent -> Doc
ppNote InstrId
instrId)

ppNote :: InstrId -> CsdEvent -> Doc
ppNote :: InstrId -> CsdEvent -> Doc
ppNote InstrId
instrId CsdEvent
evt = Char -> Doc
char Char
'i'
    Doc -> Doc -> Doc
<+> InstrId -> Doc
ppInstrId InstrId
instrId
    Doc -> Doc -> Doc
<+> Double -> Doc
double (CsdEvent -> Double
csdEventStart CsdEvent
evt) Doc -> Doc -> Doc
<+> Double -> Doc
double (CsdEvent -> Double
csdEventDur CsdEvent
evt)
    Doc -> Doc -> Doc
<+> [Doc] -> Doc
hsep ((Prim -> Doc) -> [Prim] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Prim -> Doc
ppPrim ([Prim] -> [Doc]) -> [Prim] -> [Doc]
forall a b. (a -> b) -> a -> b
$ CsdEvent -> [Prim]
csdEventContent CsdEvent
evt)

ppPrim :: Prim -> Doc
ppPrim :: Prim -> Doc
ppPrim Prim
x = case Prim
x of
    P Int
n -> Char -> Doc
char Char
'p' Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Doc
int Int
n
    PrimInstrId InstrId
a -> InstrId -> Doc
ppInstrId InstrId
a
    PString Int
a -> Int -> Doc
int Int
a
    PrimInt Int
n -> Int -> Doc
int Int
n
    PrimDouble Double
d -> Double -> Doc
double Double
d
    PrimString String
s -> Doc -> Doc
dquotes (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
s
    PrimVar Rate
targetRate Var
v -> Rate -> Rate -> Doc -> Doc
ppConverter Rate
targetRate (Var -> Rate
varRate Var
v) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Var -> Doc
ppVar Var
v
    where
        ppConverter :: Rate -> Rate -> Doc -> Doc
ppConverter Rate
dst Rate
src Doc
t
            | Rate
dst Rate -> Rate -> Bool
forall a. Eq a => a -> a -> Bool
== Rate
src = Doc
t
            | Rate
dst Rate -> Rate -> Bool
forall a. Eq a => a -> a -> Bool
== Rate
Ar Bool -> Bool -> Bool
&& Rate
src Rate -> Rate -> Bool
forall a. Eq a => a -> a -> Bool
== Rate
Kr = Doc -> Doc
a(Doc
t)
            | Rate
dst Rate -> Rate -> Bool
forall a. Eq a => a -> a -> Bool
== Rate
Ar Bool -> Bool -> Bool
&& Rate
src Rate -> Rate -> Bool
forall a. Eq a => a -> a -> Bool
== Rate
Ir = Doc -> Doc
a(Doc -> Doc
k(Doc
t))
            | Rate
dst Rate -> Rate -> Bool
forall a. Eq a => a -> a -> Bool
== Rate
Kr  = Doc -> Doc
k(Doc
t)
            | Rate
dst Rate -> Rate -> Bool
forall a. Eq a => a -> a -> Bool
== Rate
Ir Bool -> Bool -> Bool
&& Rate
src Rate -> Rate -> Bool
forall a. Eq a => a -> a -> Bool
== Rate
Kr = Doc -> Doc
i(Doc
t)
            | Rate
dst Rate -> Rate -> Bool
forall a. Eq a => a -> a -> Bool
== Rate
Ir Bool -> Bool -> Bool
&& Rate
src Rate -> Rate -> Bool
forall a. Eq a => a -> a -> Bool
== Rate
Ar = Doc -> Doc
i(Doc -> Doc
k(Doc
t))
            | Bool
otherwise = Doc
t
            where
                tfm :: Char -> Doc -> Doc
tfm Char
ch Doc
v = [Doc] -> Doc
hcat [Char -> Doc
char Char
ch, Doc -> Doc
parens Doc
v]
                a :: Doc -> Doc
a = Char -> Doc -> Doc
tfm Char
'a'
                k :: Doc -> Doc
k = Char -> Doc -> Doc
tfm Char
'k'
                i :: Doc -> Doc
i = Char -> Doc -> Doc
tfm Char
'i'


ppGen :: Int -> Gen -> Doc
ppGen :: Int -> Gen -> Doc
ppGen Int
tabId Gen
ft = Char -> Doc
char Char
'f'
    Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>  Int -> Doc
int Int
tabId
    Doc -> Doc -> Doc
<+> Int -> Doc
int Int
0
    Doc -> Doc -> Doc
<+> (Int -> Doc
int (Int -> Doc) -> Int -> Doc
forall a b. (a -> b) -> a -> b
$ Gen -> Int
genSize Gen
ft)
    Doc -> Doc -> Doc
<+> (GenId -> Doc
ppGenId (GenId -> Doc) -> GenId -> Doc
forall a b. (a -> b) -> a -> b
$ Gen -> GenId
genId Gen
ft)
    Doc -> Doc -> Doc
<+> (Doc -> (String -> Doc) -> Maybe String -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
empty (String -> Doc
text (String -> Doc) -> (String -> String) -> String -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. Show a => a -> String
show) (Maybe String -> Doc) -> Maybe String -> Doc
forall a b. (a -> b) -> a -> b
$ Gen -> Maybe String
genFile Gen
ft)
    Doc -> Doc -> Doc
<+> ([Doc] -> Doc
hsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Double -> Doc) -> [Double] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Double -> Doc
double ([Double] -> [Doc]) -> [Double] -> [Doc]
forall a b. (a -> b) -> a -> b
$ Gen -> [Double]
genArgs Gen
ft)

ppGenId :: GenId -> Doc
ppGenId :: GenId -> Doc
ppGenId GenId
x = case GenId
x of
    IntGenId Int
a      -> Int -> Doc
int Int
a
    StringGenId String
a   -> Doc -> Doc
dquotes (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
a

ppInstr :: InstrId -> Doc -> Doc
ppInstr :: InstrId -> Doc -> Doc
ppInstr InstrId
instrId Doc
body = [Doc] -> Doc
vcat [
    String -> Doc
text String
"instr" Doc -> Doc -> Doc
<+> InstrId -> Doc
ppInstrHeadId InstrId
instrId,
    Doc
body,
    String -> Doc
text String
"endin"]

ppInstrHeadId :: InstrId -> Doc
ppInstrHeadId :: InstrId -> Doc
ppInstrHeadId InstrId
x = case InstrId
x of
    InstrId Maybe Int
den Int
nom -> Int -> Doc
int Int
nom Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> (Int -> Doc) -> Maybe Int -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
empty Int -> Doc
forall a. Show a => a -> Doc
ppAfterDot Maybe Int
den
    InstrLabel String
name -> String -> Doc
text String
name
    where ppAfterDot :: a -> Doc
ppAfterDot a
a = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ (Char
'.'Char -> String -> String
forall a. a -> [a] -> [a]
: ) (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. [a] -> [a]
reverse (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. Show a => a -> String
show a
a

ppInstrId :: InstrId -> Doc
ppInstrId :: InstrId -> Doc
ppInstrId InstrId
x = case InstrId
x of
    InstrId Maybe Int
den Int
nom -> Int -> Doc
int Int
nom Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> (Int -> Doc) -> Maybe Int -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
empty Int -> Doc
forall a. Show a => a -> Doc
ppAfterDot Maybe Int
den
    InstrLabel String
name -> Doc -> Doc
dquotes (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
name
    where ppAfterDot :: a -> Doc
ppAfterDot a
a = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ (Char
'.'Char -> String -> String
forall a. a -> [a] -> [a]
: ) (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. [a] -> [a]
reverse (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. Show a => a -> String
show a
a

type TabDepth = Int

ppStmt :: [RatedVar] -> Exp RatedVar -> State TabDepth Doc
ppStmt :: [RatedVar] -> Exp RatedVar -> State Int Doc
ppStmt [RatedVar]
outs Exp RatedVar
expr = State Int Doc
-> (State Int Doc -> State Int Doc)
-> Maybe (State Int Doc)
-> State Int Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Doc -> Exp RatedVar -> State Int Doc
ppExp ([RatedVar] -> Doc
ppOuts [RatedVar]
outs) Exp RatedVar
expr) State Int Doc -> State Int Doc
forall a. a -> a
id ([RatedVar] -> Exp RatedVar -> Maybe (State Int Doc)
maybeStringCopy [RatedVar]
outs Exp RatedVar
expr)

maybeStringCopy :: [RatedVar] -> Exp RatedVar -> Maybe (State TabDepth Doc)
maybeStringCopy :: [RatedVar] -> Exp RatedVar -> Maybe (State Int Doc)
maybeStringCopy [RatedVar]
outs Exp RatedVar
expr = case ([RatedVar]
outs, Exp RatedVar
expr) of
    ([R.Var Int
_ Rate
Sr], ExpPrim (PrimVar Rate
_rate Var
var)) -> State Int Doc -> Maybe (State Int Doc)
forall a. a -> Maybe a
Just (State Int Doc -> Maybe (State Int Doc))
-> State Int Doc -> Maybe (State Int Doc)
forall a b. (a -> b) -> a -> b
$ Doc -> State Int Doc
forall (m :: * -> *). Monad m => Doc -> StateT Int m Doc
tab (Doc -> State Int Doc) -> Doc -> State Int Doc
forall a b. (a -> b) -> a -> b
$ Doc -> Doc -> Doc
ppStringCopy ([RatedVar] -> Doc
ppOuts [RatedVar]
outs) (Var -> Doc
ppVar Var
var)
    ([R.Var Int
_ Rate
Sr], ReadVar Var
var) -> State Int Doc -> Maybe (State Int Doc)
forall a. a -> Maybe a
Just (State Int Doc -> Maybe (State Int Doc))
-> State Int Doc -> Maybe (State Int Doc)
forall a b. (a -> b) -> a -> b
$ Doc -> State Int Doc
forall (m :: * -> *). Monad m => Doc -> StateT Int m Doc
tab (Doc -> State Int Doc) -> Doc -> State Int Doc
forall a b. (a -> b) -> a -> b
$ Doc -> Doc -> Doc
ppStringCopy ([RatedVar] -> Doc
ppOuts [RatedVar]
outs) (Var -> Doc
ppVar Var
var)
    ([], WriteVar Var
outVar PrimOr RatedVar
a) | Var -> Rate
varRate Var
outVar Rate -> Rate -> Bool
forall a. Eq a => a -> a -> Bool
== Rate
Sr  -> State Int Doc -> Maybe (State Int Doc)
forall a. a -> Maybe a
Just (State Int Doc -> Maybe (State Int Doc))
-> State Int Doc -> Maybe (State Int Doc)
forall a b. (a -> b) -> a -> b
$ Doc -> State Int Doc
forall (m :: * -> *). Monad m => Doc -> StateT Int m Doc
tab (Doc -> State Int Doc) -> Doc -> State Int Doc
forall a b. (a -> b) -> a -> b
$ Doc -> Doc -> Doc
ppStringCopy (Var -> Doc
ppVar Var
outVar) (PrimOr RatedVar -> Doc
ppPrimOrVar PrimOr RatedVar
a)
    ([R.Var Int
_ Rate
Sr], ReadArr Var
var ArrIndex (PrimOr RatedVar)
as) -> State Int Doc -> Maybe (State Int Doc)
forall a. a -> Maybe a
Just (State Int Doc -> Maybe (State Int Doc))
-> State Int Doc -> Maybe (State Int Doc)
forall a b. (a -> b) -> a -> b
$ Doc -> State Int Doc
forall (m :: * -> *). Monad m => Doc -> StateT Int m Doc
tab (Doc -> State Int Doc) -> Doc -> State Int Doc
forall a b. (a -> b) -> a -> b
$ Doc -> Doc -> Doc
ppStringCopy ([RatedVar] -> Doc
ppOuts [RatedVar]
outs) (Var -> [Doc] -> Doc
ppReadArr Var
var ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (PrimOr RatedVar -> Doc) -> ArrIndex (PrimOr RatedVar) -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PrimOr RatedVar -> Doc
ppPrimOrVar ArrIndex (PrimOr RatedVar)
as)
    ([], WriteArr Var
outVar ArrIndex (PrimOr RatedVar)
bs PrimOr RatedVar
a) | Var -> Rate
varRate Var
outVar Rate -> Rate -> Bool
forall a. Eq a => a -> a -> Bool
== Rate
Sr -> State Int Doc -> Maybe (State Int Doc)
forall a. a -> Maybe a
Just (State Int Doc -> Maybe (State Int Doc))
-> State Int Doc -> Maybe (State Int Doc)
forall a b. (a -> b) -> a -> b
$ Doc -> State Int Doc
forall (m :: * -> *). Monad m => Doc -> StateT Int m Doc
tab (Doc -> State Int Doc) -> Doc -> State Int Doc
forall a b. (a -> b) -> a -> b
$ Doc -> Doc -> Doc
ppStringCopy (Var -> [Doc] -> Doc
ppArrIndex Var
outVar ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (PrimOr RatedVar -> Doc) -> ArrIndex (PrimOr RatedVar) -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PrimOr RatedVar -> Doc
ppPrimOrVar ArrIndex (PrimOr RatedVar)
bs) (PrimOr RatedVar -> Doc
ppPrimOrVar PrimOr RatedVar
a)
    ([RatedVar], Exp RatedVar)
_ -> Maybe (State Int Doc)
forall a. Maybe a
Nothing

ppStringCopy :: Doc -> Doc -> Doc
ppStringCopy :: Doc -> Doc -> Doc
ppStringCopy Doc
outs Doc
src = Doc -> String -> [Doc] -> Doc
ppOpc Doc
outs String
"strcpyk" [Doc
src]

ppExp :: Doc -> Exp RatedVar -> State TabDepth Doc
ppExp :: Doc -> Exp RatedVar -> State Int Doc
ppExp Doc
res Exp RatedVar
expr = case (PrimOr RatedVar -> Doc) -> Exp RatedVar -> MainExp Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PrimOr RatedVar -> Doc
ppPrimOrVar Exp RatedVar
expr of
    ExpPrim (PString Int
n)             -> Doc -> State Int Doc
forall (m :: * -> *). Monad m => Doc -> StateT Int m Doc
tab (Doc -> State Int Doc) -> Doc -> State Int Doc
forall a b. (a -> b) -> a -> b
$ Doc -> Int -> Doc
ppStrget Doc
res Int
n
    ExpPrim Prim
p                       -> Doc -> State Int Doc
forall (m :: * -> *). Monad m => Doc -> StateT Int m Doc
tab (Doc -> State Int Doc) -> Doc -> State Int Doc
forall a b. (a -> b) -> a -> b
$ Doc
res Doc -> Doc -> Doc
$= Prim -> Doc
ppPrim Prim
p
    Tfm Info
info [Doc
a, Doc
b] | Info -> Bool
isInfix  Info
info -> Doc -> State Int Doc
forall (m :: * -> *). Monad m => Doc -> StateT Int m Doc
tab (Doc -> State Int Doc) -> Doc -> State Int Doc
forall a b. (a -> b) -> a -> b
$ Doc
res Doc -> Doc -> Doc
$= String -> Doc -> Doc -> Doc
binary (Info -> String
infoName Info
info) Doc
a Doc
b
    Tfm Info
info [Doc]
xs     | Info -> Bool
isPrefix Info
info -> Doc -> State Int Doc
forall (m :: * -> *). Monad m => Doc -> StateT Int m Doc
tab (Doc -> State Int Doc) -> Doc -> State Int Doc
forall a b. (a -> b) -> a -> b
$ Doc
res Doc -> Doc -> Doc
$= String -> [Doc] -> Doc
prefix (Info -> String
infoName Info
info) [Doc]
xs
    Tfm Info
info [Doc]
xs                     -> Doc -> State Int Doc
forall (m :: * -> *). Monad m => Doc -> StateT Int m Doc
tab (Doc -> State Int Doc) -> Doc -> State Int Doc
forall a b. (a -> b) -> a -> b
$ Doc -> String -> [Doc] -> Doc
ppOpc Doc
res (Info -> String
infoName Info
info) [Doc]
xs
    ConvertRate Rate
to Rate
from Doc
x           -> Doc -> State Int Doc
forall (m :: * -> *). Monad m => Doc -> StateT Int m Doc
tab (Doc -> State Int Doc) -> Doc -> State Int Doc
forall a b. (a -> b) -> a -> b
$ Doc -> Rate -> Rate -> Doc -> Doc
ppConvertRate Doc
res Rate
to Rate
from Doc
x
    If CondInfo Doc
info Doc
t Doc
e                     -> Doc -> State Int Doc
forall (m :: * -> *). Monad m => Doc -> StateT Int m Doc
tab (Doc -> State Int Doc) -> Doc -> State Int Doc
forall a b. (a -> b) -> a -> b
$ Doc -> Doc -> Doc -> Doc -> Doc
ppIf Doc
res (CondInfo Doc -> Doc
ppCond CondInfo Doc
info) Doc
t Doc
e
    ExpNum (PreInline NumOp
op [Doc]
as)        -> Doc -> State Int Doc
forall (m :: * -> *). Monad m => Doc -> StateT Int m Doc
tab (Doc -> State Int Doc) -> Doc -> State Int Doc
forall a b. (a -> b) -> a -> b
$ Doc
res Doc -> Doc -> Doc
$= NumOp -> [Doc] -> Doc
ppNumOp NumOp
op [Doc]
as
    WriteVar Var
v Doc
a                    -> Doc -> State Int Doc
forall (m :: * -> *). Monad m => Doc -> StateT Int m Doc
tab (Doc -> State Int Doc) -> Doc -> State Int Doc
forall a b. (a -> b) -> a -> b
$ Var -> Doc
ppVar Var
v Doc -> Doc -> Doc
$= Doc
a
    InitVar Var
v Doc
a                     -> Doc -> State Int Doc
forall (m :: * -> *). Monad m => Doc -> StateT Int m Doc
tab (Doc -> State Int Doc) -> Doc -> State Int Doc
forall a b. (a -> b) -> a -> b
$ Doc -> String -> [Doc] -> Doc
ppOpc (Var -> Doc
ppVar Var
v) String
"init" [Doc
a]
    ReadVar Var
v                       -> Doc -> State Int Doc
forall (m :: * -> *). Monad m => Doc -> StateT Int m Doc
tab (Doc -> State Int Doc) -> Doc -> State Int Doc
forall a b. (a -> b) -> a -> b
$ Doc
res Doc -> Doc -> Doc
$= Var -> Doc
ppVar Var
v

    InitArr Var
v [Doc]
as                    -> Doc -> State Int Doc
forall (m :: * -> *). Monad m => Doc -> StateT Int m Doc
tab (Doc -> State Int Doc) -> Doc -> State Int Doc
forall a b. (a -> b) -> a -> b
$ Doc -> String -> [Doc] -> Doc
ppOpc (Int -> Var -> Doc
ppArrVar ([Doc] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Doc]
as) Var
v) String
"init" [Doc]
as
    ReadArr Var
v [Doc]
as                    -> Doc -> State Int Doc
forall (m :: * -> *). Monad m => Doc -> StateT Int m Doc
tab (Doc -> State Int Doc) -> Doc -> State Int Doc
forall a b. (a -> b) -> a -> b
$ if (Var -> Rate
varRate Var
v Rate -> Rate -> Bool
forall a. Eq a => a -> a -> Bool
/= Rate
Sr) then Doc
res Doc -> Doc -> Doc
$= Var -> [Doc] -> Doc
ppReadArr Var
v [Doc]
as else Doc
res Doc -> Doc -> Doc
<+> String -> Doc
text String
"strcpy" Doc -> Doc -> Doc
<+> Var -> [Doc] -> Doc
ppReadArr Var
v [Doc]
as
    WriteArr Var
v [Doc]
as Doc
b                 -> Doc -> State Int Doc
forall (m :: * -> *). Monad m => Doc -> StateT Int m Doc
tab (Doc -> State Int Doc) -> Doc -> State Int Doc
forall a b. (a -> b) -> a -> b
$ Var -> [Doc] -> Doc -> Doc
ppWriteArr Var
v [Doc]
as Doc
b
    WriteInitArr Var
v [Doc]
as Doc
b             -> Doc -> State Int Doc
forall (m :: * -> *). Monad m => Doc -> StateT Int m Doc
tab (Doc -> State Int Doc) -> Doc -> State Int Doc
forall a b. (a -> b) -> a -> b
$ Var -> [Doc] -> Doc -> Doc
ppWriteInitArr Var
v [Doc]
as Doc
b
    TfmArr Bool
isInit Var
v Info
op [Doc
a,Doc
b]| Info -> Bool
isInfix  Info
op  -> Doc -> State Int Doc
forall (m :: * -> *). Monad m => Doc -> StateT Int m Doc
tab (Doc -> State Int Doc) -> Doc -> State Int Doc
forall a b. (a -> b) -> a -> b
$ Bool -> Var -> Doc
ppTfmArrOut Bool
isInit Var
v Doc -> Doc -> Doc
<+> String -> Doc -> Doc -> Doc
binary (Info -> String
infoName Info
op) Doc
a Doc
b
    TfmArr Bool
isInit Var
v Info
op [Doc]
args | Info -> Bool
isPrefix Info
op  -> Doc -> State Int Doc
forall (m :: * -> *). Monad m => Doc -> StateT Int m Doc
tab (Doc -> State Int Doc) -> Doc -> State Int Doc
forall a b. (a -> b) -> a -> b
$ Bool -> Var -> Doc
ppTfmArrOut Bool
isInit Var
v Doc -> Doc -> Doc
<+> String -> [Doc] -> Doc
prefix (Info -> String
infoName Info
op) [Doc]
args
    TfmArr Bool
isInit Var
v Info
op [Doc]
xs                  -> Doc -> State Int Doc
forall (m :: * -> *). Monad m => Doc -> StateT Int m Doc
tab (Doc -> State Int Doc) -> Doc -> State Int Doc
forall a b. (a -> b) -> a -> b
$ Doc -> String -> [Doc] -> Doc
ppOpc (Bool -> Var -> Doc
ppTfmArrOut Bool
isInit Var
v) (Info -> String
infoName Info
op) [Doc]
xs

    IfBegin Rate
_ CondInfo Doc
a                     -> Doc -> State Int Doc
forall (m :: * -> *). Monad m => Doc -> StateT Int m Doc
succTab          (Doc -> State Int Doc) -> Doc -> State Int Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"if "     Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> CondInfo Doc -> Doc
ppCond CondInfo Doc
a Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
" then"
--     ElseIfBegin a                   -> left >> (succTab $ text "elseif " <> ppCond a <> text " then")
    MainExp Doc
ElseBegin                       -> State Int ()
left State Int () -> State Int Doc -> State Int Doc
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Doc -> State Int Doc
forall (m :: * -> *). Monad m => Doc -> StateT Int m Doc
succTab (Doc -> State Int Doc) -> Doc -> State Int Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"else")
    MainExp Doc
IfEnd                           -> State Int ()
left State Int () -> State Int Doc -> State Int Doc
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Doc -> State Int Doc
forall (m :: * -> *). Monad m => Doc -> StateT Int m Doc
tab     (Doc -> State Int Doc) -> Doc -> State Int Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"endif")
    UntilBegin CondInfo Doc
a                    -> Doc -> State Int Doc
forall (m :: * -> *). Monad m => Doc -> StateT Int m Doc
succTab          (Doc -> State Int Doc) -> Doc -> State Int Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"until " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> CondInfo Doc -> Doc
ppCond CondInfo Doc
a Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
" do"
    MainExp Doc
UntilEnd                        -> State Int ()
left State Int () -> State Int Doc -> State Int Doc
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Doc -> State Int Doc
forall (m :: * -> *). Monad m => Doc -> StateT Int m Doc
tab     (Doc -> State Int Doc) -> Doc -> State Int Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"od")
    WhileBegin CondInfo Doc
a                    -> Doc -> State Int Doc
forall (m :: * -> *). Monad m => Doc -> StateT Int m Doc
succTab          (Doc -> State Int Doc) -> Doc -> State Int Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"while " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> CondInfo Doc -> Doc
ppCond CondInfo Doc
a Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
" do"
    WhileRefBegin Var
var               -> Doc -> State Int Doc
forall (m :: * -> *). Monad m => Doc -> StateT Int m Doc
succTab          (Doc -> State Int Doc) -> Doc -> State Int Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"while " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Var -> Doc
ppVar Var
var Doc -> Doc -> Doc
<+> Doc
equals Doc -> Doc -> Doc
<+> String -> Doc
text String
"1" Doc -> Doc -> Doc
<+> String -> Doc
text String
"do"
    MainExp Doc
WhileEnd                        -> State Int ()
left State Int () -> State Int Doc -> State Int Doc
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (Doc -> State Int Doc
forall (m :: * -> *). Monad m => Doc -> StateT Int m Doc
tab     (Doc -> State Int Doc) -> Doc -> State Int Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"od")
    InitMacrosString String
name String
initValue -> Doc -> State Int Doc
forall (m :: * -> *). Monad m => Doc -> StateT Int m Doc
tab (Doc -> State Int Doc) -> Doc -> State Int Doc
forall a b. (a -> b) -> a -> b
$ Doc -> Doc -> Doc
initMacros (String -> Doc
text String
name) (String -> Doc
text String
initValue)
    InitMacrosDouble String
name Double
initValue -> Doc -> State Int Doc
forall (m :: * -> *). Monad m => Doc -> StateT Int m Doc
tab (Doc -> State Int Doc) -> Doc -> State Int Doc
forall a b. (a -> b) -> a -> b
$ Doc -> Doc -> Doc
initMacros (String -> Doc
text String
name) (Double -> Doc
double Double
initValue)
    InitMacrosInt String
name Int
initValue    -> Doc -> State Int Doc
forall (m :: * -> *). Monad m => Doc -> StateT Int m Doc
tab (Doc -> State Int Doc) -> Doc -> State Int Doc
forall a b. (a -> b) -> a -> b
$ Doc -> Doc -> Doc
initMacros (String -> Doc
text String
name) (Int -> Doc
int Int
initValue)
    ReadMacrosString String
name           -> Doc -> State Int Doc
forall (m :: * -> *). Monad m => Doc -> StateT Int m Doc
tab (Doc -> State Int Doc) -> Doc -> State Int Doc
forall a b. (a -> b) -> a -> b
$ Doc
res Doc -> Doc -> Doc
<+> String -> Doc
text String
"strcpy" Doc -> Doc -> Doc
<+> String -> Doc
readMacro String
name
    ReadMacrosDouble String
name           -> Doc -> State Int Doc
forall (m :: * -> *). Monad m => Doc -> StateT Int m Doc
tab (Doc -> State Int Doc) -> Doc -> State Int Doc
forall a b. (a -> b) -> a -> b
$ Doc
res Doc -> Doc -> Doc
$= String -> Doc
readMacro String
name
    ReadMacrosInt String
name              -> Doc -> State Int Doc
forall (m :: * -> *). Monad m => Doc -> StateT Int m Doc
tab (Doc -> State Int Doc) -> Doc -> State Int Doc
forall a b. (a -> b) -> a -> b
$ Doc
res Doc -> Doc -> Doc
$= String -> Doc
readMacro String
name
    MainExp Doc
EmptyExp                        -> Doc -> State Int Doc
forall (m :: * -> *) a. Monad m => a -> m a
return Doc
empty
    Verbatim String
str                    -> Doc -> State Int Doc
forall (m :: * -> *) a. Monad m => a -> m a
return (Doc -> State Int Doc) -> Doc -> State Int Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
str
    MainExp Doc
x -> String -> State Int Doc
forall a. HasCallStack => String -> a
error (String -> State Int Doc) -> String -> State Int Doc
forall a b. (a -> b) -> a -> b
$ String
"unknown expression: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ MainExp Doc -> String
forall a. Show a => a -> String
show MainExp Doc
x


-- pp macros

readMacro :: String -> Doc
readMacro :: String -> Doc
readMacro String
name = Char -> Doc
char Char
'$' Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
name

initMacros :: Doc -> Doc -> Doc
initMacros :: Doc -> Doc -> Doc
initMacros Doc
name Doc
initValue = [Doc] -> Doc
vcat
    [ String -> Doc
text String
"#ifndef" Doc -> Doc -> Doc
<+> Doc
name
    , String -> Doc
text String
"#define " Doc -> Doc -> Doc
<+> Doc
name Doc -> Doc -> Doc
<+> Char -> Doc
char Char
'#' Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
initValue Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Char -> Doc
char Char
'#'
    , String -> Doc
text String
"#end"
    ]

-- pp arrays

ppTfmArrOut :: Bool -> Var -> Doc
ppTfmArrOut :: Bool -> Var -> Doc
ppTfmArrOut Bool
isInit Var
v = Var -> Doc
ppVar Var
v Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> (if Bool
isInit then (String -> Doc
text String
"[]") else Doc
empty)

ppArrIndex :: Var -> [Doc] -> Doc
ppArrIndex :: Var -> [Doc] -> Doc
ppArrIndex Var
v [Doc]
as = Var -> Doc
ppVar Var
v Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> ([Doc] -> Doc
hcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Doc -> Doc) -> [Doc] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Doc -> Doc
brackets [Doc]
as)

ppArrVar :: Int -> Var -> Doc
ppArrVar :: Int -> Var -> Doc
ppArrVar Int
n Var
v = Var -> Doc
ppVar Var
v Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> ([Doc] -> Doc
hcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Int -> Doc -> [Doc]
forall a. Int -> a -> [a]
replicate Int
n (Doc -> [Doc]) -> Doc -> [Doc]
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"[]")

ppReadArr :: Var -> [Doc] -> Doc
ppReadArr :: Var -> [Doc] -> Doc
ppReadArr Var
v [Doc]
as = Var -> [Doc] -> Doc
ppArrIndex Var
v [Doc]
as

ppWriteArr :: Var -> ArrIndex Doc -> Doc -> Doc
ppWriteArr :: Var -> [Doc] -> Doc -> Doc
ppWriteArr Var
v [Doc]
as Doc
b = Var -> [Doc] -> Doc
ppArrIndex Var
v [Doc]
as Doc -> Doc -> Doc
<+> Doc
equalsWord Doc -> Doc -> Doc
<+> Doc
b
    where equalsWord :: Doc
equalsWord = if (Var -> Rate
varRate Var
v Rate -> Rate -> Bool
forall a. Eq a => a -> a -> Bool
== Rate
Sr) then String -> Doc
text String
"strcpy" else Doc
equals

ppWriteInitArr :: Var -> [Doc] -> Doc -> Doc
ppWriteInitArr :: Var -> [Doc] -> Doc -> Doc
ppWriteInitArr Var
v [Doc]
as Doc
b = Var -> [Doc] -> Doc
ppArrIndex Var
v [Doc]
as Doc -> Doc -> Doc
<+> Doc
initWord Doc -> Doc -> Doc
<+> Doc
b
    where initWord :: Doc
initWord = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ if (Var -> Rate
varRate Var
v Rate -> Rate -> Bool
forall a. Eq a => a -> a -> Bool
== Rate
Sr) then String
"strcpy" else String
"init"

-------------------------------------

tab :: Monad m => Doc -> StateT TabDepth m Doc
tab :: Doc -> StateT Int m Doc
tab Doc
doc = (Int -> Doc) -> StateT Int m Int -> StateT Int m Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Doc -> Int -> Doc
shiftByTab Doc
doc) StateT Int m Int
forall (m :: * -> *) s. Monad m => StateT s m s
get

tabWidth :: TabDepth
tabWidth :: Int
tabWidth = Int
4

shiftByTab :: Doc -> TabDepth -> Doc
shiftByTab :: Doc -> Int -> Doc
shiftByTab Doc
doc Int
n
    | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0    = Doc
doc
    | Bool
otherwise = (String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
tabWidth Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
n) Char
' ') Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
doc

left :: State TabDepth ()
left :: State Int ()
left = (Int -> Int) -> State Int ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify Int -> Int
forall a. Enum a => a -> a
pred

succTab :: Monad m => Doc -> StateT TabDepth m Doc
succTab :: Doc -> StateT Int m Doc
succTab Doc
doc = do
    Doc
a <- Doc -> StateT Int m Doc
forall (m :: * -> *). Monad m => Doc -> StateT Int m Doc
tab Doc
doc
    (Int -> Int) -> StateT Int m ()
forall (m :: * -> *) s. Monad m => (s -> s) -> StateT s m ()
modify Int -> Int
forall a. Enum a => a -> a
succ
    Doc -> StateT Int m Doc
forall (m :: * -> *) a. Monad m => a -> m a
return Doc
a

prefix :: String -> [Doc] -> Doc
prefix :: String -> [Doc] -> Doc
prefix String
name [Doc]
args = String -> Doc
text String
name Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
tupled [Doc]
args

ppCond :: Inline CondOp Doc -> Doc
ppCond :: CondInfo Doc -> Doc
ppCond = (CondOp -> [Doc] -> Doc) -> CondInfo Doc -> Doc
forall a. (a -> [Doc] -> Doc) -> Inline a Doc -> Doc
ppInline CondOp -> [Doc] -> Doc
ppCondOp

($=) :: Doc -> Doc -> Doc
$= :: Doc -> Doc -> Doc
($=) Doc
a Doc
b = Doc
a Doc -> Doc -> Doc
<+> Doc
equals Doc -> Doc -> Doc
<+> Doc
b

ppOuts :: [RatedVar] -> Doc
ppOuts :: [RatedVar] -> Doc
ppOuts [RatedVar]
xs = [Doc] -> Doc
hsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ (RatedVar -> Doc) -> [RatedVar] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map RatedVar -> Doc
ppRatedVar [RatedVar]
xs

ppPrimOrVar :: PrimOr RatedVar -> Doc
ppPrimOrVar :: PrimOr RatedVar -> Doc
ppPrimOrVar PrimOr RatedVar
x = (Prim -> Doc) -> (RatedVar -> Doc) -> Either Prim RatedVar -> Doc
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Prim -> Doc
ppPrim RatedVar -> Doc
ppRatedVar (Either Prim RatedVar -> Doc) -> Either Prim RatedVar -> Doc
forall a b. (a -> b) -> a -> b
$ PrimOr RatedVar -> Either Prim RatedVar
forall a. PrimOr a -> Either Prim a
unPrimOr PrimOr RatedVar
x

ppStrget :: Doc -> Int -> Doc
ppStrget :: Doc -> Int -> Doc
ppStrget Doc
out Int
n = Doc -> String -> [Doc] -> Doc
ppOpc Doc
out String
"strget" [Char -> Doc
char Char
'p' Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Doc
int Int
n]

ppIf :: Doc -> Doc -> Doc -> Doc -> Doc
ppIf :: Doc -> Doc -> Doc -> Doc -> Doc
ppIf Doc
res Doc
p Doc
t Doc
e = [Doc] -> Doc
vcat
    [ String -> Doc
text String
"if" Doc -> Doc -> Doc
<+> Doc
p Doc -> Doc -> Doc
<+> String -> Doc
text String
"then"
    , String -> Doc
text String
"    " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
res Doc -> Doc -> Doc
<+> Char -> Doc
char Char
'=' Doc -> Doc -> Doc
<+> Doc
t
    , String -> Doc
text String
"else"
    , String -> Doc
text String
"    " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
res Doc -> Doc -> Doc
<+> Char -> Doc
char Char
'=' Doc -> Doc -> Doc
<+> Doc
e
    , String -> Doc
text String
"endif"
    ]

ppOpc :: Doc -> String -> [Doc] -> Doc
ppOpc :: Doc -> String -> [Doc] -> Doc
ppOpc Doc
out String
name [Doc]
xs = Doc
out Doc -> Doc -> Doc
<+> String -> [Doc] -> Doc
ppProc String
name [Doc]
xs

ppProc :: String -> [Doc] -> Doc
ppProc :: String -> [Doc] -> Doc
ppProc String
name [Doc]
xs = String -> Doc
text String
name Doc -> Doc -> Doc
<+> ([Doc] -> Doc
hsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
punctuate Doc
comma [Doc]
xs)

ppVar :: Var -> Doc
ppVar :: Var -> Doc
ppVar Var
v = case Var
v of
    Var VarType
ty Rate
rate String
name   -> VarType -> Doc
ppVarType VarType
ty Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Rate -> Doc
ppRate Rate
rate Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text (VarType -> Char
varPrefix VarType
ty Char -> String -> String
forall a. a -> [a] -> [a]
: String
name)
    VarVerbatim Rate
_ String
name -> String -> Doc
text String
name

varPrefix :: VarType -> Char
varPrefix :: VarType -> Char
varPrefix VarType
x = case VarType
x of
    VarType
LocalVar  -> Char
'l'
    VarType
GlobalVar -> Char
'g'

ppVarType :: VarType -> Doc
ppVarType :: VarType -> Doc
ppVarType VarType
x = case VarType
x of
    VarType
LocalVar  -> Doc
empty
    VarType
GlobalVar -> Char -> Doc
char Char
'g'

ppConvertRate :: Doc -> Rate -> Rate -> Doc -> Doc
ppConvertRate :: Doc -> Rate -> Rate -> Doc -> Doc
ppConvertRate Doc
out Rate
to Rate
from Doc
var = case (Rate
to, Rate
from) of
    (Rate
Ar, Rate
Kr) -> Doc -> Doc
upsamp Doc
var
    (Rate
Ar, Rate
Ir) -> Doc -> Doc
upsamp (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> Doc
k Doc
var
    (Rate
Kr, Rate
Ar) -> Doc -> Doc
downsamp Doc
var
    (Rate
Kr, Rate
Ir) -> Doc
out Doc -> Doc -> Doc
$= Doc -> Doc
k Doc
var
    (Rate
Ir, Rate
Ar) -> Doc -> Doc
downsamp Doc
var
    (Rate
Ir, Rate
Kr) -> Doc
out Doc -> Doc -> Doc
$= Doc -> Doc
i Doc
var
    (Rate
a, Rate
b)   -> String -> Doc
forall a. HasCallStack => String -> a
error (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$ String
"bug: no rate conversion from " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Rate -> String
forall a. Show a => a -> String
show Rate
b String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" to " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Rate -> String
forall a. Show a => a -> String
show Rate
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"."
    where
        upsamp :: Doc -> Doc
upsamp Doc
x = Doc -> String -> [Doc] -> Doc
ppOpc Doc
out String
"upsamp" [Doc
x]
        downsamp :: Doc -> Doc
downsamp Doc
x = Doc -> String -> [Doc] -> Doc
ppOpc Doc
out String
"downsamp" [Doc
x]
        k :: Doc -> Doc
k = String -> Doc -> Doc
func String
"k"
        i :: Doc -> Doc
i = String -> Doc -> Doc
func String
"i"

-- expressions

ppInline :: (a -> [Doc] -> Doc) -> Inline a Doc -> Doc
ppInline :: (a -> [Doc] -> Doc) -> Inline a Doc -> Doc
ppInline a -> [Doc] -> Doc
ppNode Inline a Doc
a = InlineExp a -> Doc
iter (InlineExp a -> Doc) -> InlineExp a -> Doc
forall a b. (a -> b) -> a -> b
$ Inline a Doc -> InlineExp a
forall a b. Inline a b -> InlineExp a
inlineExp Inline a Doc
a
    where iter :: InlineExp a -> Doc
iter InlineExp a
x = case InlineExp a
x of
              InlinePrim Int
n        -> Inline a Doc -> IntMap Doc
forall a b. Inline a b -> IntMap b
inlineEnv Inline a Doc
a IntMap Doc -> Int -> Doc
forall a. IntMap a -> Int -> a
IM.! Int
n
              InlineExp a
op [InlineExp a]
args   -> a -> [Doc] -> Doc
ppNode a
op ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (InlineExp a -> Doc) -> [InlineExp a] -> [Doc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap InlineExp a -> Doc
iter [InlineExp a]
args

-- booleans

ppCondOp :: CondOp -> [Doc] -> Doc
ppCondOp :: CondOp -> [Doc] -> Doc
ppCondOp CondOp
op = case CondOp
op of
    CondOp
TrueOp            -> Doc -> [Doc] -> Doc
forall a b. a -> b -> a
const (Doc -> [Doc] -> Doc) -> Doc -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"(1 == 1)"
    CondOp
FalseOp           -> Doc -> [Doc] -> Doc
forall a b. a -> b -> a
const (Doc -> [Doc] -> Doc) -> Doc -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"(0 == 1)"
    CondOp
And               -> String -> [Doc] -> Doc
bi String
"&&"
    CondOp
Or                -> String -> [Doc] -> Doc
bi String
"||"
    CondOp
Equals            -> String -> [Doc] -> Doc
bi String
"=="
    CondOp
NotEquals         -> String -> [Doc] -> Doc
bi String
"!="
    CondOp
Less              -> String -> [Doc] -> Doc
bi String
"<"
    CondOp
Greater           -> String -> [Doc] -> Doc
bi String
">"
    CondOp
LessEquals        -> String -> [Doc] -> Doc
bi String
"<="
    CondOp
GreaterEquals     -> String -> [Doc] -> Doc
bi String
">="
    where bi :: String -> [Doc] -> Doc
bi  = String -> [Doc] -> Doc
binaries

-- numeric

ppNumOp :: NumOp -> [Doc] -> Doc
ppNumOp :: NumOp -> [Doc] -> Doc
ppNumOp NumOp
op = case  NumOp
op of
    NumOp
Add -> String -> [Doc] -> Doc
bi String
"+"
    NumOp
Sub -> String -> [Doc] -> Doc
bi String
"-"
    NumOp
Mul -> String -> [Doc] -> Doc
bi String
"*"
    NumOp
Div -> String -> [Doc] -> Doc
bi String
"/"
    NumOp
Neg -> String -> [Doc] -> Doc
uno String
"-"
    NumOp
Pow -> String -> [Doc] -> Doc
bi String
"^"
    NumOp
Mod -> String -> [Doc] -> Doc
bi String
"%"
    where
        bi :: String -> [Doc] -> Doc
bi  = String -> [Doc] -> Doc
binaries
        uno :: String -> [Doc] -> Doc
uno = String -> [Doc] -> Doc
unaries

ppRatedVar :: RatedVar -> Doc
ppRatedVar :: RatedVar -> Doc
ppRatedVar RatedVar
v = Rate -> Doc
ppRate (RatedVar -> Rate
ratedVarRate RatedVar
v) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Doc
int (RatedVar -> Int
ratedVarId RatedVar
v)

ppRate :: Rate -> Doc
ppRate :: Rate -> Doc
ppRate Rate
x = case Rate
x of
    Rate
Sr -> Char -> Doc
char Char
'S'
    Rate
_  -> Rate -> Doc
phi Rate
x
    where phi :: Rate -> Doc
phi = String -> Doc
text (String -> Doc) -> (Rate -> String) -> Rate -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (String -> String) -> (Rate -> String) -> Rate -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rate -> String
forall a. Show a => a -> String
show

ppTotalDur :: Double -> Doc
ppTotalDur :: Double -> Doc
ppTotalDur Double
d = String -> Doc
text String
"f0" Doc -> Doc -> Doc
<+> Double -> Doc
double Double
d