module UHC.Light.Compiler.EHC.CompilePhase.Output
( CPOutputCoreHow (..), cpOutputCoreModules
, cpOutputCore
, cpOutputHI )
where
import qualified UHC.Util.FastSeq as Seq
import qualified Data.Map as Map
import qualified Data.Set as Set
import Control.Monad.State
import UHC.Light.Compiler.EHC.Common
import UHC.Light.Compiler.EHC.CompileUnit
import UHC.Light.Compiler.EHC.CompileRun
import qualified UHC.Light.Compiler.Config as Cfg
import qualified UHC.Light.Compiler.Core.ToGrin as Core2GrSem
import UHC.Light.Compiler.Core.Trf.EraseExtractTysigCore
import UHC.Light.Compiler.Core.ToCoreRun
import UHC.Light.Compiler.CoreRun.Pretty
import UHC.Light.Compiler.Core as Core
import UHC.Light.Compiler.Core.Pretty
import UHC.Util.Time
import System.Directory
import qualified UHC.Light.Compiler.SourceCodeSig as Sig
import qualified UHC.Light.Compiler.HI as HI
import qualified UHC.Util.Binary as Bin
import UHC.Util.Serialize
import UHC.Light.Compiler.Gam
import UHC.Light.Compiler.Module.ImportExport
import qualified UHC.Light.Compiler.EH.MainAG as EHSem
import UHC.Light.Compiler.Gam.Utils












