uhc-light-1.1.7.2: 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 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.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 (cModMerge)
import qualified UHC.Light.Compiler.Core.Merge as CMerge (cModMerge)
import qualified UHC.Light.Compiler.Core.Check as Core2ChkSem
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 112 "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 :: [HsName] -> EHCompilePhase ()
cpEhcFullProgLinkAllModules modNmL
= do { cr <- get
; let (mainModNmL,impModNmL) = splitMain 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 ()
}
where splitMain cr = partition (\n -> ecuHasMain $ crCU n cr)
{-# LINE 170 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
cpEhcCheckAbsenceOfMutRecModules :: EHCompilePhase ()
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 193 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
cpEhcFullProgCompileAllModules :: EHCompilePhase ()
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 225 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
cpEhcFullProgPostModulePhases :: EHCOpts -> [HsName] -> ([HsName],HsName) -> EHCompilePhase ()
cpEhcFullProgPostModulePhases opts modNmL modSpl
| ehcOptOptimizationScope opts >= OptimizationScope_WholeCore = cpEhcCoreFullProgPostModulePhases opts modNmL modSpl
| otherwise = return ()
{-# LINE 267 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
cpEhcCoreFullProgPostModulePhases :: EHCOpts -> [HsName] -> ([HsName],HsName) -> EHCompilePhase ()
cpEhcCoreFullProgPostModulePhases opts modNmL (impModNmL,mainModNm)
= cpSeq ([ cpSeq [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" $ ecuMbCore $ crCU m cr
{-# LINE 292 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
{-|
Per module compilation of (import) ordered sequence of module, as part of a full program compilation
-}
{-# LINE 296 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
cpEhcFullProgModuleCompileN :: [HsName] -> EHCompilePhase ()
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 307 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
{-|
Find out whether a compilation is needed, and if so, can be done.
-}
{-# LINE 311 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
cpEhcFullProgModuleDetermineNeedsCompile :: HsName -> EHCompilePhase ()
cpEhcFullProgModuleDetermineNeedsCompile modNm
= do { cr <- get
; let (ecu,_,opts,_) = crBaseInfo modNm cr
needsCompile = crModNeedsCompile modNm cr
canCompile = crModCanCompile modNm cr
; when (ehcOptVerbosity opts >= VerboseDebug)
(lift $ 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 336 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
{-|
Compilation of 1 module, as part of a full program compilation
-}
{-# LINE 340 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
cpEhcFullProgModuleCompile1 :: HsName -> EHCompilePhase ()
cpEhcFullProgModuleCompile1 modNm
= do { cr <- get
; let (_,opts) = crBaseInfo' cr -- '
; when (ehcOptVerbosity opts >= VerboseALot)
(lift $ 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 359 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
{-|
Flow of info between modules, as part of a full program compilation
-}
{-# LINE 363 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
cpEhcFullProgBetweenModuleFlow :: HsName -> EHCompilePhase ()
cpEhcFullProgBetweenModuleFlow modNm
= do { cr <- get
; case ecuState $ crCU modNm cr of
ECUS_Haskell HSAllSem -> return ()
ECUS_Haskell HIAllSem -> cpFlowHISem modNm
_ -> return ()
; cpCleanupFlow modNm
}
{-# LINE 385 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
cpEhcModuleCompile1 :: Maybe EHCompileUnitState -> HsName -> EHCompilePhase HsName
cpEhcModuleCompile1 targHSState modNm
{-# LINE 389 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
= do { cr <- get
; let (ecu,_,opts,fp) = crBaseInfo modNm cr
defaultResult = modNm
; when (ehcOptVerbosity opts >= VerboseALot)
(lift $ putStrLn ("====================== Module: " ++ show modNm ++ " ======================"))
; when (ehcOptVerbosity opts >= VerboseDebug)
(lift $ putStrLn ("State: in: " ++ show (ecuState ecu) ++ ", to: " ++ show targHSState))
; case (ecuState ecu,targHSState) of
{-# LINE 417 "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
; lift $ 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
; lift $ 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 488 "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") ++ ")"
-- 20140605 AD, code below is temporary, to cater for minimal and working infrastructure first...
-- ; cpGetDummyCheckSrcMod modNm -- really dummy, should be based on actual import info to be extracted by cpEhcCoreImport
; cpEhcHaskellModulePrepareSrc modNm
; modNm2 <- cpEhcCoreImport isBinary modNm
-- ; cpGetDummyCheckSrcMod modNm2 -- really dummy, should be based on actual import info to be extracted by cpEhcCoreImport
-- ; cpCheckModsWithBuiltin [modNm2]
; 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"
-- 20140605 AD, code below is temporary, to cater for minimal and working infrastructure first...
; cpEhcCoreModuleAfterImport (ecuIsTopMod ecu) opts modNm
{-
; cpProcessCoreModFold modNm
; cpEhcCoreModuleCommonPhases True True True {- isMainMod isTopMod doMkExec -} 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 609 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
{-|
EH common phases: analysis + core + grin
-}
{-# LINE 613 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
cpEhcCoreModuleCommonPhases :: Bool -> Bool -> Bool -> EHCOpts -> HsName -> EHCompilePhase ()
cpEhcCoreModuleCommonPhases isMainMod isTopMod doMkExec opts modNm
= cpSeq ([
cpEhcCorePerModulePart1 modNm
]
)
{-# LINE 630 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
cpEhcEhModuleCommonPhases :: Bool -> Bool -> Bool -> EHCOpts -> HsName -> EHCompilePhase ()
cpEhcEhModuleCommonPhases isMainMod isTopMod doMkExec opts modNm
= cpSeq [ cpEhcEhAnalyseModuleDefs modNm
, cpEhcCoreModuleCommonPhases isMainMod isTopMod doMkExec opts modNm
]
{-# LINE 638 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
-- | Common phases when starting with a Haskell module.
-- HS common phases: HS analysis + EH common
cpEhcHaskellModuleCommonPhases :: Bool -> Bool -> EHCOpts -> HsName -> EHCompilePhase ()
cpEhcHaskellModuleCommonPhases isTopMod doMkExec opts modNm
= cpSeq [ cpEhcHaskellAnalyseModuleDefs modNm
, do { cr <- get
; let (ecu,_,_,_) = crBaseInfo modNm cr
; cpEhcEhModuleCommonPhases
(ecuIsMainMod ecu)
isTopMod doMkExec opts modNm
}
]
{-# LINE 657 "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
:: Bool -> EHCOpts -> HSState
-> [PkgModulePartition]
-> HsName -> EHCompilePhase ()
cpEhcHaskellModuleAfterImport
isTopMod opts hsst
pkgKeyDirL
modNm
= cpSeq [ cpEhcHaskellParse False (hsstateIsLiteral hsst)
pkgKeyDirL
modNm
, cpEhcHaskellAnalyseModuleItf modNm
, cpEhcHaskellModuleCommonPhases isTopMod False opts modNm
, cpEhcHaskellModulePostlude modNm
]
{-# LINE 683 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
-- | All the work to be done after Core src/binary imports have been read/analysed
cpEhcCoreModuleAfterImport
:: Bool -> EHCOpts
-> HsName -> EHCompilePhase ()
cpEhcCoreModuleAfterImport
isTopMod opts
modNm
= do { cr <- get
; let (ecu,_,_,_) = crBaseInfo modNm cr
; cpSeq
[ cpEhcCoreAnalyseModuleItf modNm
, cpProcessCoreModFold modNm
, cpEhcCoreModuleCommonPhases (ecuIsMainMod ecu) isTopMod False opts modNm
{-
, cpEhcHaskellModuleCommonPhases isTopMod False opts modNm
, cpEhcHaskellModulePostlude modNm
-}
]
}
{-# LINE 709 "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 726 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
cpEhcHaskellModulePrepareSrc :: HsName -> EHCompilePhase ()
cpEhcHaskellModulePrepareSrc modNm
= cpGetMetaInfo [GetMeta_Src,GetMeta_Dir] modNm
cpEhcHaskellModulePrepareHS2 :: HsName -> EHCompilePhase ()
cpEhcHaskellModulePrepareHS2 modNm
= cpSeq [ cpGetMetaInfo
[ GetMeta_Src, GetMeta_HI, GetMeta_Core
, GetMeta_Dir
] modNm
, cpGetPrevHI modNm
-- , cpFoldHI modNm
, cpFoldHIInfo modNm
]
cpEhcHaskellModulePrepareHI :: HsName -> EHCompilePhase ()
cpEhcHaskellModulePrepareHI modNm
= cpSeq [ cpGetMetaInfo
[ GetMeta_HI, GetMeta_Core
] modNm
, cpGetPrevHI modNm
-- , cpFoldHI modNm
, cpFoldHIInfo modNm
]
cpEhcHaskellModulePrepare :: HsName -> EHCompilePhase ()
cpEhcHaskellModulePrepare modNm
= cpSeq [ cpEhcHaskellModulePrepareSrc modNm
, cpEhcHaskellModulePrepareHS2 modNm
]
{-# LINE 765 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
cpEhcHaskellModulePostlude :: HsName -> EHCompilePhase ()
cpEhcHaskellModulePostlude modNm
= cpSeq [ cpOutputHI "hi" modNm
, cpCleanupCU modNm
]
{-# LINE 775 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
-- | Get import information from Haskell module source text.
cpEhcHaskellImport
:: HSState
-> [PkgModulePartition]
-> HsName -> EHCompilePhase 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 840 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
-- | Parse a Haskell module
cpEhcHaskellParse
:: Bool -> Bool
-> [PkgModulePartition]
-> HsName -> EHCompilePhase ()
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 867 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
cpEhcEhParse :: HsName -> EHCompilePhase ()
cpEhcEhParse modNm
= cpSeq [ cpParseEH modNm
, cpStopAt CompilePoint_Parse
]
{-# LINE 875 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
cpEhcCoreParse :: HsName -> EHCompilePhase ()
cpEhcCoreParse modNm
= cpSeq [ cpParseCoreWithFPath Nothing modNm
, cpStopAt CompilePoint_Parse
]
{-# LINE 883 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
-- | Analyse a Haskell src module for
-- (1) module information (import, export, etc),
cpEhcHaskellAnalyseModuleItf :: HsName -> EHCompilePhase ()
cpEhcHaskellAnalyseModuleItf modNm
= cpSeq [ cpStepUID, cpFoldHsMod modNm, cpGetHsMod modNm
, cpCheckModsWithBuiltin [modNm]
, cpCleanupHSMod modNm
]
{-# LINE 899 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
-- | Analyse a Core text/binary src module for
-- (1) module information (import, export, etc),
cpEhcCoreAnalyseModuleItf :: HsName -> EHCompilePhase ()
cpEhcCoreAnalyseModuleItf modNm
= cpSeq [ cpMsg modNm VerboseDebug "cpEhcCoreAnalyseModuleItf"
, cpCheckModsWithoutBuiltin [modNm]
-- , cpCleanupHSMod modNm
]
{-# LINE 915 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
-- | Analyse a Haskell src module for
-- (2) names + dependencies
cpEhcHaskellAnalyseModuleDefs :: HsName -> EHCompilePhase ()
cpEhcHaskellAnalyseModuleDefs modNm
= cpSeq [ cpStepUID
, cpProcessHs modNm
, cpMsg modNm VerboseALot "Name+dependency analysis done"
, cpStopAt CompilePoint_AnalHS
]
{-# LINE 927 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
-- | Analyse a Haskell src module for
-- (3) types
cpEhcEhAnalyseModuleDefs :: HsName -> EHCompilePhase ()
cpEhcEhAnalyseModuleDefs modNm
= cpSeq [ cpStepUID, cpProcessEH modNm
, cpMsg modNm VerboseALot "Type analysis done"
, cpStopAt CompilePoint_AnalEH
]
{-# LINE 938 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
-- | Part 1 Core processing, on a per module basis, part1 is done always
cpEhcCorePerModulePart1 :: HsName -> EHCompilePhase ()
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 970 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
-- | Get import information from Core module source text.
cpEhcCoreImport
:: Bool -> HsName -> EHCompilePhase HsName
cpEhcCoreImport
isBinary modNm
= do { cr <- get
; let (_,opts) = crBaseInfo' cr
; if isBinary
then -- cpDecodeCore (Just Cfg.suffixDotlessInputOutputBinaryCore) modNm
cpDecodeCore Nothing modNm
else cpParseCoreWithFPath Nothing modNm
; cpFoldCoreMod modNm
; cpGetCoreModnameAndImports modNm
}
{-# LINE 988 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
-- | Analyse a Core src module
cpEhcCoreAnalyseModule :: HsName -> EHCompilePhase ()
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 1001 "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 :: HsName -> EHCompilePhase ()
cpEhcCorePerModulePart2 modNm
= do { cr <- get
; let (_,_,opts,_) = crBaseInfo modNm cr
earlyMerge = ehcOptOptimizationScope opts >= OptimizationScope_WholeCore
; cpSeq [ when earlyMerge $ cpProcessCoreRest modNm
]
}
{-# LINE 1045 "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 :: HsName -> EHCompilePhase ()
cpEhcCoreGrinPerModuleDoneFullProgAnalysis modNm
= cpSeq ( [ cpEhcCorePerModulePart2 modNm
, cpEhcExecutablePerModule FinalCompile_Exec [] modNm
, cpMsg modNm VerboseALot "Full Program Analysis (Core+Grin) done"
]
)
{-# LINE 1056 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
-- | Make final executable code, either still partly or fully (i.e. also linking)
cpEhcExecutablePerModule :: FinalCompileHow -> [HsName] -> HsName -> EHCompilePhase ()
cpEhcExecutablePerModule how impModNmL modNm
= do { cr <- get
; let (_,_,opts,_) = crBaseInfo modNm cr
; cpSeq $
[ cpCompileWithGCC how impModNmL modNm ]
}
{-# LINE 1082 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
cpProcessHs :: HsName -> EHCompilePhase ()
cpProcessHs modNm
= cpSeq [ cpFoldHs modNm
, cpFlowHsSem1 modNm
, cpTranslateHs2EH modNm
, cpCleanupHS modNm
]
{-# LINE 1096 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
cpProcessEH :: HsName -> EHCompilePhase ()
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 1158 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
-- unprocessed core -> folded core
cpProcessCoreBasic :: HsName -> EHCompilePhase ()
cpProcessCoreBasic modNm
= do { cr <- get
; let (_,_,opts,_) = crBaseInfo modNm cr
; cpSeq [ cpTransformCore OptimizationScope_PerModule modNm
, cpFlowHILamMp modNm
, void $ cpOutputCore CPOutputCoreHow_Binary [] "" Cfg.suffixDotlessBinaryCore modNm
, cpProcessCoreFold modNm
]
}
{-# LINE 1174 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
-- unfolded core -> folded core
-- (called on merged core, and on core directly generated from cached grin)
cpProcessCoreFold :: HsName -> EHCompilePhase ()
cpProcessCoreFold modNm
= cpSeq $
[ cpFlowCoreSemBeforeFold modNm ] ++
[ cpFoldCore2Grin modNm ]
++ [ cpFlowCoreSemAfterFold modNm ]
{-# LINE 1189 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
cpProcessCoreModFold :: HsName -> EHCompilePhase ()
cpProcessCoreModFold modNm
= cpSeq $
[ cpEhcCoreAnalyseModule modNm
, cpFlowCoreModSem modNm
]
{-# LINE 1198 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-}
-- folded core -> grin, jazy, and the rest
cpProcessCoreRest :: HsName -> EHCompilePhase ()
cpProcessCoreRest modNm
= do { cr <- get
; let (_,_,opts,_) = crBaseInfo modNm cr
; cpSeq ( []
++ (if CoreOpt_Dump `elem` ehcOptCoreOpts opts
then [void $ cpOutputCore CPOutputCoreHow_Text [] "" Cfg.suffixDotlessOutputTextualCore modNm]
else [])
++ (if CoreOpt_DumpBinary `elem` ehcOptCoreOpts opts
then [void $ cpOutputCore CPOutputCoreHow_Binary [] "" Cfg.suffixDotlessInputOutputBinaryCore modNm]
else [])
++ (if CoreOpt_RunDump `elem` ehcOptCoreOpts opts
then [void $ cpOutputCore CPOutputCoreHow_Run [] "" Cfg.suffixDotlessInputOutputCoreRun modNm]
else [])
++ (if CoreOpt_Run `elem` ehcOptCoreOpts opts -- TBD: only when right backend? For now, just do it
then [cpRunCoreRun modNm]
else [])
++ [ cpCleanupCore [modNm] ]
)
}