module Sound.DF.CGen ( -- * C code generator
                       code_gen, dl_gen ) where

import Data.List
import Sound.DF.Node
import Sound.DF.Graph
import System.Cmd
import System.FilePath

-- | Generate C code for graph.
code_gen :: Node -> String
code_gen n = 
    let as = analyse (tsort n)
        ns = map fst as
        hd = [ "#include <stdio.h>"
             , "#include <stdlib.h>"
             , "#include <stdbool.h>"
             , "#include <math.h>"
             , "#include <jack.dl.h>"]
        c = [hd, cdef, cstate ns, dsp_init ns, dsp_step as ns]
    in (unlines . concat) c

-- | Generate C code, write file disk and call GNU C compiler to build
--   shared library.
dl_gen :: FilePath -> Node -> IO ()
dl_gen fn n = 
    do let c = fn <.> "c"
           so = fn <.> "so"
           gcc = "gcc -g --std=c99 -O2 -shared -I ~/include "
           cmd = gcc ++ c ++ " -o " ++ so
       writeFile c (code_gen n)
       system cmd
       return ()

-- | Construct an identifier.
clabel :: String -> (NodeID, PortID) -> String
clabel p (k, n) = concat [p, "_", show k, "_", show n]

-- | Construct a function/macro call.
ccall :: String -> [String] -> String
ccall s as = concat ([s, "("] ++ intersperse "," as ++ [");"])

-- | A ccall variant with trace output.
d_ccall :: String -> Node -> [String] -> [String]
d_ccall s n as = [ "/*" ++ show n ++ "*/"
                 , ccall s as ]

ctype :: Type -> String
ctype Real_Type = "float"
ctype Integer_Type = "long int"
ctype Boolean_Type = "bool"

type CVar = (String, String, Maybe Double, Bool)

cvar_from_constant :: NodeID -> String -> Constant -> Bool -> CVar
cvar_from_constant k c (Real_Constant i) st = 
    (ctype Real_Type, clabel c (k, 0), Just i, st)
cvar_from_constant k c (Integer_Constant i) st = 
    (ctype Integer_Type, clabel c (k, 0), Just (fromIntegral i), st)

-- | List of required variable declarations.
cvars_n :: (NodeID, Node) -> [CVar]
cvars_n (k, S i) = 
    [cvar_from_constant k "n" i False]
cvars_n (k, R (R_ID j) (Left i)) =
    [cvar_from_constant j "r" i True
    ,cvar_from_constant k "n" i False]
cvars_n (k, R (R_ID _) (Right _)) =
    [("float", clabel "n" (k, 0), Nothing, False)]
