CompileUnit.hs

module UHC.Light.Compiler.EHC.CompileUnit
( EHCompileUnit (..)
, ecuFilePath
, emptyECU
, ecuFinalDestinationState
, EcuUpdater, ecuStoreSrcFilePath, ecuStoreState, ecuStoreHS, ecuStoreEH, ecuStoreHSSem, ecuStoreEHSem
, ecuStoreCoreSemMod
, ecuStoreCoreSem
, ecuStoreCore
, 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
, 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.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.Check as Core2ChkSem
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 92 "src/ehc/EHC/CompileUnit.chs" #-}
data Optim
  = Optim

defaultOptim :: Optim
defaultOptim
  = Optim

{-# LINE 115 "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 137 "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)
      , ecuMbCoreSemMod      :: !(Maybe Core2ChkSem.Syn_CodeAGItf)
      , 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
      , 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 211 "src/ehc/EHC/CompileUnit.chs" #-}
ecuHSDeclImpNmS = iumHSDeclModules . ecuImportUsedModules
ecuHIDeclImpNmS = iumHIDeclModules . ecuImportUsedModules
ecuHIUsedImpNmS = iumHIUsedModules . ecuImportUsedModules

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

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

{-# LINE 232 "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 243 "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
      , ecuMbCoreSemMod      = Nothing
      , ecuState             = ECUS_Unknown
      , ecuImportUsedModules = emptyImportUsedModules
      , ecuIsTopMod          = False
      , ecuHasMain           = False
      , ecuNeedsCompile      = True
      , ecuMbSrcTime         = Nothing
      , ecuMbHIInfoTime      = Nothing
      , ecuMbCoreTime        = 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 321 "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 330 "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 340 "src/ehc/EHC/CompileUnit.chs" #-}
-- | Is orphan, according to .hi info
ecuIsOrphan :: EHCompileUnit -> Bool
ecuIsOrphan = isJust . HI.hiiMbOrphan . ecuAnHIInfo

{-# LINE 360 "src/ehc/EHC/CompileUnit.chs" #-}
instance CompileUnitState EHCompileUnitState where
  cusDefault      = ECUS_Eh EHStart
  cusUnk          = ECUS_Unknown
  cusIsUnk        = (==ECUS_Unknown)
{-# LINE 369 "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
                      _                           -> False

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

{-# LINE 391 "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 437 "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 454 "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 479 "src/ehc/EHC/CompileUnit.chs" #-}
ecuStoreCoreSemMod :: EcuUpdater Core2ChkSem.Syn_CodeAGItf
ecuStoreCoreSemMod x ecu = ecu { ecuMbCoreSemMod = Just x }

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

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

{-# LINE 546 "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 609 "src/ehc/EHC/CompileUnit.chs" #-}
ecuStoreCoreTime :: EcuUpdater ClockTime
ecuStoreCoreTime x ecu = ecu { ecuMbCoreTime = Just x }

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

{-# LINE 624 "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 638 "src/ehc/EHC/CompileUnit.chs" #-}
ecuStoreGenCodeFiles :: EcuUpdater [FPath]
ecuStoreGenCodeFiles x ecu = ecu { ecuGenCodeFiles = x }

{-# LINE 643 "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 655 "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 674 "src/ehc/EHC/CompileUnit.chs" #-}
ecuIsValidHIInfo :: EHCompileUnit -> Bool
ecuIsValidHIInfo ecu
  = case ecuMbPrevHIInfo ecu of
      Just i -> HI.hiiValidity i == HI.HIValidity_Ok
      _      -> False

{-# LINE 682 "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)