module UHC.Light.Compiler.EHC.CompileRun
( EHCompileRunStateInfo (..)
, emptyEHCompileRunStateInfo
, EHCompileRun, EHCompilePhase
, crBaseInfo, crMbBaseInfo, crBaseInfo'
, cpUpdOpts
, cpMsg, cpMsg'
, cpStepUID, cpSetUID
, cpSystem', cpSystem
, cpSystemRaw
, cpStopAt
, crsiExpNmOffMpDbg, crsiExpNmOffMp
, crModNeedsCompile
, crModCanCompile
, crSetAndCheckMain
, EHCTime, EHCTimeDiff, getEHCTime, ehcTimeDiff, ehcTimeDiffFmt
, EHCIOInfo (..), newEHCIOInfo
, cpRegisterFilesToRm
, cpRmFilesToRm
, crPartitionIntoPkgAndOthers )
where
import qualified Data.Map as Map
import qualified Data.Set as Set
import System.IO
import System.Exit
import System.Environment
import System.Process
import Control.Monad.State
import UHC.Light.Compiler.CodeGen.ValAccess as VA
import UHC.Light.Compiler.EHC.Common
import UHC.Light.Compiler.EHC.CompileUnit
import qualified UHC.Light.Compiler.Core as Core
import qualified UHC.Light.Compiler.EH.MainAG as EHSem
import qualified UHC.Light.Compiler.HS.MainAG as HSSem
import qualified UHC.Light.Compiler.Core.ToGrin as Core2GrSem
import UHC.Light.Compiler.EHC.CompileGroup
import qualified UHC.Light.Compiler.HS.ModImpExp as HSSemMod
import UHC.Light.Compiler.Module.ImportExport
import UHC.Util.Time
import System.CPUTime
import System.Locale
import Data.IORef
import System.IO.Unsafe
import System.Directory
import Control.Exception as CE
import UHC.Util.FPath
import UHC.Light.Compiler.Base.PackageDatabase












