module UHC.Light.Compiler.EHC.CompilePhase.Module
( cpCheckMods'
, cpCheckMods
, GetMeta (..), allGetMeta
, cpGetCoreModnameAndImports
, cpGetHsModnameAndImports, cpGetHsMod, cpGetMetaInfo
, cpGetDummyCheckSrcMod
, cpUpdateModOffMp
, cpGenImpNmInfo
, cpUpdHiddenExports )
where
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified UHC.Util.Rel as Rel
import UHC.Util.Time
import UHC.Util.FPath
import System.Directory
import Control.Monad.State
import UHC.Light.Compiler.Base.Optimize
import UHC.Light.Compiler.EHC.Common
import UHC.Light.Compiler.EHC.CompileUnit
import UHC.Light.Compiler.EHC.CompileRun
import UHC.Light.Compiler.Module.ImportExport
import qualified UHC.Light.Compiler.Config as Cfg
import qualified UHC.Light.Compiler.HS.ModImpExp as HSSemMod
import qualified UHC.Light.Compiler.Core.Check as Core2ChkSem
import UHC.Light.Compiler.CodeGen.RefGenerator
import UHC.Light.Compiler.Base.Debug




{-# LINE 53 "src/ehc/EHC/CompilePhase/Module.chs" #-}
cpCheckMods' :: (HsName -> ModMpInfo) -> [Mod] -> EHCompilePhase ()
cpCheckMods' dfltMod modL@(Mod {modName = modNm} : _)
  = do { cr <- get
       -- ; cpMsg modNm VerboseDebug $ "cpCheckMods' modL: " ++ show modL
       ; let crsi   = crStateInfo cr
             (mm,e) = modMpCombine' dfltMod modL (crsiModMp crsi)
       ; cpUpdSI (\crsi -> crsi {crsiModMp = mm})
       ; cpSetLimitErrsWhen 5 "Module analysis" e
       }

{-# LINE 72 "src/ehc/EHC/CompilePhase/Module.chs" #-}
cpCheckMods :: [HsName] -> EHCompilePhase ()
cpCheckMods modNmL
  = do { cr <- get
       ; let modL   = [ addBuiltin $ ecuMod $ crCU n cr | n <- modNmL ]
       ; cpCheckMods' (\n -> panic $ "cpCheckMods: " ++ show n) modL
       }
  where addBuiltin m = m { modImpL = modImpBuiltin : modImpL m }

{-# LINE 86 "src/ehc/EHC/CompilePhase/Module.chs" #-}
data GetMeta
  = GetMeta_Src
  | GetMeta_HI
  | GetMeta_Core
  | GetMeta_Dir
  deriving (Eq,Ord)

allGetMeta
  = [ GetMeta_Src, GetMeta_HI, GetMeta_Core
    , GetMeta_Dir
    ]


{-# LINE 107 "src/ehc/EHC/CompilePhase/Module.chs" #-}
cpGetCoreModnameAndImports :: HsName -> EHCompilePhase HsName
cpGetCoreModnameAndImports modNm
  =  do  {  cr <- get
         ;  let  (ecu,_,opts,_) = crBaseInfo modNm cr
                 mbCrSemMod = ecuMbCoreSemMod ecu
                 crSemMod   = panicJust "cpGetCoreModnameAndImports" mbCrSemMod
                 modNm'     = Core2ChkSem.realModuleNm_Syn_CodeAGItf crSemMod
         ;  case mbCrSemMod of
              {-
              Just _ | ecuIsTopMod ecu -> cpUpdCUWithKey modNm (\_ ecu -> (modNm', upd $ cuUpdKey modNm' ecu))
                     | otherwise       -> do { cpUpdCU modNm upd ; return modNm }
              -}
              Just _ -> cpUpdCUWithKey modNm $ \_ ecu ->
                          ( modNm'
                          , ecuStoreHSDeclImpS (Set.fromList $ Core2ChkSem.impModNmL_Syn_CodeAGItf crSemMod )
                            $ cuUpdKey modNm' ecu
                          )
              _      -> return modNm
         }

{-# LINE 129 "src/ehc/EHC/CompilePhase/Module.chs" #-}
cpGetHsModnameAndImports :: HsName -> EHCompilePhase HsName
cpGetHsModnameAndImports modNm
  =  do  {  cr <- get
         ;  let  (ecu,_,opts,_) = crBaseInfo modNm cr
                 mbHsSemMod = ecuMbHSSemMod ecu
                 hsSemMod   = panicJust "cpGetHsModnameAndImports" mbHsSemMod
                 modNm'     = HSSemMod.realModuleNm_Syn_AGItf hsSemMod
                 upd        = ecuStoreHSDeclImpS ( -- (\v -> tr "XX" (pp $ Set.toList v) v) $
                                                  HSSemMod.modImpNmS_Syn_AGItf hsSemMod)
         ;  case mbHsSemMod of
              Just _ | ecuIsTopMod ecu -> cpUpdCUWithKey modNm (\_ ecu -> (modNm', upd $ cuUpdKey modNm' ecu))
                     | otherwise       -> do { cpUpdCU modNm upd ; return modNm }
              _      -> return modNm
         }

cpGetHsMod :: HsName -> EHCompilePhase ()
cpGetHsMod modNm
  =  do  {  cr <- get
         ;  let  (ecu,_,opts,_) = crBaseInfo modNm cr
                 mbHsSemMod = ecuMbHSSemMod ecu
                 hsSemMod   = panicJust "cpGetHsMod" mbHsSemMod
                 mod        = HSSemMod.mod_Syn_AGItf hsSemMod
         ;  when (ehcOptVerbosity opts >= VerboseDebug)
                 (do { cpMsg modNm VerboseDebug "cpGetHsMod"
                     ; lift $ putWidthPPLn 120 (pp mod)
                     })
         ;  when (isJust mbHsSemMod)
                 (cpUpdCU modNm (ecuStoreMod mod))
         }

cpGetMetaInfo :: [GetMeta] -> HsName -> EHCompilePhase ()
cpGetMetaInfo gm modNm
  =  do  {  cr <- get
         ;  let (ecu,_,opts,fp) = crBaseInfo modNm cr
         ;  when (GetMeta_Src `elem` gm)
                 (tm opts ecu ecuStoreSrcTime        (ecuSrcFilePath ecu))
         {-
         ;  when (GetMeta_HI `elem` gm)
                 (tm opts ecu ecuStoreHITime
                                              (mkInOrOutputFPathFor (InputFrom_Loc $ ecuFileLocation ecu) opts modNm fp "hi")
                 )
         -}
         ;  when (GetMeta_HI `elem` gm)
                 (tm opts ecu ecuStoreHIInfoTime
                                              (mkInOrOutputFPathFor (InputFrom_Loc $ ecuFileLocation ecu) opts modNm fp "hi")
                 )
         ;  when (GetMeta_Core `elem` gm)
                 (tm opts ecu ecuStoreCoreTime      (fpathSetSuff Cfg.suffixDotlessBinaryCore fp))
         ;  when (GetMeta_Dir `elem` gm)
                 (wr opts ecu ecuStoreDirIsWritable (                         fp     ))
         }
  where tm :: EHCOpts -> EHCompileUnit -> (ClockTime -> EHCompileUnit -> EHCompileUnit) -> FPath -> EHCompilePhase ()
        tm opts ecu store fp
          = do { let n = fpathToStr fp
               ; nExists <- lift $ doesFileExist n
               ; when (ehcOptVerbosity opts >= VerboseDebug)
                      (do { lift $ putStrLn ("meta info of: " ++ show (ecuModNm ecu) ++ ", file: " ++ n ++ ", exists: " ++ show nExists)
                          })
               ; when nExists
                      (do { t <- lift $ fpathGetModificationTime fp
                          ; when (ehcOptVerbosity opts >= VerboseDebug)
                                 (do { lift $ putStrLn ("time stamp of: " ++ show (ecuModNm ecu) ++ ", time: " ++ show t)
                                     })
                          ; cpUpdCU modNm $ store t
                          })
               }
        wr opts ecu store fp
          = do { pm <- lift $ getPermissions (maybe "." id $ fpathMbDir fp)
               -- ; lift $ putStrLn (fpathToStr fp ++ " writ " ++ show (writable pm))
               ; cpUpdCU modNm $ store (writable pm)
               }

{-# LINE 225 "src/ehc/EHC/CompilePhase/Module.chs" #-}
cpGetDummyCheckSrcMod :: HsName -> EHCompilePhase ()
cpGetDummyCheckSrcMod modNm
  = do { cr <- get
       ; let crsi   = crStateInfo cr
             mm     = crsiModMp crsi
             mod    = Mod modNm Nothing Nothing [] Rel.empty Rel.empty []
       ; cpUpdCU modNm (ecuStoreMod mod)
       ; cpUpdSI (\crsi -> crsi {crsiModMp = Map.insert modNm emptyModMpInfo mm})
       }

{-# LINE 241 "src/ehc/EHC/CompilePhase/Module.chs" #-}
cpUpdateModOffMp :: [HsName] -> EHCompilePhase ()
cpUpdateModOffMp modNmL
  = do { cr <- get
       ; let crsi   = crStateInfo cr
             offMp  = crsiModOffMp crsi
             (offMp',_)
                    = foldr add (offMp, Map.size offMp) modNmL
                    where add modNm (offMp, offset)
                            = case Map.lookup modNm offMp of
                                Just (o,_) -> (Map.insert modNm (o, new) offMp, offset )
                                _          -> (Map.insert modNm (o, new) offMp, offset')
                                           where (o, offset') = refGen1 offset 1 modNm
                            where new = crsiExpNmOffMp modNm crsi
       ; cpUpdSI (\crsi -> crsi {crsiModOffMp = offMp'})
       }

{-# LINE 263 "src/ehc/EHC/CompilePhase/Module.chs" #-}
-- | Compute imported module names
cpGenImpNmInfo :: HsName -> EHCompilePhase [HsName]
cpGenImpNmInfo modNm
  = do { cr <- get
       ; let (ecu,crsi,opts,fp) = crBaseInfo modNm cr
             isWholeProg = ehcOptOptimizationScope opts > OptimizationScope_PerModule
             impNmL     | isWholeProg = []
                        | otherwise   = ecuImpNmL ecu
       ; return impNmL
       }

{-# LINE 280 "src/ehc/EHC/CompilePhase/Module.chs" #-}
cpUpdHiddenExports :: HsName -> [(HsName,IdOccKind)] -> EHCompilePhase ()
cpUpdHiddenExports modNm exps
  = when (not $ null exps)
         (do { cpUpdSI (\crsi -> crsi { crsiModMp = modMpAddHiddenExps modNm exps $ crsiModMp crsi
                                      })
             ; cpUpdateModOffMp [modNm]
             })