module Feldspar.Compiler.Backend.C.Library
    (module System.Console.ANSI,
     module Feldspar.Compiler.Backend.C.Library) where

import Control.Monad.State
import System.Console.ANSI

data CompilationMode = Interactive | Standalone
    deriving (Show, Eq)

-- ===========================================================================
--  == String tools
-- ===========================================================================

replace :: Eq a => [a] -> [a] -> [a] -> [a]
replace [] _ _ = []
replace s find repl | take (length find) s == find = repl ++ (replace (drop (length find) s) find repl)
                    | otherwise = [head s] ++ (replace (tail s) find repl)

fixFunctionName :: String -> String
fixFunctionName functionName = replace (replace functionName "_" "__") "'" "_prime"

-- ===========================================================================
--  == Name generator
-- ===========================================================================

newName  :: (Monad m) => String -> StateT Integer m String
newName name = do
    n <- get
    put $ n+1
    return $ name ++ show n

-- ===========================================================================
--  == Console tools
-- ===========================================================================

withColor :: Color -> IO () -> IO ()
withColor color action = do
    setSGR [SetColor Foreground Vivid color, SetColor Background Dull Black] -- , SetConsoleIntensity BoldIntensity]
    action
    setSGR [Reset]