CompileUnit.hs

module UHC.Light.Compiler.EHC.CompileUnit
( EHCompileUnit (..)
, ecuFilePath
, emptyECU
, ecuFinalDestinationState
, EcuUpdater, ecuStoreSrcFilePath, ecuStoreState, ecuStoreHS, ecuStoreEH, ecuStoreHSSem, ecuStoreEHSem
, ecuStoreCoreSemMod
, ecuStoreCoreSem
, ecuStoreCore
, ecuStoreCoreRun
, ecuStoreCoreRunSemMod
, ecuStoreCore2CoreRunSem
, ecuSrcHasSuffix
, Optim (..), defaultOptim
, ecuHSDeclImpNmS, ecuHIDeclImpNmS, ecuHIUsedImpNmS
, ecuIsMainMod
, ecuImpNmS, ecuImpNmL
, ecuTransClosedUsedModMp, ecuTransClosedOrphanModS
, ecuIsOrphan
, ecuStoreHSDeclImpS, ecuSetNeedsCompile, ecuStoreHIUsedImpS, ecuStoreHIInfoTime, ecuStoreSrcTime, ecuStoreHSSemMod, ecuStoreIntrodModS, ecuStoreHIDeclImpS, ecuStoreMod, ecuSetIsTopMod, ecuSetHasMain, ecuStoreOptim, ecuStoreHIInfo, ecuStorePrevHIInfo
, ecuStoreCoreTime
, ecuStoreCoreRunTime
, ecuStoreDirIsWritable
, ecuIsHSNewerThanHI
, ecuIsValidHIInfo
, ecuCanUseHIInsteadOfHS
, EHCCompileSeqNr (..)
, ecuAnHIInfo
, ecuStoreOpts, ecuStorePragmas, ecuStoreUsedNames, ecuSetTarget
, ecuStoreGenCodeFiles
, ecuStoreCppFilePath, ecuStoreSeqNr )
where
import qualified Data.Map as Map
import qualified Data.Set as Set
import UHC.Light.Compiler.EHC.Common
import qualified UHC.Light.Compiler.HS as HS
import qualified UHC.Light.Compiler.EH as EH
import qualified UHC.Light.Compiler.Core as Core
import qualified UHC.Light.Compiler.CoreRun as CoreRun
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 qualified UHC.Light.Compiler.Core.ToCoreRun as Core2CoreRunSem
import qualified UHC.Light.Compiler.Core.Check as Core2ChkSem
import qualified UHC.Light.Compiler.CoreRun.Check as CoreRun2ChkSem
import qualified UHC.Light.Compiler.HI as HI
import qualified UHC.Light.Compiler.HS.ModImpExp as HSSemMod
import UHC.Light.Compiler.Module.ImportExport
import UHC.Light.Compiler.CodeGen.ImportUsedModules
import UHC.Util.Time
import System.Directory
import qualified UHC.Light.Compiler.Base.Pragma as Pragma
import UHC.Light.Compiler.Base.Target
import UHC.Util.Debug











