module Language.ImProve.Code (code) where

import Data.List
import Text.Printf

import Language.ImProve.Core
import Language.ImProve.Tree hiding (Branch)
import qualified Language.ImProve.Tree as T

-- | Generate C code.
code :: Name -> Statement -> IO ()
code name stmt = do
  writeFile (name ++ ".c") $
       "// Generated by ImProve.\n\n"
    ++ "#include <assert.h>\n\n"
    ++ codeVariables True scope ++ "\n"
    ++ "void " ++ name ++ "() {\n"
    ++ indent (codeStmt stmt)
    ++ "}\n\n"
  writeFile (name ++ ".h") $
       "// Generated by ImProve.\n\n"
    ++ codeVariables False scope ++ "\n"
    ++ "void " ++ name ++ "(void);\n\n"
  where
  [scope] = tree (\ (_, path, _) -> path) $ stmtVars stmt

codeStmt :: Statement -> String
codeStmt a = case a of
  AssignBool  a b -> pathName a ++ " = " ++ codeExpr b ++ ";\n"
  AssignInt   a b -> pathName a ++ " = " ++ codeExpr b ++ ";\n"
  AssignFloat a b -> pathName a ++ " = " ++ codeExpr b ++ ";\n"
  Branch path a b Null -> "// if_ "    ++ pathName path ++ "\nif (" ++ codeExpr a ++ ") {\n" ++ indent (codeStmt b) ++ "}\n"
  Branch path a b c    -> "// ifelse " ++ pathName path ++ "\nif (" ++ codeExpr a ++ ") {\n" ++ indent (codeStmt b) ++ "}\nelse {\n" ++ indent (codeStmt c) ++ "}\n"
  Sequence a b -> codeStmt a ++ codeStmt b
  Assert path a -> "// assert " ++ pathName path ++ "\nassert(" ++ codeExpr a ++ ");\n"
  Assume path a -> "// assume " ++ pathName path ++ "\nassert(" ++ codeExpr a ++ ");\n"
  Null -> ""

codeExpr :: E a -> String
codeExpr a = case a of
  Ref a     -> pathName a
  Const a   -> showConst $ const' a
  Add a b   -> group [codeExpr a, "+", codeExpr b]
  Sub a b   -> group [codeExpr a, "-", codeExpr b]
  Mul a b   -> group [codeExpr a, "*", showConst (const' b)]
  Div a b   -> group [codeExpr a, "/", showConst (const' b)]
  Mod a b   -> group [codeExpr a, "%", showConst (const' b)]
  Not a     -> group ["!", codeExpr a]
  And a b   -> group [codeExpr a, "&&",  codeExpr b]
  Or  a b   -> group [codeExpr a, "||",  codeExpr b]
  Eq  a b   -> group [codeExpr a, "==",  codeExpr b]
  Lt  a b   -> group [codeExpr a, "<",   codeExpr b]
  Gt  a b   -> group [codeExpr a, ">",   codeExpr b]
  Le  a b   -> group [codeExpr a, "<=",  codeExpr b]
  Ge  a b   -> group [codeExpr a, ">=",  codeExpr b]
  Mux a b c -> group [codeExpr a, "?", codeExpr b, ":", codeExpr c] 
  where
  group :: [String] -> String
  group a = "(" ++ intercalate " " a ++ ")"

indent :: String -> String
indent = unlines . map ("  " ++) . lines

indent' :: String -> String
indent' a = case lines a of
  [] -> []
  (a:b) -> a ++ "\n" ++ indent (unlines b)

codeVariables :: Bool -> (Tree Name (Bool, Path, Const)) -> String
codeVariables define a = (if define then "" else "extern ") ++ init (init (f1 a)) ++ (if define then " =\n  " ++ f2 a else "") ++ ";\n"
  where
  f1 a = case a of
    T.Branch name items -> "struct {  // " ++ name ++ "\n" ++ indent (concatMap f1 items) ++ "} " ++ name ++ ";\n"
    Leaf name (input, _, init) -> printf "%-5s %-25s;%s\n" (showConstType init) name (if input then "  // input" else "")

  f2 a = case a of
    T.Branch name items -> indent' $ "{ " ++ (intercalate ", " $ map f2 items) ++ "}  // " ++ name ++ "\n"
    Leaf name (_, _, init) -> printf "%-15s  // %s\n" (showConst init) name

showConst :: Const -> String
showConst a = case a of
  Bool  True  -> "1"
  Bool  False -> "0"
  Int   a     -> show a
  Float a     -> show a

showConstType :: Const -> String
showConstType a = case a of
  Bool  _ -> "int"
  Int   _ -> "int"
  Float _ -> "float"