{-# LINE 93 "src/ehc/EHC/CompilePhase/Output.chs" #-}
-- | Abstraction for writing a module to output with variation in suffices
cpOutputSomeModules
  ::    (EHCOpts -> EHCompileUnit -> FPath -> FilePath -> mod -> IO ())
     -> (EHCOpts -> HsName -> FPath -> String -> FPath)
     -> (Int -> String -> String)
     -> String
     -> HsName
     -> [(String,mod)]
     -> EHCompilePhase [FPath]
cpOutputSomeModules write mkfp mknmsuff suff modNm mods = do
    cr <- get
    let  (ecu,crsi,opts,fp) = crBaseInfo modNm cr
    forM (zip [1..] mods) $ \(nr,(nmsuff,mod)) -> do
      let fpC     = mkfp opts modNm fp (suff ++ mknmsuff nr nmsuff) -- for now nmsuff after suff, but should be inside name
          fnC     = fpathToStr fpC
      lift $ do
        fpathEnsureExists fpC
        write opts ecu fpC fnC mod
      return fpC

{-# LINE 151 "src/ehc/EHC/CompilePhase/Output.chs" #-}
data CPOutputCoreHow
  = CPOutputCoreHow_Text
  | CPOutputCoreHow_Binary
  | CPOutputCoreHow_Run

cpOutputCoreModules
  :: CPOutputCoreHow -> [CoreOpt]
     -> (Int -> String -> String)
     -> String -> HsName
     -> [(String,CModule)]
     -> EHCompilePhase [FPath]
cpOutputCoreModules how coreOpts mknmsuff suff modNm cMods
  = do { cr <- get
       ; let (_,opts) = crBaseInfo' cr
       ; cpOutputSomeModules write mkOutputFPath mknmsuff suff modNm cMods
       }
  where write opts _ fpC fnC cMod = case how of
          CPOutputCoreHow_Text -> do
            let cMod' = cmodTrfEraseTyCore opts cMod
            putPPFPath fpC (ppCModule (opts {ehcOptCoreOpts = coreOpts ++ ehcOptCoreOpts opts}) cMod') 100
          CPOutputCoreHow_Binary ->
            putSerializeFile fnC cMod
          CPOutputCoreHow_Run -> do
            let cMod' = cmod2CoreRun cMod
            putPPFPath fpC (ppMod' opts cMod') 100

{-# LINE 187 "src/ehc/EHC/CompilePhase/Output.chs" #-}
cpOutputCore :: CPOutputCoreHow -> [CoreOpt] -> String -> String -> HsName -> EHCompilePhase FPath
cpOutputCore how coreOpts nmsuff suff modNm
  =  do  {  cr <- get
         ;  let  (ecu,_,_,_) = crBaseInfo modNm cr
                 mbCore = ecuMbCore ecu
                 cMod   = panicJust "cpOutputCore" mbCore
         ;  cpMsg modNm VerboseALot "Emit Core"
         ;  fmap head $ cpOutputCoreModules how coreOpts (\_ nm -> nm) suff modNm [(nmsuff,cMod)]
         }

{-# LINE 314 "src/ehc/EHC/CompilePhase/Output.chs" #-}
cpOutputHI :: String -> HsName -> EHCompilePhase ()
cpOutputHI suff modNm
  =  do  {  cr <- get
         ;  let  (ecu,crsi,opts,fp) = crBaseInfo modNm cr
                 mmi    = panicJust "cpOutputHI.crsiModMp" $ Map.lookup modNm $ crsiModMp crsi
                 hii1   = ecuHIInfo ecu
                 impNmS = ecuImpNmS ecu
                 hii2   = hii1 { HI.hiiValidity             = HI.HIValidity_Ok
                               , HI.hiiModuleNm             = modNm
                               , HI.hiiExps                 = mmiExps       mmi
                               , HI.hiiHiddenExps           = mmiHiddenExps mmi
                               , HI.hiiHasMain              = ecuHasMain ecu
                               , HI.hiiTarget               = ehcOptTarget opts
                               , HI.hiiTargetFlavor         = ehcOptTargetFlavor opts
                               , HI.hiiSrcTimeStamp         = Sig.timestamp
                               , HI.hiiSrcSig               = Sig.sig
                               , HI.hiiSrcVersionMajor      = Cfg.verMajor Cfg.version
                               , HI.hiiSrcVersionMinor      = Cfg.verMinor Cfg.version
                               , HI.hiiSrcVersionMinorMinor = Cfg.verMinorMinor Cfg.version
                               , HI.hiiSrcVersionSvn        = Cfg.verSvnRevision Cfg.version
                               , HI.hiiCompileFlags         = optsDiscrRecompileRepr opts
                               , HI.hiiCompiler             = Cfg.installVariant opts
                               , HI.hiiTransClosedUsedModMp = Map.unions $
                                                                Map.singleton modNm impNmS : [ ecuTransClosedUsedModMp $ crCU m cr | m <- Set.toList impNmS ]
                               , HI.hiiTransClosedOrphanModS= Set.unions $
                                                                [ Set.unions [if ecuIsOrphan me then Set.singleton m else Set.empty, ecuTransClosedOrphanModS me]
                                                                | m <- Set.toList impNmS
                                                                , let me = crCU m cr
                                                                ]
                               }
                 hii3   = hii2
                 fpH    = mkOutputFPath opts modNm fp suff
                 fnH    = fpathToStr fpH
         ;  cpMsg modNm VerboseALot "Emit HI"
         ;  hiExists <- lift $ doesFileExist fnH
         ;  when (hiExists)
                 (lift $ removeFile fnH)
         ;  when (ehcOptVerbosity opts > VerboseALot)
                 (do { lift $ putPPLn ("hii3: " >#< hii3)
                     ; lift $ putPPLn ("orph: " >#< vlist [ m >#< (fmap Set.toList $ HI.hiiMbOrphan $ ecuHIInfo me) | m <- Set.toList impNmS, let me = crCU m cr ])
                     ; lift $ putPPLn ("used nms: " >#< (pp $ show $ ecuUsedNames ecu))
                     })
         ;  lift $ do { fpathEnsureExists fpH
                      ; putSerializeFile fnH hii3
                      }
         ;  now <- lift $ getClockTime
         ;  cpUpdCU modNm ( ecuStoreHIInfoTime now
                          . ecuStoreHIInfo hii3
                          )
         }