{-# LINE 99 "src/ehc/EHC/CompileUnit.chs" #-}
data Optim
  = Optim

defaultOptim :: Optim
defaultOptim
  = Optim

{-# LINE 122 "src/ehc/EHC/CompileUnit.chs" #-}
data EHCCompileSeqNr
  = EHCCompileSeqNr
      { ecseqnrThis     :: !Int
      , ecseqnrTotal    :: !Int
      }
  deriving (Eq,Ord)

zeroEHCCompileSeqNr :: EHCCompileSeqNr
zeroEHCCompileSeqNr = EHCCompileSeqNr 0 0

instance Show EHCCompileSeqNr where
  show (EHCCompileSeqNr this total)
    = "[" ++ replicate (length tot - length ths) ' ' ++ ths ++ "/" ++ tot ++ "]"
    where tot = show total
          ths = show this

{-# LINE 144 "src/ehc/EHC/CompileUnit.chs" #-}
data EHCompileUnit
  = EHCompileUnit
      { ecuSrcFilePath       :: !FPath
      , ecuMbCppFilePath     :: !(Maybe FPath)
      , ecuFileLocation      :: !FileLoc
      , ecuGrpNm             :: !HsName
      , ecuModNm             :: !HsName
      , ecuMbHS              :: !(Maybe HS.AGItf)
      , ecuMbHSSem           :: !(Maybe HSSem.Syn_AGItf)
      , ecuMbEH              :: !(Maybe EH.AGItf)
      , ecuMbEHSem           :: !(Maybe EHSem.Syn_AGItf)
      , ecuMbCore            :: !(Maybe Core.CModule)
      , ecuMbCoreSem         :: !(Maybe Core2GrSem.Syn_CodeAGItf)
      , ecuMbCore2CoreRunSem :: !(Maybe Core2CoreRunSem.Syn_CodeAGItf)
      , ecuMbCoreSemMod      :: !(Maybe Core2ChkSem.Syn_CodeAGItf)
      , ecuMbCoreRun         :: !(Maybe CoreRun.Mod)
      , ecuMbCoreRunSemMod   :: !(Maybe CoreRun2ChkSem.Syn_AGItf)
      , ecuState             :: !EHCompileUnitState
      , ecuImportUsedModules :: !ImportUsedModules                  -- imported modules info
      , ecuIsTopMod          :: !Bool                               -- module has been specified for compilation on commandline
      , ecuHasMain           :: !Bool                               -- has a def for 'main'?
      , ecuNeedsCompile      :: !Bool                               -- (re)compilation from .hs needed?
      , ecuMbSrcTime         :: !(Maybe ClockTime)                  -- timestamp of possibly absent source (hs, or other type) file
      , ecuMbHIInfoTime      :: !(Maybe ClockTime)                  -- timestamp of possibly previously generated hi file
      , ecuMbCoreTime        :: !(Maybe ClockTime)                  -- timestamp of possibly previously generated core file
      , ecuMbCoreRunTime     :: !(Maybe ClockTime)                  -- timestamp of possibly previously generated corerun file
      , ecuMbHSSemMod        :: !(Maybe HSSemMod.Syn_AGItf)
      , ecuMod               :: !Mod                                -- import/export info of module
      , ecuMbPrevHIInfo      :: !(Maybe HI.HIInfo)                  -- possible HI info of previous run
      , ecuMbOptim           :: !(Maybe Optim)
      , ecuHIInfo            :: !HI.HIInfo                          -- HI info of module
      , ecuDirIsWritable     :: !Bool                               -- can be written in dir of module?
      , ecuMbOpts            :: (Maybe EHCOpts)                     -- possibly per module adaption of options (caused by pragmas)
      , ecuTarget            :: Target                              -- target for which we compile
      , ecuPragmas           :: !(Set.Set Pragma.Pragma)            -- pragmas of module
      , ecuUsedNames         :: ModEntRelFilterMp                   -- map holding actually used names, to later filter cache of imported hi's to be included in this module's hi
      , ecuSeqNr             :: !EHCCompileSeqNr                    -- sequence nr of sorted compilation
      , ecuGenCodeFiles      :: ![FPath]                            -- generated code files
      }

{-# LINE 230 "src/ehc/EHC/CompileUnit.chs" #-}
ecuHSDeclImpNmS = iumHSDeclModules . ecuImportUsedModules
ecuHIDeclImpNmS = iumHIDeclModules . ecuImportUsedModules
ecuHIUsedImpNmS = iumHIUsedModules . ecuImportUsedModules

{-# LINE 236 "src/ehc/EHC/CompileUnit.chs" #-}
ecuFilePath :: EHCompileUnit -> FPath
ecuFilePath ecu
  = maybe (ecuSrcFilePath ecu) id (ecuMbCppFilePath ecu)

{-# LINE 246 "src/ehc/EHC/CompileUnit.chs" #-}
ecuIsMainMod :: EHCompileUnit -> Bool
ecuIsMainMod e = ecuIsTopMod e && ecuHasMain e

{-# LINE 251 "src/ehc/EHC/CompileUnit.chs" #-}
-- | give the current value HIInfo, or the previous one
ecuAnHIInfo :: EHCompileUnit -> HI.HIInfo
ecuAnHIInfo e
  = case ecuMbPrevHIInfo e of
      Just pi | HI.hiiIsEmpty hii
        -> pi
      _ -> hii
  where hii = ecuHIInfo e

{-# LINE 262 "src/ehc/EHC/CompileUnit.chs" #-}
emptyECU :: EHCompileUnit
emptyECU
  = EHCompileUnit
      { ecuSrcFilePath       = emptyFPath
      , ecuMbCppFilePath     = Nothing
      , ecuFileLocation      = emptyFileLoc
      , ecuGrpNm             = hsnUnknown
      , ecuModNm             = hsnUnknown
      , ecuMbHS              = Nothing
      , ecuMbHSSem           = Nothing
      , ecuMbEH              = Nothing
      , ecuMbEHSem           = Nothing
      , ecuMbCore            = Nothing
      , ecuMbCoreSem         = Nothing
      , ecuMbCore2CoreRunSem = Nothing
      , ecuMbCoreSemMod      = Nothing
      , ecuMbCoreRun		 = Nothing
      , ecuMbCoreRunSemMod   = Nothing
      , ecuState             = ECUS_Unknown
      , ecuImportUsedModules = emptyImportUsedModules
      , ecuIsTopMod          = False
      , ecuHasMain           = False
      , ecuNeedsCompile      = True
      , ecuMbSrcTime         = Nothing
      , ecuMbHIInfoTime      = Nothing
      , ecuMbCoreTime        = Nothing
      , ecuMbCoreRunTime	 = Nothing
      , ecuMbHSSemMod        = Nothing
      , ecuMod               = emptyMod
      , ecuMbPrevHIInfo      = Nothing
      , ecuMbOptim           = Nothing
      , ecuHIInfo            = HI.emptyHIInfo
      , ecuDirIsWritable     = False
      , ecuMbOpts            = Nothing
      , ecuTarget            = defaultTarget
      , ecuPragmas           = Set.empty
      , ecuUsedNames         = Map.empty
      , ecuSeqNr             = zeroEHCCompileSeqNr
      , ecuGenCodeFiles      = []
      }

{-# LINE 352 "src/ehc/EHC/CompileUnit.chs" #-}
ecuImpNmS :: EHCompileUnit -> Set.Set HsName
ecuImpNmS ecu = -- (\v -> tr "XX" (pp $ Set.toList v) v) $
  Set.delete (ecuModNm ecu) $ Set.unions [ ecuHSDeclImpNmS ecu, ecuHIDeclImpNmS ecu, ecuHIUsedImpNmS ecu ]

ecuImpNmL :: EHCompileUnit -> [HsName]
ecuImpNmL = Set.toList . ecuImpNmS -- ecu = (nub $ ecuHSDeclImpNmL ecu ++ ecuHIDeclImpNmL ecu ++ ecuHIUsedImpNmL ecu) \\ [ecuModNm ecu]

{-# LINE 361 "src/ehc/EHC/CompileUnit.chs" #-}
-- | The used modules, for linking, according to .hi info
ecuTransClosedUsedModMp :: EHCompileUnit -> HI.HIInfoUsedModMp
ecuTransClosedUsedModMp = HI.hiiTransClosedUsedModMp . ecuAnHIInfo

-- | The orphan modules, must be .hi read, according to .hi info
ecuTransClosedOrphanModS :: EHCompileUnit -> Set.Set HsName
ecuTransClosedOrphanModS = HI.hiiTransClosedOrphanModS . ecuAnHIInfo

{-# LINE 371 "src/ehc/EHC/CompileUnit.chs" #-}
-- | Is orphan, according to .hi info
ecuIsOrphan :: EHCompileUnit -> Bool
ecuIsOrphan = isJust . HI.hiiMbOrphan . ecuAnHIInfo

{-# LINE 391 "src/ehc/EHC/CompileUnit.chs" #-}
instance CompileUnitState EHCompileUnitState where
  cusDefault      = ECUS_Eh EHStart
  cusUnk          = ECUS_Unknown
  cusIsUnk        = (==ECUS_Unknown)
{-# LINE 400 "src/ehc/EHC/CompileUnit.chs" #-}
  cusIsImpKnown s = case s of
                      ECUS_Haskell HSOnlyImports  -> True
                      ECUS_Haskell HIOnlyImports  -> True
                      ECUS_Haskell HMOnlyMinimal  -> True
                      ECUS_Haskell LHSOnlyImports -> True
                      ECUS_Haskell HSAllSem       -> True
                      ECUS_Haskell HIAllSem       -> True
                      ECUS_Core    CROnlyImports  -> True
                      ECUS_CoreRun CRROnlyImports -> True
                      _                           -> False

{-# LINE 419 "src/ehc/EHC/CompileUnit.chs" #-}
instance FileLocatable EHCompileUnit FileLoc where
  fileLocation   = ecuFileLocation
  noFileLocation = emptyFileLoc

{-# LINE 425 "src/ehc/EHC/CompileUnit.chs" #-}
instance CompileUnit EHCompileUnit HsName FileLoc EHCompileUnitState where
  cuDefault         = emptyECU
  cuFPath           = ecuFilePath
  cuLocation        = fileLocation
  cuKey             = ecuModNm
  cuState           = ecuState
  cuUpdFPath        = ecuStoreSrcFilePath
  cuUpdLocation     = ecuStoreFileLocation
  cuUpdState        = ecuStoreState
  cuUpdKey   nm u   = u {ecuModNm = nm}
  cuImports         = ecuImpNmL
  cuParticipation u = if not (Set.null $ Set.filter (Pragma.pragmaIsExcludeTarget $ ecuTarget u) $ ecuPragmas u)
                      then [CompileParticipation_NoImport]
                      else []

-- instance FPathError Err

instance CompileRunError Err () where
  crePPErrL                      = ppErrL
  creMkNotFoundErrL _ fp sp sufs = [rngLift emptyRange Err_FileNotFound fp sp sufs]
  creAreFatal                    = errLIsFatal

instance CompileModName HsName where
  mkCMNm = hsnFromString

instance Show EHCompileUnit where
  show _ = "EHCompileUnit"

instance PP EHCompileUnit where
  pp ecu
    = ecuModNm ecu >|<
      ":" >#< ppBracketsCommas (ecuImpNmL ecu) >|<
      "," >#< show (ecuState ecu)

{-# LINE 471 "src/ehc/EHC/CompileUnit.chs" #-}
-- | The final state to be reached
ecuFinalDestinationState :: EHCompileUnit -> EHCompileUnitState
ecuFinalDestinationState ecu = ecuStateFinalDestination upd $ ecuState ecu
  where
        upd (ECUS_Haskell _)
          | ecuNeedsCompile ecu = ECUS_Haskell HSAllSem
          | otherwise           = ECUS_Haskell HIAllSem
        upd s                   = s

{-# LINE 488 "src/ehc/EHC/CompileUnit.chs" #-}
type EcuUpdater a = a -> EHCompileUnit -> EHCompileUnit

ecuStoreSrcFilePath :: EcuUpdater FPath
ecuStoreSrcFilePath x ecu = ecu { ecuSrcFilePath = x }

ecuStoreFileLocation :: EcuUpdater FileLoc
ecuStoreFileLocation x ecu = ecu { ecuFileLocation = x }

ecuStoreState :: EcuUpdater EHCompileUnitState
ecuStoreState x ecu = ecu { ecuState = x }

ecuStoreHS :: EcuUpdater HS.AGItf
ecuStoreHS x ecu = ecu { ecuMbHS = Just x }

ecuStoreEH :: EcuUpdater EH.AGItf
ecuStoreEH x ecu = ecu { ecuMbEH = Just x }

ecuStoreHSSem :: EcuUpdater HSSem.Syn_AGItf
ecuStoreHSSem x ecu = ecu { ecuMbHSSem = Just x }

ecuStoreEHSem :: EcuUpdater EHSem.Syn_AGItf
ecuStoreEHSem x ecu = ecu { ecuMbEHSem = Just x }

{-# LINE 513 "src/ehc/EHC/CompileUnit.chs" #-}
ecuStoreCoreSemMod :: EcuUpdater Core2ChkSem.Syn_CodeAGItf
ecuStoreCoreSemMod x ecu = ecu { ecuMbCoreSemMod = Just x }

{-# LINE 518 "src/ehc/EHC/CompileUnit.chs" #-}
ecuStoreCoreSem :: EcuUpdater Core2GrSem.Syn_CodeAGItf
ecuStoreCoreSem x ecu = ecu { ecuMbCoreSem = Just x }

{-# LINE 523 "src/ehc/EHC/CompileUnit.chs" #-}
ecuStoreCore :: EcuUpdater Core.CModule
ecuStoreCore x ecu | x `seq` True = ecu { ecuMbCore = Just x }

{-# LINE 534 "src/ehc/EHC/CompileUnit.chs" #-}
ecuStoreCoreRun :: EcuUpdater CoreRun.Mod
ecuStoreCoreRun x ecu | x `seq` True = ecu { ecuMbCoreRun = Just x }

{-# LINE 539 "src/ehc/EHC/CompileUnit.chs" #-}
ecuStoreCoreRunSemMod :: EcuUpdater CoreRun2ChkSem.Syn_AGItf
ecuStoreCoreRunSemMod x ecu = ecu { ecuMbCoreRunSemMod = Just x }

{-# LINE 544 "src/ehc/EHC/CompileUnit.chs" #-}
ecuStoreCore2CoreRunSem :: EcuUpdater Core2CoreRunSem.Syn_CodeAGItf
ecuStoreCore2CoreRunSem x ecu = ecu { ecuMbCore2CoreRunSem = Just x }

{-# LINE 595 "src/ehc/EHC/CompileUnit.chs" #-}
ecuStoreSrcTime :: EcuUpdater ClockTime
ecuStoreSrcTime x ecu = ecu { ecuMbSrcTime = Just x }

-- ecuStoreHITime :: EcuUpdater ClockTime
-- ecuStoreHITime x ecu = ecu { ecuMbHITime = Just x }

ecuStoreHIInfoTime :: EcuUpdater ClockTime
ecuStoreHIInfoTime x ecu = ecu { ecuMbHIInfoTime = Just x }

ecuStoreHSSemMod :: EcuUpdater HSSemMod.Syn_AGItf
ecuStoreHSSemMod x ecu = ecu { ecuMbHSSemMod = Just x }

ecuStoreHSDeclImpS :: EcuUpdater (Set.Set HsName)
ecuStoreHSDeclImpS x ecu = ecu { ecuImportUsedModules = ium {iumHSDeclModules = x} }
  where ium = ecuImportUsedModules ecu

ecuStoreHIDeclImpS :: EcuUpdater (Set.Set HsName)
ecuStoreHIDeclImpS x ecu = ecu { ecuImportUsedModules = ium {iumHIDeclModules = x} }
  where ium = ecuImportUsedModules ecu

ecuStoreHIUsedImpS :: EcuUpdater (Set.Set HsName)
ecuStoreHIUsedImpS x ecu = ecu { ecuImportUsedModules = ium {iumHIUsedModules = x} }
  where ium = ecuImportUsedModules ecu

ecuStoreIntrodModS :: EcuUpdater (Set.Set HsName)
ecuStoreIntrodModS x ecu = ecu { ecuImportUsedModules = ium {iumIntrodModules = x} }
  where ium = ecuImportUsedModules ecu

ecuStoreMod :: EcuUpdater Mod
ecuStoreMod x ecu = ecu { ecuMod = x }

ecuSetIsTopMod :: EcuUpdater Bool
ecuSetIsTopMod x ecu = ecu { ecuIsTopMod = x }

ecuSetHasMain :: EcuUpdater Bool
ecuSetHasMain x ecu = ecu { ecuHasMain = x }

ecuSetNeedsCompile :: EcuUpdater Bool
ecuSetNeedsCompile x ecu = ecu { ecuNeedsCompile = x }

-- ecuStorePrevHI :: EcuUpdater HI.AGItf
-- ecuStorePrevHI x ecu = ecu { ecuMbPrevHI = Just x }

-- ecuStorePrevHISem :: EcuUpdater HISem.Syn_AGItf
-- ecuStorePrevHISem x ecu = ecu { ecuMbPrevHISem = Just x }

ecuStorePrevHIInfo :: EcuUpdater HI.HIInfo
ecuStorePrevHIInfo x ecu = ecu { ecuMbPrevHIInfo = Just x }

ecuStoreOptim :: EcuUpdater Optim
ecuStoreOptim x ecu = ecu { ecuMbOptim = Just x }

ecuStoreHIInfo :: EcuUpdater HI.HIInfo
ecuStoreHIInfo x ecu | x `seq` True = ecu { ecuHIInfo = x }

{-# LINE 658 "src/ehc/EHC/CompileUnit.chs" #-}
ecuStoreCoreTime :: EcuUpdater ClockTime
ecuStoreCoreTime x ecu = ecu { ecuMbCoreTime = Just x }

{-# LINE 663 "src/ehc/EHC/CompileUnit.chs" #-}
ecuStoreCoreRunTime :: EcuUpdater ClockTime
ecuStoreCoreRunTime x ecu = ecu { ecuMbCoreRunTime = Just x }

{-# LINE 673 "src/ehc/EHC/CompileUnit.chs" #-}
ecuStoreDirIsWritable :: EcuUpdater Bool
ecuStoreDirIsWritable x ecu = ecu { ecuDirIsWritable = x }

{-# LINE 678 "src/ehc/EHC/CompileUnit.chs" #-}
ecuStoreOpts :: EcuUpdater EHCOpts
ecuStoreOpts x ecu = ecu { ecuMbOpts = Just x }

ecuSetTarget :: EcuUpdater Target
ecuSetTarget x ecu = ecu { ecuTarget = x }

ecuStorePragmas :: EcuUpdater (Set.Set Pragma.Pragma)
ecuStorePragmas x ecu = ecu { ecuPragmas = x }

ecuStoreUsedNames :: EcuUpdater ModEntRelFilterMp
ecuStoreUsedNames x ecu = ecu { ecuUsedNames = x }

{-# LINE 692 "src/ehc/EHC/CompileUnit.chs" #-}
ecuStoreGenCodeFiles :: EcuUpdater [FPath]
ecuStoreGenCodeFiles x ecu = ecu { ecuGenCodeFiles = x }

{-# LINE 697 "src/ehc/EHC/CompileUnit.chs" #-}
ecuStoreSeqNr :: EcuUpdater EHCCompileSeqNr
ecuStoreSeqNr x ecu = ecu { ecuSeqNr = x }

ecuStoreCppFilePath :: EcuUpdater FPath
ecuStoreCppFilePath x ecu = ecu { ecuMbCppFilePath = Just x }

{-# LINE 709 "src/ehc/EHC/CompileUnit.chs" #-}
-- | Has the source file the given extension? Given suffix is stripped from possible prefixed '.'.
ecuSrcHasSuffix :: String -> EHCompileUnit -> Bool
ecuSrcHasSuffix suff ecu
  = maybe False (==suff') $ fpathMbSuff $ ecuSrcFilePath ecu
  where suff' = case suff of {('.':s) -> s; _ -> suff}

{-# LINE 717 "src/ehc/EHC/CompileUnit.chs" #-}
-- | Is HS newer?
--   If no HS exists False is returned.
ecuIsHSNewerThanHI :: EHCompileUnit -> Bool
ecuIsHSNewerThanHI ecu
  = case (ecuMbSrcTime ecu,ecuMbHIInfoTime ecu) of
      (Just ths,Just thi) -> ths `diffClockTimes` thi > noTimeDiff
      (Nothing ,Just thi) -> False
      _                   -> True

{-# LINE 736 "src/ehc/EHC/CompileUnit.chs" #-}
ecuIsValidHIInfo :: EHCompileUnit -> Bool
ecuIsValidHIInfo ecu
  = case ecuMbPrevHIInfo ecu of
      Just i -> HI.hiiValidity i == HI.HIValidity_Ok
      _      -> False

{-# LINE 744 "src/ehc/EHC/CompileUnit.chs" #-}
-- | Can HI be used instead of HS?
--   This is purely based on HI being of the right version and HS not newer.
--   The need for recompilation considers dependencies on imports as well.
ecuCanUseHIInsteadOfHS :: EHCompileUnit -> Bool
ecuCanUseHIInsteadOfHS ecu
  = ecuIsValidHIInfo ecu && not (ecuIsHSNewerThanHI ecu)