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 ; cpMsg modNm VerboseALot $ "cpEhcCorePerModulePart2" ; cpSeq [ when earlyMerge $ cpProcessCoreRest modNm ] } {-# LINE 1171 "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 1182 "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 1208 "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 1227 "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 1289 "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 1313 "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 1340 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} cpProcessCoreModFold :: EHCCompileRunner m => HsName -> EHCompilePhaseT m () cpProcessCoreModFold modNm = cpSeq $ [ cpEhcCoreAnalyseModule modNm , cpFlowCoreModSem modNm ] {-# LINE 1349 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} cpProcessCoreRunModFold :: EHCCompileRunner m => HsName -> EHCompilePhaseT m () cpProcessCoreRunModFold modNm = cpSeq $ [ cpEhcCoreRunAnalyseModule modNm -- , cpFlowCoreRunModSem modNm ] {-# LINE 1358 "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_DumpAST `elem` ehcOptCoreOpts opts then [void $ cpOutputCore ASTFileContent_ASTText {-[]-} "" Cfg.suffixDotlessOutputTextualCoreAST modNm] else []) ++ (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 1399 "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 []) ) }