cvars_n (k, (A _ _ o)) = 
    let f (p, t) = let t' = port_data_type t
                   in (ctype t', clabel "n" (k, p), Nothing, False)
    in map f (zip [0 .. length o - 1] o)
cvars_n (_, (M _ _)) = undefined
cvars_n (_, (P _ _)) = undefined

cvars :: [(NodeID, Node)] -> [CVar]
cvars = concatMap cvars_n

is_stateful :: CVar -> Bool
is_stateful (_, _, _, st) = st

stateful_cvars :: [(NodeID, Node)] -> [CVar]
stateful_cvars = filter is_stateful . cvars

non_stateful_cvars :: [(NodeID, Node)] -> [CVar]
non_stateful_cvars = filter (not . is_stateful) . cvars

cstate :: [(NodeID, Node)] -> [String]
cstate ns = 
    let f (t, n, _, _) = t ++ " " ++ n ++ ";"
    in "struct df_state {" : map f (stateful_cvars ns) ++ ["};"]

cstate_init :: String -> [(NodeID, Node)] -> [String]
cstate_init s ns =  
    let f (_, n, Just i, _) = s ++ "->" ++ n ++ " = " ++ show i ++ ";"
        f (_, _, Nothing, _) = error "cstate_init"
    in map f (stateful_cvars ns)

-- | Non-statefule variable declarations.  Unintialised, the node 
--   writes the constant value.
non_state_decl :: [(NodeID, Node)] -> [String]
non_state_decl ns =  
    let f (ty, n, _, _) = ty ++ " " ++ n ++ ";"
    in map f (non_stateful_cvars ns)

-- | Generate dsp_init function.
dsp_init :: [(NodeID, Node)] -> [String]
dsp_init ns = 
    let a = [ "void *dsp_init(struct world *w, int g)"
            , "{"
            , "struct df_state *s = malloc(sizeof(struct df_state));" ]
        b = [ "return (void*)s;"
            , "}"]
    in a ++ cstate_init "s" ns ++ b

-- | Generate dsp_step function.
dsp_step :: [((NodeID, Node), [Edge])] -> [(NodeID, Node)] -> [String]
dsp_step as ns = 
    let s = "void dsp_step(struct world *w, int g, void *ptr, int nf)"
        f (t, n, _, _) = t ++ " " ++ n ++ " = s->" ++ n ++ ";"
        g (_, n, _, _) = "s->" ++ n ++ " = " ++ n ++ ";"
        ss = [ [ s
               , "{"
               , "struct df_state *s = (struct df_state *)ptr;"
               , "/* load state */" ]
             , map f (stateful_cvars ns)
             , [ "/* non-stateful variables */" ]
             , non_state_decl ns                   
             , [ "/* algorithm */" 
               , "for(int i = 0; i < nf; i++) {" ]
             , concatMap cgen as
             , [ "}"
               , "/* store state */" ]
             , map g (stateful_cvars ns)
             , [ "}" ] ]
    in concat ss

-- | List of code statements.
cgen :: ((NodeID, Node), [Edge]) -> [String]
cgen ((k, n@(S (Real_Constant x))), []) = 
    d_ccall "df_real_constant" n [clabel "n" (k, 0), show x]
cgen ((k, n@(S (Integer_Constant x))), []) = 
    d_ccall "df_integer_constant" n [clabel "n" (k, 0), show x]
cgen ((k, n@(R (R_ID j) (Left _))), []) = 
    d_ccall "df_rec_r" n [clabel "n" (k, 0), clabel "r" (j, 0)]
cgen ((_, n@(R (R_ID j) (Right _))), [(s, _)]) = 
    d_ccall "df_rec_w" n [clabel "r" (j, 0), clabel "n" s]
cgen ((k, n@(A a _ o)), es) = 
    let o_l = map (clabel "n") (zip (repeat k) [0 .. length o - 1])
        i_l = map (clabel "n". fst) es
    in d_ccall a n (o_l ++ i_l)
cgen ((_, (P _ _)), _) =
    []
cgen c = error ("cgen: " ++ show c)

-- | Macro definitions
cdef :: [String]
cdef = 
    ["/* reader */"
    ,"#define df_integer_constant(o_0,i_0) { o_0 = i_0; }"
    ,"#define df_real_constant(o_0,i_0) { o_0 = i_0; }"
    ,"#define df_rec_r(o_0,i_0) { o_0 = i_0; }"
    ,"#define df_rec_w(o_0,i_0) { o_0 = i_0; }"
    ,"/* instance Num */"
    ,"#define df_add(o_0,i_0,i_1) { o_0 = (i_0) + (i_1); }"
    ,"#define df_mul(o_0,i_0,i_1) { o_0 = (i_0) * (i_1); }"
    ,"#define df_sub(o_0,i_0,i_1) { o_0 = (i_0) - (i_1); }"
    ,"#define df_negate(o_0,i_0) { o_0 = -(i_0); }"
    ,"#define df_fabs(o_0,i_0) { o_0 = fabsf(i_0); }"
    ,"#define df_iabs(o_0,i_0) { o_0 = labs(i_0); }"
    ,"#define df_signum(o_0,i_0) { o_0 = i_0 > 0 ? 1 (i_0 < 0 ? -1 : 0); } }"
    ,"/* instance Fractional */"
    ,"#define df_div(o_0,i_0,i_1) { o_0 = (i_0) / (i_1); }"
    ,"#define df_recip(o_0,i_0) { o_0 = 1.0 / i_0; }"
    ,"/* instance Floating */"
    ,"#define df_exp(o_0,i_0) { o_0 = expf(i_0); }"
    ,"#define df_sqrt(o_0,i_0) { o_0 = sqrtf(i_0); }"
    ,"#define df_log(o_0,i_0) { o_0 = logf(i_0); }"
    ,"#define df_pow(o_0,i_0,i_1) { o_0 = powf(i_0,i_1); }"
    ,"#define df_sin(o_0,i_0) { o_0 = sinf(i_0); }"
    ,"#define df_cos(o_0,i_0) { o_0 = cosf(i_0); }"
    ,"#define df_tan(o_0,i_0) { o_0 = tanf(i_0); }"
    ,"/* instance Ord */"
    ,"#define df_lt(o_0,i_0,i_1) { o_0 = i_0 < i_1 ? true : false; }"
    ,"#define df_lte(o_0,i_0,i_1) { o_0 = i_0 <= i_1 ? true : false; }"
    ,"#define df_gt(o_0,i_0,i_1) { o_0 = i_0 > i_1 ? true : false; }"
    ,"#define df_gte(o_0,i_0,i_1) { o_0 = i_0 >= i_1 ? true : false; }"
    ,"#define df_max(o_0,i_0,i_1) { o_0 = i_0 > i_1 ? i_0 : i_1; }"
    ,"#define df_min(o_0,i_0,i_1) { o_0 = i_0 < i_1 ? i_0 : i_1; }"
    ,"/* instance Eq */"
    ,"#define df_eq(o_0,i_0,i_1) { o_0 = i_0 == i_1 ? true : false; }"
    ,"/* instance RealFrac */"
    ,"#define df_floor(o_0,i_0) { o_0 = floorf(i_0); }"     
    ,"#define df_lrint(o_0,i_0) { o_0 = lrintf(i_0); }"     
    ,"/* Control */"
    ,"#define df_and(o_0,i_0,i_1) { o_0 = i_0 && i_1 ? true : false; }"
    ,"#define df_or(o_0,i_0,i_1) { o_0 = i_0 || i_1 ? true : false; }"
    ,"#define df_select2(o_0,i_0,i_1,i_2) { o_0 = i_0 ? i_1 : i_2; }"
    ,"/* World|Environment */"
    ,"#define df_sample_rate(o_0) { o_0 = w_sr(w); }"    
    ,"#define df_b_read(o_0,i_0,i_1) { o_0=w_b_read1(w,i_0,i_1); }"
    ,"#define df_b_write(i_0,i_1,i_2) { w_b_write1(w,i_0,i_1,i_2); }"
    ,"#define df_random(o_0,i_0) { o_0 = ((float)rand() / (float)RAND_MAX); }"
    ,"#define df_out1(i_0) { w_out1(w,i,i_0); }"
    ,"#define df_out2(i_0,i_1) { w_out2(w,i,i_0,i_1); }"
    ,"#define df_out3(i_0,i_1,i_2) { w_out3(w,i,i_0,i_1,i_2); }"
    ]