{-# LINE 68 "src/ehc/EHC/CompileRun.chs" #-}
type EHCTime = Integer
type EHCTimeDiff = Integer

getEHCTime :: IO EHCTime
getEHCTime = getCPUTime

ehcTimeDiff :: EHCTime -> EHCTime -> EHCTimeDiff
ehcTimeDiff = (-)

ehcTimeDiffFmt :: EHCTimeDiff -> String
ehcTimeDiffFmt t
  = fm 2 hrs ++ ":" ++ fm 2 mins ++ ":" ++ fm 2 secs ++ ":" ++ fm 6 (psecs `div` 1000000)
  where (r0  , psecs) = t  `quotRem` 1000000000000
        (r1  , secs ) = r0 `quotRem` 60
        (r2  , mins ) = r1 `quotRem` 60
        (days, hrs  ) = r2 `quotRem` 24
        fm n x = strPadLeft '0' n (show x)

{-# LINE 88 "src/ehc/EHC/CompileRun.chs" #-}
data EHCIOInfo
  = EHCIOInfo
      { ehcioinfoStartTime			:: EHCTime
      , ehcioinfoLastTime			:: EHCTime
      }

newEHCIOInfo :: IO (IORef EHCIOInfo)
newEHCIOInfo
  = do t <- getEHCTime
       newIORef (EHCIOInfo t t)


{-# LINE 122 "src/ehc/EHC/CompileRun.chs" #-}
data EHCompileRunStateInfo
  = EHCompileRunStateInfo
      { crsiOpts        :: !EHCOpts                             -- options
      , crsiNextUID     :: !UID                                 -- unique id, the next one
      , crsiHereUID     :: !UID                                 -- unique id, the current one
      , crsiHSInh       :: !HSSem.Inh_AGItf                     -- current inh attrs for HS sem
      , crsiEHInh       :: !EHSem.Inh_AGItf                     -- current inh attrs for EH sem
      , crsiCoreInh     :: !Core2GrSem.Inh_CodeAGItf            -- current inh attrs for Core2Grin sem
      , crsiMbMainNm    :: !(Maybe HsName)                      -- name of main module, if any
      , crsiHSModInh    :: !HSSemMod.Inh_AGItf                  -- current inh attrs for HS module analysis sem
      , crsiModMp       :: !ModMp                               -- import/export info for modules
      , crsiGrpMp       :: (Map.Map HsName EHCompileGroup)      -- not yet used, for mut rec modules
      , crsiOptim       :: !Optim                               -- inter module optimisation info
      , crsiModOffMp    :: !VA.HsName2FldMpMp              		-- mapping of all modules + exp entries to offsets in module + exp tables
      , crsiEHCIOInfo	:: !(IORef EHCIOInfo)					-- unsafe info
      , crsiFilesToRm   :: ![FPath]                             -- files to clean up (remove)
      }

{-# LINE 150 "src/ehc/EHC/CompileRun.chs" #-}
emptyEHCompileRunStateInfo :: EHCompileRunStateInfo
emptyEHCompileRunStateInfo
  = EHCompileRunStateInfo
      { crsiOpts        =   defaultEHCOpts
      , crsiNextUID     =   uidStart
      , crsiHereUID     =   uidStart
      , crsiHSInh       =   panic "emptyEHCompileRunStateInfo.crsiHSInh"
      , crsiEHInh       =   panic "emptyEHCompileRunStateInfo.crsiEHInh"
      , crsiCoreInh     =   panic "emptyEHCompileRunStateInfo.crsiCoreInh"
      , crsiMbMainNm    =   Nothing
      , crsiHSModInh    =   panic "emptyEHCompileRunStateInfo.crsiHSModInh"
      , crsiModMp       =   Map.empty
      , crsiGrpMp       =   Map.empty
      , crsiOptim       =   defaultOptim
      , crsiModOffMp    =   Map.empty
      , crsiEHCIOInfo   =   panic "emptyEHCompileRunStateInfo.crsiEHCIOInfo"
      , crsiFilesToRm   =   []
      }

{-# LINE 179 "src/ehc/EHC/CompileRun.chs" #-}
crsiExpNmOffMpDbg :: String -> HsName -> EHCompileRunStateInfo -> VA.HsName2FldMp
crsiExpNmOffMpDbg ctxt modNm crsi = mmiNmOffMp $ panicJust ("crsiExpNmOffMp." ++ ctxt ++ show ks ++ ": " ++ show modNm) $ Map.lookup modNm $ crsiModMp crsi
  where ks = Map.keys $ crsiModMp crsi

crsiExpNmOffMp :: HsName -> EHCompileRunStateInfo -> VA.HsName2FldMp
crsiExpNmOffMp modNm crsi = mmiNmOffMp $ panicJust ("crsiExpNmOffMp: " ++ show modNm) $ Map.lookup modNm $ crsiModMp crsi

{-# LINE 188 "src/ehc/EHC/CompileRun.chs" #-}
instance Show EHCompileRunStateInfo where
  show _ = "EHCompileRunStateInfo"

instance PP EHCompileRunStateInfo where
  pp i = "CRSI:" >#< ppModMp (crsiModMp i)

{-# LINE 196 "src/ehc/EHC/CompileRun.chs" #-}
instance CompileRunStateInfo EHCompileRunStateInfo HsName () where
  crsiImportPosOfCUKey n i = ()

{-# LINE 201 "src/ehc/EHC/CompileRun.chs" #-}
type EHCompileRun     = CompileRun   HsName EHCompileUnit EHCompileRunStateInfo Err
type EHCompilePhase a = CompilePhase HsName EHCompileUnit EHCompileRunStateInfo Err a

{-# LINE 210 "src/ehc/EHC/CompileRun.chs" #-}
crBaseInfo' :: EHCompileRun -> (EHCompileRunStateInfo,EHCOpts)
crBaseInfo' cr
  = (crsi,opts)
  where crsi   = crStateInfo cr
        opts   = crsiOpts  crsi

crMbBaseInfo :: HsName -> EHCompileRun -> (Maybe EHCompileUnit, EHCompileRunStateInfo, EHCOpts, Maybe FPath)
crMbBaseInfo modNm cr
  = ( mbEcu ,crsi
    -- if any per module opts are available, use those
    , maybe opts id $ mbEcu >>= ecuMbOpts
    , fmap ecuFilePath mbEcu
    )
  where mbEcu       = crMbCU modNm cr
        (crsi,opts) = crBaseInfo' cr

crBaseInfo :: HsName -> EHCompileRun -> (EHCompileUnit,EHCompileRunStateInfo,EHCOpts,FPath)
crBaseInfo modNm cr
  = ( maybe (panic "crBaseInfo.mbEcu") id mbEcu
    , crsi
    , opts
    , maybe (panic "crBaseInfo.mbFp") id mbFp
    )
  where (mbEcu, crsi, opts, mbFp) = crMbBaseInfo modNm cr

{-# LINE 245 "src/ehc/EHC/CompileRun.chs" #-}
cpMemUsage :: EHCompilePhase ()
cpMemUsage
  = return ()

{-# LINE 268 "src/ehc/EHC/CompileRun.chs" #-}
cpUpdOpts :: (EHCOpts -> EHCOpts) -> EHCompilePhase ()
cpUpdOpts upd
  = cpUpdSI (\crsi -> crsi {crsiOpts = upd $ crsiOpts crsi})

{-# LINE 278 "src/ehc/EHC/CompileRun.chs" #-}
cpRegisterFilesToRm :: [FPath] -> EHCompilePhase ()
cpRegisterFilesToRm fpL
  = cpUpdSI (\crsi -> crsi {crsiFilesToRm = fpL ++ crsiFilesToRm crsi})

{-# LINE 284 "src/ehc/EHC/CompileRun.chs" #-}
cpRmFilesToRm :: EHCompilePhase ()
cpRmFilesToRm
  = do { cr <- get
       ; let (crsi,opts) = crBaseInfo' cr
             files = Set.toList $ Set.fromList $ map fpathToStr $ crsiFilesToRm crsi
       ; lift $ mapM rm files
       ; cpUpdSI (\crsi -> crsi {crsiFilesToRm = []})
       }
  where rm f = CE.catch (removeFile f)
                        (\(e :: SomeException) -> hPutStrLn stderr (show f ++ ": " ++ show e))

{-# LINE 301 "src/ehc/EHC/CompileRun.chs" #-}
cpMsg :: HsName -> Verbosity -> String -> EHCompilePhase ()
cpMsg modNm v m
  = do { cr <- get
       ; let (_,_,_,mbFp) = crMbBaseInfo modNm cr
       ; cpMsg' modNm v m Nothing (maybe emptyFPath id mbFp)
       }

cpMsg' :: HsName -> Verbosity -> String -> Maybe String -> FPath -> EHCompilePhase ()
cpMsg' modNm v m mbInfo fp
  = do { cr <- get
       ; let (mbEcu,crsi,opts,_) = crMbBaseInfo modNm cr
       ; ehcioinfo <- lift $ readIORef (crsiEHCIOInfo crsi)
       ; clockTime <- lift getEHCTime
       ; let clockStartTimePrev = ehcioinfoStartTime ehcioinfo
             clockTimePrev      = ehcioinfoLastTime ehcioinfo
             clockStartTimeDiff = ehcTimeDiff clockTime clockStartTimePrev
             clockTimeDiff      = ehcTimeDiff clockTime clockTimePrev
       ; let
             t				= if v >= VerboseALot then "<" ++ strBlankPad 35 (ehcTimeDiffFmt clockStartTimeDiff ++ "/" ++ ehcTimeDiffFmt clockTimeDiff) ++ ">" else ""
             m'             = maybe "" (\ecu -> show (ecuSeqNr ecu) ++ t ++ " ") mbEcu ++ m
       ; lift $ putCompileMsg v (ehcOptVerbosity opts) m' mbInfo modNm fp
       ; clockTime <- lift getEHCTime
       ; lift $ writeIORef (crsiEHCIOInfo crsi) (ehcioinfo {ehcioinfoLastTime = clockTime})
       -- ; cpUpdSI (\crsi -> crsi { crsiTime = clockTime })
       ; cpMemUsage
       }

{-# LINE 342 "src/ehc/EHC/CompileRun.chs" #-}
cpStepUID :: EHCompilePhase ()
cpStepUID
  = cpUpdSI (\crsi -> let (n,h) = mkNewLevUID (crsiNextUID crsi)
                      in  crsi {crsiNextUID = n, crsiHereUID = h}
            )

cpSetUID :: UID -> EHCompilePhase ()
cpSetUID u
  = cpUpdSI (\crsi -> crsi {crsiNextUID = u})

{-# LINE 358 "src/ehc/EHC/CompileRun.chs" #-}
cpSystem' :: Maybe FilePath -> (FilePath,[String]) -> EHCompilePhase ()
cpSystem' mbStdOut (cmd,args)
  = do { exitCode <- lift $ system $ showShellCmd $ (cmd,args ++ (maybe [] (\o -> [">", o]) mbStdOut))
       ; case exitCode of
           ExitSuccess -> return ()
           _           -> cpSetFail
       }

cpSystem :: (FilePath,[String]) -> EHCompilePhase ()
cpSystem = cpSystem' Nothing

{-# LINE 388 "src/ehc/EHC/CompileRun.chs" #-}
cpSystemRaw :: String -> [String] -> EHCompilePhase ()
cpSystemRaw cmd args
  = do { exitCode <- lift $ rawSystem cmd args
       ; case exitCode of
           ExitSuccess -> return ()
           _           -> cpSetErrs [rngLift emptyRange Err_PP $ pp $ show exitCode] -- cpSetFail
       }

{-# LINE 402 "src/ehc/EHC/CompileRun.chs" #-}
cpStopAt :: CompilePoint -> EHCompilePhase ()
cpStopAt atPhase
  = do { cr <- get
       ; let (_,opts) = crBaseInfo' cr
       ; unless (atPhase < ehcStopAtPoint opts)
                cpSetStopAllSeq
       }

{-# LINE 416 "src/ehc/EHC/CompileRun.chs" #-}
crPartitionNewerOlderImports :: HsName -> EHCompileRun -> ([EHCompileUnit],[EHCompileUnit])
crPartitionNewerOlderImports modNm cr
  = partition isNewer $ map (flip crCU cr) $ ecuImpNmL ecu
  where ecu = crCU modNm cr
        t   = panicJust "crPartitionNewerOlderImports1" $ ecuMbHIInfoTime ecu
        isNewer ecu'
            | isJust mbt = t' `diffClockTimes` t > noTimeDiff
            | otherwise  = False
            where t' = panicJust "crPartitionNewerOlderImports2" $ ecuMbHIInfoTime ecu'
                  mbt = ecuMbHIInfoTime ecu'

{-# LINE 433 "src/ehc/EHC/CompileRun.chs" #-}
crModNeedsCompile :: HsName -> EHCompileRun -> Bool
crModNeedsCompile modNm cr
  = ecuIsMainMod ecu -- ecuIsTopMod ecu
    || not (  ehcOptCheckRecompile opts
           && ecuCanUseHIInsteadOfHS ecu
           && null newer
           )
  where ecu = crCU modNm cr
        (newer,_) = crPartitionNewerOlderImports modNm cr
        opts = crsiOpts $ crStateInfo cr

{-# LINE 454 "src/ehc/EHC/CompileRun.chs" #-}
crModCanCompile :: HsName -> EHCompileRun -> Bool
crModCanCompile modNm cr
  = isJust (ecuMbSrcTime ecu) && ecuDirIsWritable ecu
  where ecu = crCU modNm cr

{-# LINE 465 "src/ehc/EHC/CompileRun.chs" #-}
-- | split module names in those part of a package, and others
crPartitionIntoPkgAndOthers :: EHCompileRun -> [HsName] -> ([PkgModulePartition],[HsName])
crPartitionIntoPkgAndOthers cr modNmL
  = ( [ (p,d,m)
      | ((p,d),m) <- Map.toList $ Map.unionsWith (++) $ map Map.fromList ps
      ]
    , concat ms
    )
  where (ps,ms) = unzip $ map loc modNmL
        loc m = case filelocKind $ ecuFileLocation ecu of
                  FileLocKind_Dir	  -> ([           ], [m])
                  FileLocKind_Pkg p d -> ([((p,d),[m])], [ ])
              where (ecu,_,_,_) = crBaseInfo m cr

{-# LINE 485 "src/ehc/EHC/CompileRun.chs" #-}
crSetAndCheckMain :: HsName -> EHCompilePhase ()
crSetAndCheckMain modNm
  = do { cr <- get
       ; let (crsi,opts) = crBaseInfo' cr
             mkerr lim ns = cpSetLimitErrs 1 "compilation run" [rngLift emptyRange Err_MayOnlyHaveNrMain lim ns modNm]
       ; case crsiMbMainNm crsi of
           Just n | n /= modNm          -> mkerr 1 [n]
           _ | ehcOptDoExecLinking opts -> cpUpdSI (\crsi -> crsi {crsiMbMainNm = Just modNm})
             | otherwise                -> return ()
                                           -- mkerr 0 []
       }