module Feldspar.Compiler.Compiler where

import Data.Map
import System.IO
import Data.Typeable as DT

import Feldspar.Core.Types
import Feldspar.Transformation
import qualified Feldspar.NameExtractor as Precompiler

import Feldspar.Compiler.Imperative.Representation
import Feldspar.Compiler.Backend.C.Options
import Feldspar.Compiler.Backend.C.Platforms
import Feldspar.Compiler.Backend.C.Library
import Feldspar.Compiler.Imperative.Plugin.Naming
import Feldspar.Compiler.Backend.C.Plugin.HandlePrimitives
import Feldspar.Compiler.Imperative.Plugin.Unroll
import Feldspar.Compiler.Backend.C.Plugin.TypeDefinitionGenerator
import Feldspar.Compiler.Backend.C.Plugin.VariableRoleAssigner
import Feldspar.Compiler.Imperative.Plugin.ConstantFolding
import Feldspar.Compiler.Backend.C.Plugin.BlockProgramHandler
import Feldspar.Compiler.Backend.C.Plugin.TypeCorrector
import Feldspar.Compiler.Backend.C.Plugin.PrettyPrint
import Feldspar.Compiler.Backend.C.Plugin.Locator
import Feldspar.Compiler.Backend.C.Plugin.AllocationEliminator
import Feldspar.Compiler.Backend.C.CodeGeneration
import Feldspar.Compiler.Imperative.FromCore

data SomeCompilable = forall a . Compilable a => SomeCompilable a
    deriving (DT.Typeable)

-- ================================================================================================
--  == Compiler core
-- ================================================================================================


compileToC :: (Compilable t) =>
    CompilationMode -> t -> Precompiler.OriginalFunctionSignature -> Options -> Int -> (String, (Int, Int))
compileToC compilationMode prg originalFunctionSignature coreOptions lineNum =
    compToC ((coreOptions, Declaration_pl), lineNum) $ executePluginChain compilationMode prg originalFunctionSignature {
        Precompiler.originalFunctionName = fixFunctionName $ Precompiler.originalFunctionName originalFunctionSignature
    } coreOptions

compileToCWithInfos :: (Compilable t) =>
    CompilationMode -> t -> Precompiler.OriginalFunctionSignature -> Options -> Int -> (Module DebugToCSemanticInfo, (String, (Int, Int)))
compileToCWithInfos compilationMode prg originalFunctionSignature coreOptions lineNum =
    compToCWithInfos ((coreOptions, Declaration_pl), lineNum) $ executePluginChain compilationMode prg originalFunctionSignature {
        Precompiler.originalFunctionName = fixFunctionName $ Precompiler.originalFunctionName originalFunctionSignature
    } coreOptions

compileToCWithHeaders :: (Compilable t) =>
    CompilationMode -> t -> Precompiler.OriginalFunctionSignature -> Options -> (String, (Int, Int))
compileToCWithHeaders compilationMode prg originalFunctionSignature coreOptions =
     (headers ++ cSource, endPos) where
         (cSource, endPos) = compileToC compilationMode prg originalFunctionSignature coreOptions lineNum
         (headers, lineNum) = genHeaders coreOptions

compileToCWithHeaders_Infos :: (Compilable t) =>
    CompilationMode -> t -> Precompiler.OriginalFunctionSignature -> Options -> (Module DebugToCSemanticInfo, (String, (Int, Int)))
compileToCWithHeaders_Infos compilationMode prg originalFunctionSignature coreOptions =
     (debugModule, (headers ++ cSource, endPos)) where
         (debugModule, (cSource, endPos)) = compileToCWithInfos compilationMode prg originalFunctionSignature coreOptions lineNum
         (headers, lineNum) = genHeaders coreOptions


-- ================================================================================================
--  == Standalone compilation
-- ================================================================================================

standaloneCompile :: (Compilable t) =>
    t -> FilePath -> FilePath -> Precompiler.OriginalFunctionSignature -> Options -> IO ()
standaloneCompile prg inputFileName outputFileName originalFunctionSignature opts =
    appendFile outputFileName $ fst $ compileToCWithHeaders Standalone prg originalFunctionSignature opts

-- ================================================================================================
--  == Interactive compilation
-- ================================================================================================

data PrgType = ForType | AssignType | IfType | SwitchType

getProgram :: (Int, Int) -> PrgType -> Module DebugToCSemanticInfo -> IO ()
getProgram (line, col) prgtype prg = res where
     res = case find of 
                True -> putStrLn $ myShow code
                _    -> putStrLn "Not found appropriate code part!"
     (find, code) = case prgtype of
                        ForType     -> getPrgParLoop (line, col) prg
                        AssignType  -> getPrgAssign (line, col) prg
                        IfType      -> getPrgBranch (line, col) prg
                        SwitchType  -> getPrgSwitch (line, col) prg
      

