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 (cModMergeByConcat) 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) = 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 169 "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 192 "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 224 "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 266 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} cpEhcCoreFullProgPostModulePhases :: EHCOpts -> [HsName] -> ([HsName],HsName) -> EHCompilePhase () 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" $ ecuMbCore $ crCU m cr {-# LINE 291 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} {-| Per module compilation of (import) ordered sequence of module, as part of a full program compilation -} {-# LINE 295 "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 306 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} {-| Find out whether a compilation is needed, and if so, can be done. -} {-# LINE 310 "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 335 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} {-| Compilation of 1 module, as part of a full program compilation -} {-# LINE 339 "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 358 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} {-| Flow of info between modules, as part of a full program compilation -} {-# LINE 362 "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 384 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} cpEhcModuleCompile1 :: Maybe EHCompileUnitState -> HsName -> EHCompilePhase HsName cpEhcModuleCompile1 targHSState modNm {-# LINE 388 "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 416 "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 487 "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 608 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} {-| EH common phases: analysis + core + grin -} {-# LINE 612 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} cpEhcCoreModuleCommonPhases :: Bool -> Bool -> Bool -> EHCOpts -> HsName -> EHCompilePhase () cpEhcCoreModuleCommonPhases isMainMod isTopMod doMkExec opts modNm = cpSeq ([ cpEhcCorePerModulePart1 modNm ] ) {-# LINE 629 "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 637 "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 656 "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 682 "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 708 "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 725 "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 764 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} cpEhcHaskellModulePostlude :: HsName -> EHCompilePhase () cpEhcHaskellModulePostlude modNm = cpSeq [ cpOutputHI "hi" modNm , cpCleanupCU modNm ] {-# LINE 774 "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 839 "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 866 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} cpEhcEhParse :: HsName -> EHCompilePhase () cpEhcEhParse modNm = cpSeq [ cpParseEH modNm , cpStopAt CompilePoint_Parse ] {-# LINE 874 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} cpEhcCoreParse :: HsName -> EHCompilePhase () cpEhcCoreParse modNm = cpSeq [ cpParseCoreWithFPath Nothing modNm , cpStopAt CompilePoint_Parse ] {-# LINE 882 "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 898 "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 914 "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 926 "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 937 "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 969 "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 987 "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 1000 "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 1044 "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 1055 "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 1081 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} cpProcessHs :: HsName -> EHCompilePhase () cpProcessHs modNm = cpSeq [ cpFoldHs modNm , cpFlowHsSem1 modNm , cpTranslateHs2EH modNm , cpCleanupHS modNm ] {-# LINE 1095 "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 1157 "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 1173 "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 1188 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} cpProcessCoreModFold :: HsName -> EHCompilePhase () cpProcessCoreModFold modNm = cpSeq $ [ cpEhcCoreAnalyseModule modNm , cpFlowCoreModSem modNm ] {-# LINE 1197 "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{-2-} modNm] else []) ++ [ cpCleanupCore [modNm] ] ) }