{-# LANGUAGE ScopedTypeVariables #-}

-- | The Dispatch module : does all the IO, and offers an unified interface to both
-- the interpreter and the compiler.
--
-- Also communicates with GCC in order to compile the C code, and then transmits
-- the results of the execution of that C code.  This functionnality is mostly
-- used to check automatically the equivalence between the interpreter and the
-- compiler.  The Dispatch module only parses the command-line arguments before
-- calling that module.
module Language.Copilot.Dispatch 
  (dispatch, BackEnd(..), AtomToC(..), Interpreted(..), Iterations, Verbose(..)) where

import Language.Copilot.Core
import Language.Copilot.Analyser (check, getExternalVars)
import Language.Copilot.Interpreter
import Language.Copilot.AtomToC
import Language.Copilot.Compiler
import Language.Copilot.PrettyPrinter ()

import qualified Language.Atom as A
import qualified Data.Map as M

import System.Directory 
import System.Process
import System.IO
import Control.Monad

data AtomToC = AtomToC 
    { cName :: Name -- ^ Name of the C file to generate
    , gccOpts :: String -- ^ Options to pass to the compiler
    , getPeriod :: Maybe Period -- ^ The optional period
    , interpreted :: Interpreted -- ^ Interpret the program or not
    , outputDir :: String -- ^ Where to put the executable
    , compiler :: String -- ^ Which compiler to use
    , sim :: Bool -- ^ Are we running a C simulator?
    , prePostCode :: (Maybe String, Maybe String) -- ^ Code to replace the default
                                                  -- initialization and main
    , arrDecs :: [(String, Int)] -- ^ When generating C programs to test, we
                                 -- don't know how large external arrays are, so
                                 -- we cannot declare them.  Passing in pairs
                                 -- containing the name of the array and it's
                                 -- size allows them to be declared.
    , clock :: Maybe A.Clock     -- Use the hardware clock to drive the timing
                                 -- of the program.
    }

data BackEnd = Opts AtomToC 
             | Interpreter

data Interpreted = Interpreted | NotInterpreted
type Iterations = Int
data Verbose = OnlyErrors | DefaultVerbose | Verbose deriving Eq

-- | This function is the core of /Copilot/ :
-- it glues together analyser, interpreter and compiler, and does all the IO.
-- It can be called either from interface (which justs decodes the command-line argument)
-- or directly from the interactive prompt in ghci.
-- @streams@ is a specification, 
-- @inputExts@ allows the user to give at runtime values for
--      the monitored variables. Useful for testing on randomly generated values and specifications,
--      or for the interpreted version.
-- @be@ chooses between compilation or interpretation,
--      and if compilation is chosen (AtomToC) holds a few additionnal informations.
--      see description of @'BackEnd'@
-- @iterations@ just gives the number of periods the specification must be executed.
--      If you would rather execute it by hand, then just choose AtomToC for backEnd and 0 for iterations
-- @verbose@ determines what is output.
dispatch :: LangElems -> Vars -> BackEnd -> Iterations -> Verbose -> IO ()
dispatch elems inputExts backEnd iterations verbose =
    do
        hSetBuffering stdout LineBuffering
        mapM_ putStrLn preludeText 
        isValid <-
            case check (strms elems) of
                Just x -> print x >> return False
                Nothing -> return True
        when isValid $
            -- because haskell is lazy, will only get computed if later used
            let interpretedLines = showVars (interpretStreams (strms elems) trueInputExts) 
                                     iterations 
            in case backEnd of
                Interpreter -> 
                    do
                        unless allInputsPresents $ error errMsg
                        mapM_ putStrLn interpretedLines
                Opts opts ->
                    let isInterpreted =
                            case (interpreted opts) of
                                Interpreted -> True
                                NotInterpreted -> False
                        dirName = outputDir opts
                    in do
                        putStrLn $ "Trying to create the directory " ++ dirName 
                                     ++  " (if missing)  ..."
                        createDirectoryIfMissing False dirName
                        copilotToC elems allExts trueInputExts opts isVerbose
                        let copy ext = copyFile (cName opts ++ ext) 
                                        (dirName ++ cName opts ++ ext)
                        let delete ext = do 
                              f0 <- canonicalizePath (cName opts ++ ext) 
                              f1 <- canonicalizePath (dirName ++ cName opts ++ ext)
                              unless (f0 == f1) $ removeFile (cName opts ++ ext)
                        putStrLn $ "Moving " ++ cName opts ++ ".c and " ++ cName opts 
                                        ++ ".h to " ++ dirName ++ "  ..."
                        copy ".c"
                        copy ".h"
                        delete ".c"
                        delete ".h"
--                        when (prePostCode opts == Nothing) $ gccCall (Opts opts)
                        when (sim opts) (gccCall (Opts opts))
                        when ((isInterpreted || isExecuted) && not allInputsPresents) $ 
                            error errMsg
                        when isExecuted $ execute (strms elems) (dirName ++ cName opts) 
                                             trueInputExts isInterpreted 
                            interpretedLines iterations isSilent
    where
        errMsg = "The interpreter does not have values for some of the external variables."
        isVerbose = verbose == Verbose
        isSilent = verbose == OnlyErrors
        isExecuted = iterations /= 0
        allExts = getExternalVars (strms elems)
        (trueInputExts :: StreamableMaps [] , allInputsPresents :: Bool) = 
          filterStreamableMaps inputExts (map (\(a,v,r) -> (a, show v, r)) allExts)

copilotToC :: LangElems -> [Exs] -> Vars -> AtomToC -> Bool -> IO ()
copilotToC elems allExts trueInputExts opts isVerbose =
    let cFileName = cName opts
        (p', program) = copilotToAtom elems (getPeriod opts) cFileName
        (preCode, postCode) = 
            getPrePostCode (sim opts) (prePostCode opts) cFileName 
                           (strms elems) allExts (map (\(x,y) -> (ExtV x,y)) 
                           (arrDecs opts)) trueInputExts p'
            -- case (prePostCode opts) of
            --     Nothing ->  
            --       getPrePostCode cFileName (strms elems) allExts 
            --                      (map (\(x,y) -> (ExtV x,y)) (arrDecs opts))
            --                      trueInputExts p'
            --     Just (pre, post) -> (pre, post)
        atomConfig = A.defaults 
            { A.cCode = \_ _ _ -> (preCode, postCode)
            , A.cRuleCoverage = False
            , A.cAssert = False
            , A.hardwareClock = clock opts
            , A.cStateName = "copilotState" ++ cFileName
            }
    in do
        putStrLn $ "Compiling Copilot specs to C  ..."
        (sched, _, _, _, _) <- A.compile cFileName atomConfig program
        when isVerbose (putStrLn $ A.reportSchedule sched)
        putStrLn $ "Generated " ++ cFileName ++ ".c and " ++ cFileName ++ ".h"

-- | Call Gcc to compile the code.
gccCall :: BackEnd -> IO ()
gccCall backend = 
  case backend of
    Interpreter -> error "Impossible: gccCall called with Interpreter."
    Opts opts   -> 
      let dirName = outputDir opts
          programName = cName opts
      in
        do
          let command = compiler opts ++ " " ++ dirName ++ cName opts 
                        ++ ".c" ++ " -o " ++ dirName ++ programName 
                        ++ " " ++ gccOpts opts
          putStrLn "Calling the C compiler  ..."
          putStrLn command
          _ <- system command
          return ()

execute :: StreamableMaps Spec -> String -> Vars -> Bool -> [String] -> Iterations -> Bool -> IO ()
execute streams programName trueInputExts isInterpreted interpretedLines iterations isSilent =
    do  (Just hin, Just hout, _, _) <- createProcess processConfig
        hSetBuffering hout LineBuffering
        hSetBuffering hin LineBuffering

        when isInterpreted 
                 (do putStrLn "\n *** Checking the randomly-generated Copilot specification: ***\n"
                     print streams)
        let inputVar v (val:vals) ioVars =
                do  hPutStr hin (showAsC val ++ " \n")
                    hFlush hin
                    vars <- ioVars
                    return $ updateSubMap (\m -> M.insert v vals m) vars
            inputVar _ [] _ = error "Impossible : empty inputVar"
            executePeriod _ [] 0 = putStrLn "Execution complete." 
            executePeriod _ [] _ = error "Impossible : empty ExecutePeriod"
            executePeriod inputExts (inLine:inLines) n =
                when (n > 0) $ 
                    do  nextInputExts <- foldStreamableMaps inputVar inputExts (return emptySM)
                        line <- hGetLine hout
                        let nextPeriod = 
                                (unless isSilent $ putStrLn line) >> 
                                    executePeriod nextInputExts inLines (n - 1)
                        -- Checking the compiler and interpreter.
                        if isInterpreted
                            then if inLine == line
                                       then nextPeriod
                                       else error $ unlines 
                                              [ "Failure: interpreter /= compiler"
                                              , "  program name: " ++ programName
                                              , "  interpreter: " ++ inLine
                                              , "  compiler: "    ++ line
                                              ]
                            else nextPeriod
                            
        -- useful for initializing the sampling temporary variables
        firstInputExts <- foldStreamableMaps inputVar trueInputExts (return emptySM)
        executePeriod firstInputExts interpretedLines iterations
    where
        processConfig = 
            (shell $ programName ++ " " ++ show iterations)
            {std_in = CreatePipe, std_out = CreatePipe, std_err = UseHandle stdout}

showVars :: Vars -> Int-> [String]
showVars interpretedVars n =
    showVarsLine interpretedVars 0
    where
        showVarsLine inVs i =
            if i == n 
                then []
                else 
                    let (string, inVs') = foldStreamableMaps prettyShow inVs ("", emptySM) 
                        endString = showVarsLine inVs' (i + 1) 
                        beginString = "period: " ++ show i ++ "   " ++ string 
                    in
                    beginString:endString
        prettyShow v l (s, vs) =
            let s' = v ++ ": " ++ showAsC (head l) ++ "   " ++ s
                vs' = updateSubMap (\ m -> M.insert v (tail l) m) vs in
            (s', vs')
                
preludeText :: [String]
preludeText = 
    [ ""
    , "========================================================================="
    , "  CoPilot, a stream language for generating hard real-time C monitors.  "
    , "========================================================================="
    , "Copyright, Galois, Inc. 2010"
    , "BSD3 License" 
    , "Website: http://leepike.github.com/Copilot/"
    , "Maintainer: Lee Pike <leepike--at--gmail.com> (remove dashes)."
    , "Usage: > help"
    , "========================================================================="
    , ""
    ]