uhc-light-1.1.8.10: src/UHC/Light/Compiler/EHC/CompilePhase/TopLevelPhases.hs
module UHC.Light.Compiler.EHC.CompilePhase.TopLevelPhases
( cpEhcCheckAbsenceOfMutRecModules
, cpEhcFullProgCompileAllModules
, cpEhcFullProgModuleDetermineNeedsCompile
, cpEhcModuleCompile1 )
where
import qualified Data.Map as Map
import qualified Data.Set as Set
import UHC.Util.Lens
import qualified UHC.Util.FastSeq as Seq
import Control.Monad.State
import qualified UHC.Light.Compiler.Config as Cfg
import System.IO.Unsafe
import Debug.Trace
import UHC.Light.Compiler.Base.Optimize
import UHC.Light.Compiler.Base.Target
import UHC.Light.Compiler.EHC.Common
import UHC.Light.Compiler.EHC.CompileUnit
import UHC.Light.Compiler.EHC.CompileRun
import UHC.Light.Compiler.EHC.CompilePhase.Parsers
import UHC.Light.Compiler.EHC.CompilePhase.Translations
import UHC.Light.Compiler.EHC.CompilePhase.Output
import UHC.Light.Compiler.EHC.CompilePhase.Transformations
import UHC.Light.Compiler.EHC.CompilePhase.Semantics
import UHC.Light.Compiler.EHC.CompilePhase.FlowBetweenPhase
import UHC.Light.Compiler.EHC.CompilePhase.CompileC
import UHC.Light.Compiler.EHC.ASTHandler.Instances
import UHC.Light.Compiler.EHC.CompilePhase.Run
import UHC.Light.Compiler.EHC.CompileGroup
import UHC.Light.Compiler.EHC.CompilePhase.Module
import UHC.Light.Compiler.Module.ImportExport
import qualified UHC.Light.Compiler.Core as Core (cModMergeByConcat)
import qualified UHC.Light.Compiler.Core.Merge as CMerge (cModMerge)
import qualified UHC.Light.Compiler.Core.Check as Core2ChkSem
import qualified UHC.Light.Compiler.CoreRun.Check as CoreRun2ChkSem
import UHC.Light.Compiler.Base.PackageDatabase
import UHC.Light.Compiler.EHC.CompilePhase.Link
import UHC.Light.Compiler.Base.Pragma
import UHC.Light.Compiler.EHC.CompilePhase.Cleanup
{-# LINE 6 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
{-|
Top level combinations, stratified into 6 levels,
where higher numbered levels use lower numbered levels.
Levels:
1: processing building blocks
2: ehc compilation phases, including progress messages, stopping when asked for
3: ehc grouping of compilation phases for a single module
4: single module compilation
5: full program phases
6: full program compilation
Naming convention for functions:
level 1 : with prefix 'cpProcess'
level 2..6 : with prefix 'cpEhc'
-}
{-# LINE 118 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
-- | top lever driver for after all per-module work has been done, and whole program stuff like combining/linking can start
cpEhcFullProgLinkAllModules :: EHCCompileRunner m => [HsName] -> EHCompilePhaseT m ()
cpEhcFullProgLinkAllModules modNmL
= do { cr <- get
; let (mainModNmL,impModNmL) = crPartitionMainAndImported cr modNmL
(_,opts) = crBaseInfo' cr -- '
; when (not $ null modNmL)
(cpMsg (head modNmL) VerboseDebug ("Main mod split: " ++ show mainModNmL ++ ": " ++ show impModNmL))
; case (mainModNmL, ehcOptLinkingStyle opts) of
([mainModNm], LinkingStyle_Exec)
-> case () of
() | ehcOptOptimizationScope opts >= OptimizationScope_WholeCore
-> cpSeq ( hpt
++ exec
)
| targetDoesHPTAnalysis (ehcOptTarget opts)
-> cpSeq $ hpt ++ exec
| otherwise
-> cpSeq exec
where exec = [ cpEhcExecutablePerModule FinalCompile_Exec impModNmL mainModNm ]
hpt = [ cpEhcFullProgPostModulePhases opts modNmL (impModNmL,mainModNm)
, cpEhcCorePerModulePart2 mainModNm
]
([mainModNm], _)
-> return ()
-- cpSetLimitErrs 1 "compilation run" [rngLift emptyRange Err_MayNotHaveMain mainModNm]
([], LinkingStyle_Exec)
-> cpSetLimitErrs 1 "compilation run" [rngLift emptyRange Err_MustHaveMain]
([], LinkingStyle_None)
-> return ()
([], LinkingStyle_Pkg)
-> do let cfgwr o = liftIO $ pkgWritePkgOptionAsCfg o fp
where (fp,_) = mkInOrOutputFPathDirFor OutputFor_Pkg opts l l ""
l = mkFPath ""
case ehcOptPkgOpt opts of
Just (pkgopt@(PkgOption {pkgoptName=pkg})) -> do
cfgwr pkgopt
case () of
() | targetAllowsOLinking (ehcOptTarget opts) -> do
cpLinkO impModNmL pkg
_ -> return ()
_ -> return ()
}
{-# LINE 175 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
cpEhcCheckAbsenceOfMutRecModules :: EHCCompileRunner m => EHCompilePhaseT m ()
cpEhcCheckAbsenceOfMutRecModules
= do { cr <- get
; let mutRecL = filter (\ml -> length ml > 1) $ _crCompileOrder cr
; when (not $ null mutRecL)
(cpSetLimitErrs 1 "compilation run" [rngLift emptyRange Err_MutRecModules mutRecL]
)
}
{-# LINE 198 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
cpEhcFullProgCompileAllModules :: EHCCompileRunner m => EHCompilePhaseT m ()
cpEhcFullProgCompileAllModules
= do { cr <- get
; let modNmLL = _crCompileOrder cr
modNmL = map head modNmLL
; cpSeq ( []
++ (let modNmL2 = filter (\m -> let (ecu,_,_,_) = crBaseInfo m cr in not $ filelocIsPkg $ ecuFileLocation ecu) modNmL
nrMods = length modNmL2
in zipWith (\m i -> cpUpdCU m (ecuStoreSeqNr (EHCCompileSeqNr i nrMods)) ) modNmL2 [1..nrMods]
)
++ [cpEhcFullProgModuleCompileN modNmL]
++ [cpEhcFullProgLinkAllModules modNmL]
)
}
{-# LINE 230 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
cpEhcFullProgPostModulePhases :: EHCCompileRunner m => EHCOpts -> [HsName] -> ([HsName],HsName) -> EHCompilePhaseT m ()
cpEhcFullProgPostModulePhases opts modNmL modSpl
| ehcOptOptimizationScope opts >= OptimizationScope_WholeCore = cpEhcCoreFullProgPostModulePhases opts modNmL modSpl
| otherwise = return ()
{-# LINE 272 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
cpEhcCoreFullProgPostModulePhases :: EHCCompileRunner m => EHCOpts -> [HsName] -> ([HsName],HsName) -> EHCompilePhaseT m ()
cpEhcCoreFullProgPostModulePhases opts modNmL (impModNmL,mainModNm)
= cpSeq ([ cpSeq [void $ cpGetPrevCore m | m <- modNmL]
, mergeIntoOneBigCore
, cpTransformCore OptimizationScope_WholeCore mainModNm
, cpFlowHILamMp mainModNm
, cpProcessCoreFold mainModNm -- redo folding for replaced main module
]
-- ++ (if ehcOptDumpCoreStages opts then [void $ cpOutputCore CPOutputCoreHow_Text "" "full.core" mainModNm] else [])
++ [ cpMsg mainModNm VerboseDebug ("Full Core generated, from: " ++ show impModNmL)
]
)
where mergeIntoOneBigCore
= do { cr <- get
; cpUpdCU mainModNm
$ ecuStoreCore
$ CMerge.cModMerge (mOf mainModNm cr, [ mOf m cr | m <- impModNmL ])
; cpCleanupCore impModNmL -- clean up Core and CoreSem (it can still be read through cr in the next statement)
}
where mOf m cr = panicJust ("cpEhcCoreFullProgPostModulePhases.mergeIntoOneBigCore: " ++ show m) $ _ecuMbCore $ crCU m cr
{-# LINE 297 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
{-|
Per module compilation of (import) ordered sequence of module, as part of a full program compilation
-}
{-# LINE 301 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
cpEhcFullProgModuleCompileN :: EHCCompileRunner m => [HsName] -> EHCompilePhaseT m ()
cpEhcFullProgModuleCompileN modNmL
= cpSeq (merge (map cpEhcFullProgModuleCompile1 modNmL)
(map cpEhcFullProgBetweenModuleFlow modNmL)
)
where merge (c1:cs1) (c2:cs2) = c1 : c2 : merge cs1 cs2
merge [] cs = cs
merge cs [] = cs
{-# LINE 312 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
{-|
Find out whether a compilation is needed, and if so, can be done.
-}
{-# LINE 316 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
cpEhcFullProgModuleDetermineNeedsCompile :: EHCCompileRunner m => HsName -> EHCompilePhaseT m ()
cpEhcFullProgModuleDetermineNeedsCompile modNm
= do { cr <- get
; let (ecu,_,opts,_) = crBaseInfo modNm cr
needsCompile = crModNeedsCompile modNm cr
canCompile = ecuCanCompile ecu
; when (ehcOptVerbosity opts >= VerboseDebug)
(liftIO $ putStrLn
( show modNm
++ ", src fpath: " ++ show (ecuSrcFilePath ecu)
++ ", fileloc: " ++ show (ecuFileLocation ecu)
++ ", needs compile: " ++ show needsCompile
++ ", can compile: " ++ show canCompile
++ ", can use HI instead of HS: " ++ show (ecuCanUseHIInsteadOfHS ecu)
++ ", has main: " ++ show (ecuHasMain ecu)
++ ", is main: " ++ show (ecuIsMainMod ecu)
++ ", is top: " ++ show (ecuIsTopMod ecu)
++ ", valid HI: " ++ show (ecuIsValidHIInfo ecu)
++ ", HS newer: " ++ show (ecuIsHSNewerThanHI ecu)
))
; cpUpdCU modNm (ecuSetNeedsCompile (needsCompile && canCompile))
}
{-# LINE 341 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
{-|
Compilation of 1 module, as part of a full program compilation
-}
{-# LINE 345 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
cpEhcFullProgModuleCompile1 :: EHCCompileRunner m => HsName -> EHCompilePhaseT m ()
cpEhcFullProgModuleCompile1 modNm
= do { cr <- get
; let (_,opts) = crBaseInfo' cr -- '
; when (ehcOptVerbosity opts >= VerboseALot)
(liftIO $ putStrLn ("====================== Compile1: " ++ show modNm ++ "======================"))
; cpEhcFullProgModuleDetermineNeedsCompile modNm
; cr <- get
; let (ecu,_,_,_) = crBaseInfo modNm cr
targ = ecuFinalDestinationState ecu -- ECUS_Haskell $ if ecuNeedsCompile ecu then HSAllSem else HIAllSem
; cpEhcModuleCompile1 (Just targ) modNm
; cr <- get
; let (ecu,_,_,_) = crBaseInfo modNm cr
-- ; return ()
; when (ecuHasMain ecu) (crSetAndCheckMain modNm)
}
{-# LINE 364 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
{-|
Flow of info between modules, as part of a full program compilation
-}
{-# LINE 368 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
cpEhcFullProgBetweenModuleFlow :: EHCCompileRunner m => HsName -> EHCompilePhaseT m ()
cpEhcFullProgBetweenModuleFlow modNm
= do { cr <- get
; case ecuState $ crCU modNm cr of
ECUS_Haskell HSAllSem -> return ()
ECUS_Haskell HIAllSem -> cpFlowHISem modNm
_ -> return ()
; cpCleanupFlow modNm
}
{-# LINE 390 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
cpEhcModuleCompile1 :: EHCCompileRunner m => Maybe EHCompileUnitState -> HsName -> EHCompilePhaseT m HsName
cpEhcModuleCompile1 targHSState modNm
{-# LINE 394 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
= do { cr <- get
; let (ecu,_,opts,fp) = crBaseInfo modNm cr
defaultResult = modNm
; when (ehcOptVerbosity opts >= VerboseALot)
(liftIO $ putStrLn ("====================== Module: " ++ show modNm ++ " ======================"))
; when (ehcOptVerbosity opts >= VerboseDebug)
(liftIO $ putStrLn ("State: in: " ++ show (ecuState ecu) ++ ", to: " ++ show targHSState))
; case (ecuState ecu,targHSState) of
{-# LINE 422 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
(ECUS_Haskell st,Just (ECUS_Haskell HSOnlyImports))
| st == HSStart
|| st == LHSStart
-> do { cpEhcHaskellModulePrepareSrc modNm
; modNm2 <- cpEhcHaskellImport stnext
(pkgExposedPackages $ ehcOptPkgDb opts)
modNm
; cpEhcHaskellModulePrepareHS2 modNm2
; cpMsg modNm2 VerboseNormal ("Imports of " ++ hsstateShowLit st ++ "Haskell")
; when (ehcOptVerbosity opts >= VerboseDebug)
(do { cr <- get
; let (ecu,_,opts,fp) = crBaseInfo modNm2 cr
; liftIO $ putStrLn ("After HS import: nm=" ++ show modNm ++ ", newnm=" ++ show modNm2 ++ ", fp=" ++ show fp ++ ", imp=" ++ show (ecuImpNmS ecu))
})
; cpUpdCU modNm2 (ecuStoreState (ECUS_Haskell stnext))
; cpStopAt CompilePoint_Imports
; return modNm2
}
where stnext = hsstateNext st
(ECUS_Haskell HIStart,Just (ECUS_Haskell HSOnlyImports))
-> do { cpMsg modNm VerboseNormal ("Imports of HI")
; cpEhcHaskellModulePrepareHI modNm
; cpUpdCU modNm (ecuStoreState (ECUS_Haskell (hsstateNext HIStart)))
; when (ehcOptVerbosity opts >= VerboseDebug)
(do { cr <- get
; let (ecu,_,opts,fp) = crBaseInfo modNm cr
; liftIO $ putStrLn ("After HI import: nm=" ++ show modNm ++ ", fp=" ++ show fp ++ ", imp=" ++ show (ecuImpNmS ecu))
})
; return defaultResult
}
(ECUS_Haskell st,Just (ECUS_Haskell HSOnlyImports))
| st == HSOnlyImports
|| st == HIOnlyImports
|| st == LHSOnlyImports
-> return defaultResult
(ECUS_Haskell st,Just (ECUS_Haskell HSAllSem))
| st == HSOnlyImports
|| st == LHSOnlyImports
-> do { cpMsg modNm VerboseMinimal ("Compiling " ++ hsstateShowLit st ++ "Haskell")
; cpEhcHaskellModuleAfterImport (ecuIsTopMod ecu) opts st
(pkgExposedPackages $ ehcOptPkgDb opts)
modNm
; cpUpdCU modNm (ecuStoreState (ECUS_Haskell HSAllSem))
; return defaultResult
}
(ECUS_Haskell st,Just (ECUS_Haskell HIAllSem))
| st == HSOnlyImports
|| st == HIOnlyImports
|| st == LHSOnlyImports
-> do { cpMsg modNm VerboseNormal "Reading HI"
; cpUpdCU modNm (ecuStoreState (ECUS_Haskell HIAllSem))
; return defaultResult
}
{-# LINE 493 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
(ECUS_Haskell HSStart,_)
-> do { cpMsg modNm VerboseMinimal "Compiling Haskell"
; cpEhcHaskellModulePrepare modNm
; cpEhcHaskellParse
(ehcOptCPP opts) False
(pkgExposedPackages $ ehcOptPkgDb opts)
modNm
; cpEhcHaskellModuleCommonPhases True True opts modNm
; when (ehcOptWholeProgHPTAnalysis opts)
(cpEhcCoreGrinPerModuleDoneFullProgAnalysis modNm)
; cpUpdCU modNm (ecuStoreState (ECUS_Haskell HSAllSem))
; return defaultResult
}
(ECUS_Haskell st,Just (ECUS_Haskell HMOnlyMinimal))
| st == HIStart || st == HSStart -- st /= HMOnlyMinimal
-> do { let mod = emptyMod' modNm
; cpUpdCU modNm (ecuStoreMod mod)
-- ; cpCheckModsWithBuiltin [modNm]
; cpUpdCU modNm (ecuStoreState (ECUS_Haskell HMOnlyMinimal))
; return defaultResult
}
(ECUS_CoreRun cst, Just (ECUS_Haskell HSOnlyImports))
| {- cst == CRRStartText || -} isBinary
-> do { cpMsg modNm VerboseNormal $ "Reading CoreRun (" ++ (if isBinary then "binary" else "textual") ++ ")"
; cpEhcHaskellModulePrepareSrc modNm
; modNm2 <- cpEhcCoreRunImport isBinary modNm
; cpUpdCU modNm2 (ecuStoreState (ECUS_CoreRun CRROnlyImports))
; return modNm2
}
where isBinary = cst == CRRStartBinary
(ECUS_CoreRun CRROnlyImports,Just (ECUS_CoreRun CRRAllSem))
-> do { cpMsg modNm VerboseMinimal "Compiling CoreRun"
; cpEhcCoreRunModuleAfterImport (ecuIsTopMod ecu) opts modNm
; cpUpdCU modNm (ecuStoreState (ECUS_CoreRun CRRAllSem))
; return defaultResult
}
(ECUS_Core cst, Just (ECUS_Haskell HSOnlyImports))
| cst == CRStartText || isBinary
-> do { cpMsg modNm VerboseNormal $ "Reading Core (" ++ (if isBinary then "binary" else "textual") ++ ")"
; cpEhcHaskellModulePrepareSrc modNm
; modNm2 <- cpEhcCoreImport isBinary modNm
; cpUpdCU modNm2 (ecuStoreState (ECUS_Core CROnlyImports))
; return modNm2
}
where isBinary = cst == CRStartBinary
(ECUS_Core CROnlyImports,Just (ECUS_Core CRAllSem))
-> do { cpMsg modNm VerboseMinimal "Compiling Core"
; cpEhcCoreModuleAfterImport (ecuIsTopMod ecu) opts modNm
; cpUpdCU modNm (ecuStoreState (ECUS_Core CRAllSem))
; return defaultResult
}
(_,Just (ECUS_Haskell HSOnlyImports))
-> return defaultResult
(ECUS_Eh EHStart,_)
-> do { cpMsg modNm VerboseMinimal "Compiling EH"
; cpUpdOpts (\o -> o {ehcOptHsChecksInEH = True})
; cpEhcEhParse modNm
; cpGetDummyCheckSrcMod modNm
; cpEhcEhModuleCommonPhases True True True opts modNm
; when (ehcOptWholeProgHPTAnalysis opts)
(cpEhcCoreGrinPerModuleDoneFullProgAnalysis modNm)
; cpUpdCU modNm (ecuStoreState (ECUS_Eh EHAllSem))
; return defaultResult
}
(ECUS_C CStart,_)
| targetIsOnUnixAndOrC (ehcOptTarget opts)
-> do { cpSeq [ cpMsg modNm VerboseMinimal "Compiling C"
, cpCompileWithGCC FinalCompile_Module [] modNm
, cpUpdCU modNm (ecuStoreState (ECUS_C CAllSem))
]
; return defaultResult
}
| otherwise
-> do { cpMsg modNm VerboseMinimal "Skipping C"
; return defaultResult
}
(ECUS_O OStart,_)
| targetIsOnUnixAndOrC (ehcOptTarget opts)
-> do { cpSeq [ cpMsg modNm VerboseMinimal "Passing through .o file"
-- , cpCompileWithGCC FinalCompile_Module [] modNm
, cpUpdCU modNm (ecuStoreState (ECUS_O OAllSem))
]
; return defaultResult
}
| otherwise
-> do { cpMsg modNm VerboseMinimal "Skipping .o file"
; return defaultResult
}
_ -> return defaultResult
}
{-# LINE 622 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
{-|
EH common phases: analysis + core + grin
-}
{-# LINE 626 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
cpEhcCoreModuleCommonPhases :: EHCCompileRunner m => Bool -> Bool -> Bool -> EHCOpts -> HsName -> EHCompilePhaseT m ()
cpEhcCoreModuleCommonPhases isMainMod isTopMod doMkExec opts modNm
= cpSeq ([
cpEhcCorePerModulePart1 modNm
]
)
{-# LINE 643 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
cpEhcEhModuleCommonPhases :: EHCCompileRunner m => Bool -> Bool -> Bool -> EHCOpts -> HsName -> EHCompilePhaseT m ()
cpEhcEhModuleCommonPhases isMainMod isTopMod doMkExec opts modNm
= cpSeq [ cpEhcEhAnalyseModuleDefs modNm
, cpEhcCoreModuleCommonPhases isMainMod isTopMod doMkExec opts modNm
]
{-# LINE 651 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
-- | Common phases when starting with a Haskell module.
-- HS common phases: HS analysis + EH common
cpEhcHaskellModuleCommonPhases :: EHCCompileRunner m => Bool -> Bool -> EHCOpts -> HsName -> EHCompilePhaseT m ()
cpEhcHaskellModuleCommonPhases isTopMod doMkExec opts modNm
= cpSeq [ cpEhcHaskellAnalyseModuleDefs modNm
, do { cr <- get
; let (ecu,_,_,_) = crBaseInfo modNm cr
; cpEhcEhModuleCommonPhases
(ecuIsMainMod ecu)
isTopMod doMkExec opts modNm
}
]
{-# LINE 670 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
-- | All the work to be done after Haskell src imports have been read/analysed.
-- Post module import common phases: Parse + Module analysis + HS common
cpEhcHaskellModuleAfterImport
:: EHCCompileRunner m =>
Bool -> EHCOpts -> HSState
-> [PkgModulePartition]
-> HsName -> EHCompilePhaseT m ()
cpEhcHaskellModuleAfterImport
isTopMod opts hsst
pkgKeyDirL
modNm
= cpSeq [ cpEhcHaskellParse False (hsstateIsLiteral hsst)
pkgKeyDirL
modNm
, cpEhcHaskellAnalyseModuleItf modNm
, cpEhcHaskellModuleCommonPhases isTopMod False opts modNm
, cpEhcHaskellModulePostlude modNm
]
{-# LINE 697 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
-- | All the work to be done after Core src/binary imports have been read/analysed
cpEhcCoreModuleAfterImport
:: EHCCompileRunner m =>
Bool -> EHCOpts
-> HsName -> EHCompilePhaseT m ()
cpEhcCoreModuleAfterImport
isTopMod opts
modNm
= do { cr <- get
; let (ecu,_,_,_) = crBaseInfo modNm cr
; cpSeq
[ cpEhcCoreAnalyseModuleItf modNm
, cpProcessCoreModFold modNm
, cpEhcCoreModuleCommonPhases (ecuIsMainMod ecu) isTopMod False opts modNm
]
}
{-# LINE 716 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
-- | All the work to be done after CoreRun src/binary imports have been read/analysed
cpEhcCoreRunModuleAfterImport
:: EHCCompileRunner m =>
Bool -> EHCOpts
-> HsName -> EHCompilePhaseT m ()
cpEhcCoreRunModuleAfterImport
isTopMod opts
modNm
= do { cr <- get
; let (ecu,_,_,_) = crBaseInfo modNm cr
; cpSeq
[ cpEhcCoreRunAnalyseModuleItf modNm
, cpProcessCoreRunModFold modNm
-- , cpEhcCoreRunModuleCommonPhases (ecuIsMainMod ecu) isTopMod False opts modNm
]
}
{-# LINE 739 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
{-|
Prepare module for compilation.
This should be the first step before compilation of a module and is meant to obtain cached info from a previous compilation.
-}
{-# LINE 756 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
cpEhcHaskellModulePrepareSrc :: EHCCompileRunner m => HsName -> EHCompilePhaseT m ()
cpEhcHaskellModulePrepareSrc modNm
= cpGetMetaInfo [GetMeta_Src,GetMeta_Dir] modNm
cpEhcHaskellModulePrepareHS2 :: EHCCompileRunner m => HsName -> EHCompilePhaseT m ()
cpEhcHaskellModulePrepareHS2 modNm
= cpSeq [ cpGetMetaInfo
[ GetMeta_Src, GetMeta_HI, GetMeta_Core
, GetMeta_CoreRun
, GetMeta_Dir
] modNm
, cpGetPrevHI modNm
-- , cpFoldHI modNm
, cpFoldHIInfo modNm
]
cpEhcHaskellModulePrepareHI :: EHCCompileRunner m => HsName -> EHCompilePhaseT m ()
cpEhcHaskellModulePrepareHI modNm
= cpSeq [ cpGetMetaInfo
[ GetMeta_HI, GetMeta_Core
, GetMeta_CoreRun
] modNm
, cpGetPrevHI modNm
-- , cpFoldHI modNm
, cpFoldHIInfo modNm
]
cpEhcHaskellModulePrepare :: EHCCompileRunner m => HsName -> EHCompilePhaseT m ()
cpEhcHaskellModulePrepare modNm
= cpSeq [ cpEhcHaskellModulePrepareSrc modNm
, cpEhcHaskellModulePrepareHS2 modNm
]
{-# LINE 801 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
cpEhcHaskellModulePostlude :: EHCCompileRunner m => HsName -> EHCompilePhaseT m ()
cpEhcHaskellModulePostlude modNm
= cpSeq [ cpOutputHI "hi" modNm
, cpCleanupCU modNm
]
{-# LINE 811 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
-- | Get import information from Haskell module source text.
cpEhcHaskellImport
:: EHCCompileRunner m =>
HSState
-> [PkgModulePartition]
-> HsName -> EHCompilePhaseT m HsName
cpEhcHaskellImport
hsst
pkgKeyDirL
modNm
= do { cr <- get
; let (_,opts) = crBaseInfo' cr
-- 1st, parse
; cppAndParse modNm
(ehcOptCPP opts)
; cpStepUID
-- and then get pragmas and imports
; modNm' <- foldAndImport modNm
; cr2 <- get
; let (ecu,_,opts2,_) = crBaseInfo modNm' cr2
-- if we find out that CPP should have invoked or cmdline options (pragma OPTIONS_UHC) have been specified,
-- we backtrack to the original runstate and redo the above with CPP
; if (not (ehcOptCPP opts2) -- reinvoke if CPP has not been invoked before
|| ehcOptCmdLineOptsDoneViaPragma opts2 -- or options have been set via pragma
)
-- check whether the pragma has a cmdline option like effect
&& (not $ null $ filter pragmaInvolvesCmdLine $ Set.toList $ ecuPragmas ecu) -- Set.member Pragma_CPP (ecuPragmas ecu)
then do { put cr
; when (isJust $ ecuMbOpts ecu)
(cpUpdCU modNm (ecuStoreOpts opts2))
; cppAndParse modNm (ehcOptCPP opts || Set.member Pragma_CPP (ecuPragmas ecu))
; cpStepUID
; foldAndImport modNm
}
else return modNm'
}
where cppAndParse modNm
doCPP
= cpSeq [ when doCPP (cpPreprocessWithCPP pkgKeyDirL modNm)
, cpParseHsImport (hsstateIsLiteral hsst) modNm
]
foldAndImport modNm
= do { cpFoldHsMod modNm
; cpGetHsModnameAndImports modNm
}
{-# LINE 877 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
-- | Parse a Haskell module
cpEhcHaskellParse
:: EHCCompileRunner m =>
Bool -> Bool
-> [PkgModulePartition]
-> HsName -> EHCompilePhaseT m ()
cpEhcHaskellParse
doCPP litmode
pkgKeyDirL
modNm
= cpSeq (
(if doCPP then [cpPreprocessWithCPP pkgKeyDirL modNm] else [])
++ [ cpParseHs litmode modNm ]
++ [ cpMsg modNm VerboseALot "Parsing done"
, cpStopAt CompilePoint_Parse
]
)
{-# LINE 905 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
cpEhcEhParse :: EHCCompileRunner m => HsName -> EHCompilePhaseT m ()
cpEhcEhParse modNm
= cpSeq [ cpParseEH modNm
, cpStopAt CompilePoint_Parse
]
{-# LINE 913 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
cpEhcCoreParse :: EHCCompileRunner m => HsName -> EHCompilePhaseT m ()
cpEhcCoreParse modNm
= cpSeq [ cpParseCoreWithFPath Nothing modNm
, cpStopAt CompilePoint_Parse
]
{-# LINE 921 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
-- | Analyse a Haskell src module for
-- (1) module information (import, export, etc),
cpEhcHaskellAnalyseModuleItf :: EHCCompileRunner m => HsName -> EHCompilePhaseT m ()
cpEhcHaskellAnalyseModuleItf modNm
= cpSeq [ cpStepUID, cpFoldHsMod modNm, cpGetHsMod modNm
, cpCheckModsWithBuiltin [modNm]
, cpCleanupHSMod modNm
]
{-# LINE 937 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
-- | Analyse a Core text/binary src module for
-- (1) module information (import, export, etc).
-- Note: TBD: identical to cpEhcCoreRunAnalyseModuleItf
cpEhcCoreAnalyseModuleItf :: EHCCompileRunner m => HsName -> EHCompilePhaseT m ()
cpEhcCoreAnalyseModuleItf modNm
= cpSeq [ cpMsg modNm VerboseDebug "cpEhcCoreAnalyseModuleItf"
, cpCheckModsWithoutBuiltin [modNm]
-- , cpCleanupHSMod modNm
]
{-# LINE 954 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
-- | Analyse a CoreRun text/binary src module for
-- (1) module information (import, export, etc).
-- Note: TBD: identical to cpEhcCoreAnalyseModuleItf
cpEhcCoreRunAnalyseModuleItf :: EHCCompileRunner m => HsName -> EHCompilePhaseT m ()
cpEhcCoreRunAnalyseModuleItf modNm
= cpSeq [ cpMsg modNm VerboseDebug "cpEhcCoreRunAnalyseModuleItf"
, cpCheckModsWithoutBuiltin [modNm]
-- , cpCleanupHSMod modNm
]
{-# LINE 971 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
-- | Analyse a Haskell src module for
-- (2) names + dependencies
cpEhcHaskellAnalyseModuleDefs :: EHCCompileRunner m => HsName -> EHCompilePhaseT m ()
cpEhcHaskellAnalyseModuleDefs modNm
= cpSeq [ cpStepUID
, cpProcessHs modNm
, cpMsg modNm VerboseALot "Name+dependency analysis done"
, cpStopAt CompilePoint_AnalHS
]
{-# LINE 983 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
-- | Analyse a Haskell src module for
-- (3) types
cpEhcEhAnalyseModuleDefs :: EHCCompileRunner m => HsName -> EHCompilePhaseT m ()
cpEhcEhAnalyseModuleDefs modNm
= cpSeq [ cpStepUID, cpProcessEH modNm
, cpMsg modNm VerboseALot "Type analysis done"
, cpStopAt CompilePoint_AnalEH
]
{-# LINE 994 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
-- | Part 1 Core processing, on a per module basis, part1 is done always
cpEhcCorePerModulePart1 :: EHCCompileRunner m => HsName -> EHCompilePhaseT m ()
cpEhcCorePerModulePart1 modNm
= do { cr <- get
; let (_,_,opts,_) = crBaseInfo modNm cr
earlyMerge = ehcOptOptimizationScope opts >= OptimizationScope_WholeCore
; cpSeq
( [ cpStepUID ]
++ [ cpProcessCoreBasic modNm
, cpMsg modNm VerboseALot "Core (basic) done"
, when (not earlyMerge) $ cpProcessCoreRest modNm
, cpStopAt CompilePoint_Core
]
)
}
{-# LINE 1026 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
-- | Get import information from Core module source text/binary.
cpEhcCoreImport
:: EHCCompileRunner m => Bool -> HsName -> EHCompilePhaseT m HsName
cpEhcCoreImport
isBinary modNm
= do { cr <- get
; let (_,opts) = crBaseInfo' cr
; if isBinary
then cpDecodeCore Nothing modNm
else cpParseCoreWithFPath Nothing modNm
; cpFoldCoreMod modNm
; cpGetCoreModnameAndImports modNm
}
{-# LINE 1043 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
-- | Get import information from CoreRun module source text/binary.
cpEhcCoreRunImport
:: EHCCompileRunner m => Bool -> HsName -> EHCompilePhaseT m HsName
cpEhcCoreRunImport
isBinary modNm
= do { cr <- get
; let (_,opts) = crBaseInfo' cr
; {- if isBinary
then -} cpDecodeCoreRun Nothing modNm
{- else cpParseCoreWithFPath Nothing modNm -}
; cpFoldCoreRunMod modNm
; cpGetCoreRunModnameAndImports modNm
}
{-# LINE 1060 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
-- | Analyse a Core src module
cpEhcCoreAnalyseModule :: EHCCompileRunner m => HsName -> EHCompilePhaseT m ()
cpEhcCoreAnalyseModule modNm
= do { cr <- get
; cpUpdateModOffMp [modNm]
; let (ecu,_,opts,_) = crBaseInfo modNm cr
coreSem = panicJust "cpEhcCoreAnalyseModule" $ _ecuMbCoreSemMod ecu
errs = Seq.toList $ Core2ChkSem.errs_Syn_CodeAGItf coreSem
; cpSetLimitErrsWhen 5 "Core analysis" errs
}
{-# LINE 1073 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
-- | Analyse a CoreRun src module
cpEhcCoreRunAnalyseModule :: EHCCompileRunner m => HsName -> EHCompilePhaseT m ()
cpEhcCoreRunAnalyseModule modNm
= do { cr <- get
; cpUpdateModOffMp [modNm]
; let (ecu,_,opts,_) = crBaseInfo modNm cr
corerunSem = panicJust "cpEhcCoreRunAnalyseModule" $ _ecuMbCoreRunSemMod ecu
errs = [] -- No errors -- Seq.toList $ CoreRun2ChkSem.errs_Syn_AGItf corerunSem
; cpSetLimitErrsWhen 5 "CoreRun analysis" errs
}
{-# LINE 1086 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
-- | Part 2 Core processing, part2 is done either for per individual module compilation or after full program analysis
cpEhcCorePerModulePart2 :: EHCCompileRunner m => HsName -> EHCompilePhaseT m ()
cpEhcCorePerModulePart2 modNm
= do { cr <- get
; let (_,_,opts,_) = crBaseInfo modNm cr
earlyMerge = ehcOptOptimizationScope opts >= OptimizationScope_WholeCore
; cpSeq [ when earlyMerge $ cpProcessCoreRest modNm
]
}
{-# LINE 1105 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
-- | Part 2 CoreRun processing, part2 is done either for per individual module compilation or after full program analysis
cpEhcCoreRunPerModulePart2 :: EHCCompileRunner m => HsName -> EHCompilePhaseT m ()
cpEhcCoreRunPerModulePart2 = cpProcessCoreRunRest
{-# LINE 1136 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
-- | Core+grin processing, on a per module basis, may only be done when full program analysis is done
cpEhcCoreGrinPerModuleDoneFullProgAnalysis :: EHCCompileRunner m => HsName -> EHCompilePhaseT m ()
cpEhcCoreGrinPerModuleDoneFullProgAnalysis modNm
= cpSeq ( [ cpEhcCorePerModulePart2 modNm
, cpEhcExecutablePerModule FinalCompile_Exec [] modNm
, cpMsg modNm VerboseALot "Full Program Analysis (Core+Grin) done"
]
)
{-# LINE 1147 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
-- | Make final executable code, either still partly or fully (i.e. also linking)
cpEhcExecutablePerModule :: EHCCompileRunner m => FinalCompileHow -> [HsName] -> HsName -> EHCompilePhaseT m ()
cpEhcExecutablePerModule how impModNmL modNm
= do { cr <- get
; let (_,_,opts,_) = crBaseInfo modNm cr
; cpSeq $
[ cpCompileWithGCC how impModNmL modNm ]
}
{-# LINE 1173 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
cpProcessHs :: EHCCompileRunner m => HsName -> EHCompilePhaseT m ()
cpProcessHs modNm
= cpSeq [ cpFoldHs modNm
, cpFlowHsSem1 modNm
, cpTranslateHs2EH modNm
, cpCleanupHS modNm
]
{-# LINE 1187 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
cpProcessEH :: EHCCompileRunner m => HsName -> EHCompilePhaseT m ()
cpProcessEH modNm
= do { cr <- get
; let (_,_,opts,fp) = crBaseInfo modNm cr
{-
optsTr = opts { ehcOptTrace = \s x -> unsafePerformIO (do { s <- execStateT (do { cpMsg modNm VerboseALot ("EH>: " ++ s)
; x `seq` cpMsg modNm VerboseALot ("EH<: " ++ s)
}) cr
; return x
}) }
-- optsTr = opts { ehcOptTrace = \s x -> unsafePerformIO (do { putCompileMsg VerboseALot (ehcOptVerbosity opts) ("EH: " ++ s) Nothing modNm fp ; return x }) }
-- optsTr = opts { ehcOptTrace = \s x -> unsafePerformIO (do { putStrLn ("EH: " ++ s) ; return x }) }
-- optsTr = opts { ehcOptTrace = trace }
-- ; cpUpdStateInfo (\crsi -> crsi {crsiOpts = optsTr})
; cpUpdCU modNm (ecuStoreOpts optsTr)
-}
; cpSeq [ cpFoldEH modNm
, cpCleanupFoldEH modNm
, cpFlowEHSem1 modNm
, cpTranslateEH2Output modNm
,
cpTranslateEH2Core modNm
, cpCleanupEH modNm
]
}
{-# LINE 1249 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
-- unprocessed core -> folded core
cpProcessCoreBasic :: EHCCompileRunner m => HsName -> EHCompilePhaseT m ()
cpProcessCoreBasic modNm
= do { cr <- get
; let (_,_,opts,_) = crBaseInfo modNm cr
; cpSeq [ cpTransformCore OptimizationScope_PerModule modNm
, cpFlowHILamMp modNm
, void $ cpOutputCore ASTFileContent_Binary {-[]-} "" Cfg.suffixDotlessBinaryCore modNm
-- , void $ cpOutputSomeModule (^. ecuCore) astHandler'_Core ASTFileContent_Binary "" Cfg.suffixDotlessBinaryCore modNm
, cpProcessCoreFold modNm
, when (targetIsCoreVariation (ehcOptTarget opts)) $
void $ -- cpOutputCoreRun ASTFileContent_Binary "" Cfg.suffixDotlessBinaryCoreRun modNm
cpOutputSomeModule (^. ecuCoreRun) astHandler'_CoreRun ASTFileContent_Binary "" Cfg.suffixDotlessBinaryCoreRun modNm
]
}
{-# LINE 1271 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
-- unfolded core -> folded core
-- (called on merged core, and on core directly generated from cached grin)
cpProcessCoreFold :: EHCCompileRunner m => HsName -> EHCompilePhaseT m ()
cpProcessCoreFold modNm
= do { cr <- get
; let (_,_,opts,_) = crBaseInfo modNm cr
; cpSeq $ [] ++
[ cpFlowCoreSemBeforeFold modNm ] ++
(if targetIsViaGrin (ehcOptTarget opts) then [ cpFoldCore2Grin modNm ] else []) ++
(if targetIsCoreVariation (ehcOptTarget opts) then [ cpFoldCore2CoreRun modNm ] else []) ++
[ cpFlowCoreSemAfterFold modNm ] ++
[]
}
{-# LINE 1293 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
cpProcessCoreModFold :: EHCCompileRunner m => HsName -> EHCompilePhaseT m ()
cpProcessCoreModFold modNm
= cpSeq $
[ cpEhcCoreAnalyseModule modNm
, cpFlowCoreModSem modNm
]
{-# LINE 1302 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
cpProcessCoreRunModFold :: EHCCompileRunner m => HsName -> EHCompilePhaseT m ()
cpProcessCoreRunModFold modNm
= cpSeq $
[ cpEhcCoreRunAnalyseModule modNm
-- , cpFlowCoreRunModSem modNm
]
{-# LINE 1311 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
-- folded core -> grin, jazy, and the rest
cpProcessCoreRest :: EHCCompileRunner m => HsName -> EHCompilePhaseT m ()
cpProcessCoreRest modNm
= do { cr <- get
; let (_,_,opts,_) = crBaseInfo modNm cr
; cpSeq ( []
++ (if CoreOpt_Dump `elem` ehcOptCoreOpts opts
then [void $ cpOutputCore ASTFileContent_Text {-[]-} "" Cfg.suffixDotlessOutputTextualCore modNm]
else [])
++ (if CoreOpt_DumpBinary `elem` ehcOptCoreOpts opts
then [void $ cpOutputCore ASTFileContent_Binary {-[]-} "" Cfg.suffixDotlessInputOutputBinaryCore modNm]
else [])
++ [ cpProcessCoreRunRest modNm ]
++ [ cpCleanupCore [modNm] ]
)
}
{-# LINE 1349 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
-- | folded corerun -> ...
cpProcessCoreRunRest :: EHCCompileRunner m => HsName -> EHCompilePhaseT m ()
cpProcessCoreRunRest modNm
= do { cr <- get
; let (_,_,opts,_) = crBaseInfo modNm cr
; cpSeq ( []
++ (if CoreOpt_RunDump `elem` ehcOptCoreOpts opts
then -- [void $ cpOutputCore CPOutputCoreHow_CoreRun_Text {-[]-} "" Cfg.suffixDotlessInputOutputCoreRun modNm]
[void $ cpOutputSomeModule (^. ecuCoreRun) astHandler'_CoreRun ASTFileContent_Text "" Cfg.suffixDotlessInputOutputCoreRun modNm]
else [])
++ (if CoreOpt_Run `elem` ehcOptCoreOpts opts -- TBD: only when right backend? For now, just do it
then [cpRunCoreRun modNm]
-- [cpRunCoreRun2 modNm]
-- [cpRunCoreRun3 modNm]
else [])
)
}