compile :: (Compilable t) => t -> FilePath -> String -> Options -> IO ()
compile prg fileName functionName opts = writeFile fileName $
    fst $ compileToCWithHeaders Interactive prg (Precompiler.OriginalFunctionSignature functionName []) opts

icompile :: (Compilable t) => t -> IO ()
icompile prg = putStrLn $
    fst $ compileToCWithHeaders Interactive prg (Precompiler.OriginalFunctionSignature "test" []) defaultOptions

icompile' :: (Compilable t) => t -> String -> Options -> IO ()
icompile' prg functionName opts = putStrLn $
    fst $ compileToCWithHeaders Interactive prg (Precompiler.OriginalFunctionSignature functionName []) opts

icompileWithInfos_ ::  (Compilable t) => t -> String -> Options -> (Module DebugToCSemanticInfo, (String, (Int, Int)))
icompileWithInfos_ prg functionName opts = compileToCWithHeaders_Infos Interactive prg (Precompiler.OriginalFunctionSignature functionName []) opts

genIncludeLines :: [String] -> (String, Int)
genIncludeLines []   = ("", 1)
genIncludeLines (x:xs) = ("#include " ++ x ++ "\n" ++ str, linenum + 1) where
    (str, linenum) = genIncludeLines xs

genHeaders :: Options -> (String, Int)
genHeaders coreOptions = (str ++ "\n\n", linenum + 2) where
    (str, linenum)  = genIncludeLines (includes $ platform coreOptions)
-- genHeaders coreOptions = (str ++ "#define " ++ defaultArraySizeConstantName ++ " (" ++ (show $ defaultArraySize coreOptions) ++ ")\n\n", linenum + 2) where
    -- (str, linenum)  = genIncludeLines (includes $ platform coreOptions)

------------------------
-- Predefined options --
------------------------

forPrg = ForType
ifPrg  = IfType
assignPrg = AssignType
switchPrg = SwitchType


defaultOptions
    = Options
    { platform          = c99
    , unroll            = NoUnroll
    , debug             = NoDebug
    , defaultArraySize  = 16
    }

c99PlatformOptions              = defaultOptions
tic64xPlatformOptions           = defaultOptions { platform = tic64x }
unrollOptions                   = defaultOptions { unroll = Unroll 8 }
noPrimitiveInstructionHandling  = defaultOptions { debug = NoPrimitiveInstructionHandling }

-- ===========================================================================
--  == Plugin system
-- ===========================================================================

pluginChain :: ExternalInfoCollection -> Module () -> Module ()
pluginChain externalInfo
    = (executePlugin AllocationEliminator ())
    . (executePlugin TypeDefinitionGenerator (typeDefinitionGeneratorExternalInfo externalInfo))
    . (executePlugin ConstantFolding ())
    . (executePlugin UnrollPlugin (unrollExternalInfo externalInfo))
    . (executePlugin Precompilation (precompilationExternalInfo externalInfo))
    . (executePlugin VariableRoleAssigner (variableRoleAssignerExternalInfo externalInfo))
    . (executePlugin HandlePrimitives (handlePrimitivesExternalInfo externalInfo))
    . (executePlugin TypeCorrector (typeCorrectorExternalInfo externalInfo))
    . (executePlugin BlockProgramHandler ())
   
data ExternalInfoCollection = ExternalInfoCollection {
      precompilationExternalInfo          :: ExternalInfo Precompilation
    , unrollExternalInfo                  :: ExternalInfo UnrollPlugin
    , handlePrimitivesExternalInfo        :: ExternalInfo HandlePrimitives
    , typeDefinitionGeneratorExternalInfo :: ExternalInfo TypeDefinitionGenerator
    , variableRoleAssignerExternalInfo    :: ExternalInfo VariableRoleAssigner
    , typeCorrectorExternalInfo           :: ExternalInfo TypeCorrector
}

executePluginChain :: (Compilable p) =>
    CompilationMode -> p -> Precompiler.OriginalFunctionSignature -> Options -> Module ()
executePluginChain compilationMode prg originalFunctionSignatureParam opt =
    (pluginChain ExternalInfoCollection {
        precompilationExternalInfo = PrecompilationExternalInfo {
            originalFunctionSignature = originalFunctionSignatureParam,
            inputParametersDescriptor = buildInParamDescriptor prg,
            numberOfFunctionArguments = numArgs prg,
            compilationMode = compilationMode
        }
        , unrollExternalInfo            = unroll opt
        , handlePrimitivesExternalInfo  = (defaultArraySize opt, debug opt, platform opt)
        , typeDefinitionGeneratorExternalInfo = opt
        , variableRoleAssignerExternalInfo = ()
        , typeCorrectorExternalInfo = False
    }) $ fromCore "PLACEHOLDER" prg