{-# LANGUAGE LambdaCase #-}
module Language.C.Print where

import Data.List (intersperse)

import Language.C


-- precedence -> tail -> string
type PrintS = Int -> String -> String

-- | The resulting program will need <stdlib.h> and <stdint.h>.
printProgram :: Program -> PrintS
printProgram (Program defs) = intercalates "\n" (map printFunDef defs)

printFunDef :: FunDef -> PrintS
printFunDef (FunDef rt n as (StExpr ss rete)) =
    printType rt % printString " " % printName n
    % printString "("
    % intercalates ", " [printType t % printString " " % printName an | (t, an) <- as]
    % printString ") {\n  "
    % addIndent 2 (intercalates "\n" (map printStmt ss))
    % printString "\n  return (" % printExpr rete % printString ");\n}\n"
printFunDef (ProcDef n as ss) =
    printString "void " % printName n
    % printString "("
    % intercalates ", " [printType t % printString " " % printName an | (t, an) <- as]
    % printString ") " % printBlock ss % printString "\n"

printName :: Name -> PrintS
printName (Name s) = printString s

printType :: Type -> PrintS
printType = printString . showType
  where
    showType :: Type -> String
    showType = \case
        TInt b -> "int" ++ printBits b ++ "_t"
        TUInt b -> "uint" ++ printBits b ++ "_t"
        TFloat -> "float"
        TDouble -> "double"
        TPtr t -> showType t ++ "*"
      where
        printBits :: Bits -> String
        printBits B8 = "8"
        printBits B16 = "16"
        printBits B32 = "32"
        printBits B64 = "64"

printBlock :: [Stmt] -> PrintS
printBlock ss =
    printString "{\n  "
    % addIndent 2 (intercalates "\n" (map printStmt ss))
    % printString "\n}"

printStmt :: Stmt -> PrintS
printStmt (SDecl ty name rhs) =
    printType ty % printString " "
    % printName name
    % maybe (printString "") (\e -> printString " = " % printExpr e) rhs
    % printString ";"
printStmt (SAsg name e) =
    printName name % printString " = " % printExpr e % printString ";"
printStmt (SStore name idx val) =
    printName name % printString "[" % printExpr idx % printString "] = " % printExpr val % printString ";"
printStmt (SCall name args) =
    printName name % printString "(" % intercalates ", " (map printExpr args) % printString ");"
printStmt (SFor ty name lo hi body) =
    printString "for ("
    % printType ty % printString " " % printName name % printString " = " % printExpr lo
    % printString "; "
    % printName name % printString " < (" % printExpr hi % printString ")"
    % printString "; "
    % printName name % printString "++) "
    % printBlock body
printStmt (SIf e b1 b2) =
    printString "if (" % printExpr e % printString ") "
    % printBlock b1 % printString " else " % printBlock b2

printExpr :: Expr -> PrintS
printExpr (EOp e1 op e2) =
    printString "(" % printExpr e1 % printString (") " ++ op ++ " (")
    % printExpr e2 % printString ")"
printExpr (ENot e) =
    printString "!(" % printExpr e % printString ")"
printExpr (ELit s) = printString ("(" ++ s ++ ")")
printExpr (EVar name) = printName name
printExpr (ECall name args) =
    printName name % printString "("
    % intercalates ", " (map printExpr args) % printString ")"
printExpr (EIndex name e) = printName name % printString "[" % printExpr e % printString "]"
printExpr (EPtrTo e) = printString "&(" % printExpr e % printString ")"
printExpr (ESizeOf t) = printString "(sizeof (" % printType t % printString "))"


addIndent :: Int -> PrintS -> PrintS
addIndent plusd f d = f (d + plusd)

withIndent :: Int -> PrintS -> PrintS
withIndent d f _ = f d

intercalates :: String -> [PrintS] -> PrintS
intercalates sep l = foldr (%) (\_ -> id) $ intersperse (printString sep) l

(%) :: PrintS -> PrintS -> PrintS
f % g = \d -> f d . g d

printString :: String -> PrintS
printString "" _ rest = rest
printString ('\n' : s@('\n' : _)) d rest = '\n' : printString s d rest
printString ('\n' : s) d rest = '\n' : replicate d ' ' ++ printString s d rest
printString s d rest =
    let (pre, post) = span (/= '\n') s
    in pre ++ printString post d rest