uhc-light-1.1.9.1: 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 UHC.Light.Compiler.EHC.ASTTypes
import UHC.Light.Compiler.EHC.BuildFunction.Run
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.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 121 "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 178 "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 201 "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 233 "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 275 "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 300 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
{-|
Per module compilation of (import) ordered sequence of module, as part of a full program compilation
-}
{-# LINE 304 "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 315 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
{-|
Find out whether a compilation is needed, and if so, can be done.
-}
{-# LINE 319 "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
-- ; canCompile <- bcall $ CanCompile $ mkPrevFileSearchKeyWithName modNm
; 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 345 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
{-|
Compilation of 1 module, as part of a full program compilation
-}
{-# LINE 349 "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 368 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
{-|
Flow of info between modules, as part of a full program compilation
-}
{-# LINE 372 "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 394 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
cpEhcModuleCompile1 :: EHCCompileRunner m => Maybe EHCompileUnitState -> HsName -> EHCompilePhaseT m HsName
cpEhcModuleCompile1 targHSState modNm
{-# LINE 398 "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 426 "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
-- ; (modNm2, _, _, _) <- bcall $ HsModnameAndImports 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")
-- ; isTopMod <- bcall $ IsTopMod $ mkPrevFileSearchKeyWithName modNm
; cpEhcHaskellModuleAfterImport {- isTopMod -} (_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 501 "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_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
-- ; (modNm2, _, _, _) <- bcall $ ModnameAndImports (mkPrevFileSearchKeyWithName modNm) ASTType_Core
; 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"
-- ; isTopMod <- bcall $ IsTopMod $ mkPrevFileSearchKeyWithName modNm
; cpEhcCoreModuleAfterImport {- isTopMod -} (_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})
; (_ :: AST_EH) <- bcall $ ASTFromFile (mkPrevFileSearchKeyWithName modNm) (AlwaysEq ASTFileTimeHandleHow_Ignore) ASTType_EH (ASTFileContent_Text, ASTFileUse_Src) ASTFileTiming_Current
; cpStopAt CompilePoint_Parse
-- ; 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 636 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
{-|
EH common phases: analysis + core + grin
-}
{-# LINE 640 "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 657 "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 665 "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 684 "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 711 "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 730 "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 753 "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 770 "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 = do
cpGetMetaInfo
[ GetMeta_Src, GetMeta_HI, GetMeta_Core
, GetMeta_CoreRun
, GetMeta_Dir
] modNm
cpGetPrevHI modNm
cpFoldHIInfo modNm
-- void $ bcall $ FoldHIInfo modNm
cpEhcHaskellModulePrepareHI :: EHCCompileRunner m => HsName -> EHCompilePhaseT m ()
cpEhcHaskellModulePrepareHI modNm = do
cpGetMetaInfo
[ GetMeta_HI, GetMeta_Core
, GetMeta_CoreRun
] modNm
cpGetPrevHI modNm
cpFoldHIInfo modNm
-- void $ bcall $ FoldHIInfo modNm
cpEhcHaskellModulePrepare :: EHCCompileRunner m => HsName -> EHCompilePhaseT m ()
cpEhcHaskellModulePrepare modNm
= cpSeq [ cpEhcHaskellModulePrepareSrc modNm
, cpEhcHaskellModulePrepareHS2 modNm
]
{-# LINE 813 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
cpEhcHaskellModulePostlude :: EHCCompileRunner m => HsName -> EHCompilePhaseT m ()
cpEhcHaskellModulePostlude modNm
= cpSeq [ cpOutputHI "hi" modNm
, cpCleanupCU modNm
]
{-# LINE 823 "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 (void $ bcall $ FPathPreprocessedWithCPP pkgKeyDirL (mkPrevFileSearchKeyWithName modNm))
when doCPP (void $ cpPreprocessWithCPP pkgKeyDirL modNm)
, cpParseHsImport (hsstateIsLiteral hsst) modNm
-- , bcall $ ASTFromFile (mkPrevFileSearchKeyWithName modNm) (AlwaysEq ASTFileTimeHandleHow_AbsenceIsError) ASTType_HS (ASTFileContent_Text, ASTFileUse_SrcImport) ASTFileTiming_Current
]
foldAndImport modNm
= do cpFoldHsMod modNm
-- bcall $ FoldHsMod (mkPrevFileSearchKeyWithName modNm)
cpGetHsModnameAndImports modNm
{-# LINE 892 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
-- | Parse a Haskell module
cpEhcHaskellParse
:: EHCCompileRunner m =>
Bool -> Bool
-> [PkgModulePartition]
-> HsName -> EHCompilePhaseT m ()
cpEhcHaskellParse
doCPP litmode
pkgKeyDirL
modNm
= do ecu <- bcall $ EcuOf modNm
if doCPP
then do -- 20150721 AD: this alternative should be done by else branch too
-- bcall $ FPathPreprocessedWithCPP pkgKeyDirL modNm
cpPreprocessWithCPP pkgKeyDirL modNm
cpParseHs litmode modNm
else do
-- (_ :: AST_HS) <- bcall $ ASTFromFile (mkPrevFileSearchKeyWithName modNm) (AlwaysEq ASTFileTimeHandleHow_AbsenceIsError) ASTType_HS (_ecuASTFileContent ecu, ASTFileUse_Src) ASTFileTiming_Current
cpParseHs litmode modNm
return ()
cpMsg modNm VerboseALot "Parsing done"
cpStopAt CompilePoint_Parse
{-# LINE 944 "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 960 "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 977 "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 994 "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 1006 "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 1017 "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 1049 "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
-}
{-
-}
(_ :: AST_Core) <- bcall $ ASTFromFile (mkPrevFileSearchKeyWithName modNm) (AlwaysEq ASTFileTimeHandleHow_Ignore) ASTType_Core (if isBinary then ASTFileContent_Binary else ASTFileContent_Text, ASTFileUse_Src) ASTFileTiming_Current
cpFoldCoreMod modNm
cpGetCoreModnameAndImports modNm
{-# LINE 1094 "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 1107 "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 1120 "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 1170 "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 1181 "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 1207 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
cpProcessHs :: EHCCompileRunner m => HsName -> EHCompilePhaseT m ()
cpProcessHs modNm = do
cpFoldHs modNm
-- bcall $ FoldHs (mkPrevFileSearchKeyWithName modNm) astpipe_EH_from_HS
cpFlowHsSem1 modNm
-- bcall $ CRSIOfName (mkPrevFileSearchKeyWithName modNm) ASTType_HS
-- bcall $ CRSIOfNameP (mkPrevFileSearchKeyWithName modNm) astpipe_EH_from_HS
cpTranslateHs2EH modNm
-- (_ :: AST_EH) <- bcall $ AST (mkPrevFileSearchKeyWithName modNm) ASTType_EH
-- (_ :: AST_EH) <- bcall $ ASTP (mkPrevFileSearchKeyWithName modNm) astpipe_EH_from_HS
cpCleanupHS modNm
return ()
{-# LINE 1226 "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)
-}
; cpFoldEH modNm
-- ; void $ bcall $ FoldEH (mkPrevFileSearchKeyWithName modNm)
; cpCleanupFoldEH modNm
; cpFlowEHSem1 modNm
; cpTranslateEH2Output modNm
{- -- %%[[(8 tycore)
; if ehcOptTyCore optsTr
then cpTranslateEH2TyCore modNm
else
-} -- %%]]
; cpTranslateEH2Core modNm
-- ; (_ :: AST_Core) <- bcall $ AST (mkPrevFileSearchKeyWithName modNm) ASTType_Core
; cpCleanupEH modNm
}
{-# LINE 1288 "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 1312 "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
; when (targetIsCoreVariation (ehcOptTarget opts)) $
cpFoldCore2CoreRun modNm
; return ()
}
{-# LINE 1339 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
cpProcessCoreModFold :: EHCCompileRunner m => HsName -> EHCompilePhaseT m ()
cpProcessCoreModFold modNm
= cpSeq $
[ cpEhcCoreAnalyseModule modNm
, cpFlowCoreModSem modNm
]
{-# LINE 1348 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
cpProcessCoreRunModFold :: EHCCompileRunner m => HsName -> EHCompilePhaseT m ()
cpProcessCoreRunModFold modNm
= cpSeq $
[ cpEhcCoreRunAnalyseModule modNm
-- , cpFlowCoreRunModSem modNm
]
{-# LINE 1357 "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 1395 "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.suffixDotlessOutputTextualCoreRun 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 [])
++ (if targetIsCoreVariation (ehcOptTarget opts)
then [void $ cpOutputSomeModule (^. ecuCoreRun) astHandler'_CoreRun ASTFileContent_Binary "" Cfg.suffixDotlessInputOutputBinaryCoreRun modNm]
else [])
)
}