module UHC.Light.Compiler.EHC.Main.Compile
( compileN_Alternate
, compileN
, import1 )
where
import System.Console.GetOpt
import System.IO
import System.Exit
import System.Process
import System.Environment
import qualified Control.Exception as CE
import qualified UHC.Light.Compiler.Config as Cfg
import UHC.Light.Compiler.EHC.Common
import UHC.Light.Compiler.EHC.Environment
import UHC.Light.Compiler.EHC.CompileUnit
import UHC.Light.Compiler.EHC.CompileRun
import UHC.Light.Compiler.EHC.InitialSetup
import UHC.Light.Compiler.EHC.CompilePhase.TopLevelPhases
import UHC.Light.Compiler.EHC.BuildFunction.Run
import qualified Debug.Trace
import qualified Data.Map as Map
import qualified Data.Set as Set
import Control.Monad.State
import Control.Monad.Error
import UHC.Light.Compiler.Base.Target
import UHC.Light.Compiler.Base.Optimize (allOptimizeMp)
import UHC.Light.Compiler.EHC.Main.Utils
import qualified UHC.Light.Compiler.SourceCodeSig as Sig
import UHC.Light.Compiler.EHC.CompilePhase.Module
import UHC.Light.Compiler.Module.ImportExport (modBuiltin)
import UHC.Light.Compiler.Module.ImportExport
import System.Directory
import UHC.Light.Compiler.Base.PackageDatabase
import UHC.Light.Compiler.Base.Parser2
import qualified UHC.Light.Compiler.ConfigCabal as Cfg (getDataDir)
compileN_Alternate :: EHCCompileRunner m => [FPath] -> [HsName] -> EHCompilePhaseT m ()
compileN_Alternate fpL topModNmL@(modNm:_) = do
cpMsg modNm VerboseDebug $ "compileN_Alternate topModNmL: " ++ show topModNmL
zipWithM (\fp topModNm -> bcall $ EcuOfNameAndPath Nothing (topModNm, Just fp)) fpL topModNmL
return ()
compileN :: EHCCompileRunner m => EHCOpts -> FileSuffMp -> FileLocPath -> [FPath] -> [HsName] -> EHCompilePhaseT m ()
compileN opts fileSuffMpHs searchPath fpL topModNmL@(modNm:_)
= do { cpMsg modNm VerboseDebug $ "compileN topModNmL: " ++ show topModNmL
; cpCheckModsModWith (const emptyModMpInfo) [modBuiltin]
; topModNmL' <- zipWithM (\fp topModNm -> imp (ECUS_Haskell HSOnlyImports) (Just fp) Nothing topModNm) fpL topModNmL
; cpImportGatherFromModsWithImp
(if ehcOptPriv opts
then \ecu -> case ecuState ecu of
ECUS_Haskell HIOnlyImports -> []
_ -> ecuImpNmL ecu
else ecuImpNmL
)
(imp (ECUS_Haskell HSOnlyImports) Nothing) (map fst topModNmL')
; when (ehcOptPriv opts)
(do {
importAlso (ECUS_Haskell HSOnlyImports) ecuTransClosedOrphanModS
; importAlso (ECUS_Haskell HMOnlyMinimal) (Set.unions . Map.elems . ecuTransClosedUsedModMp)
})
; cpEhcCheckAbsenceOfMutRecModules
; cpEhcFullProgCompileAllModules
; unless (ehcOptKeepIntermediateFiles opts) cpRmFilesToRm
}
where
imp = import1 opts fileSuffMpHs searchPath
importAlso how getNms
= do { cr <- get
; let allAnalysedModS = Map.keysSet $ _crCUCache cr
allNewS = Set.unions [ getNms $ crCU m cr | m <- Set.toList allAnalysedModS ] `Set.difference` allAnalysedModS
; cpImportGatherFromModsWithImp
(const [])
(imp how Nothing) (Set.toList allNewS)
}
import1
:: EHCCompileRunner m
=> EHCOpts
-> FileSuffMp
-> FileLocPath
-> EHCompileUnitState
-> Maybe FPath
-> Maybe PrevSearchInfo
-> HsName
-> EHCompilePhaseT m (HsName,Maybe PrevSearchInfo)
import1 opts fileSuffMpHs searchPath desiredState mbFp mbPrev nm
= do { let isTopModule = isJust mbFp
fileSuffMpHs' = map tup123to12 $ (if isTopModule then fileSuffMpHsNoSuff else []) ++ fileSuffMpHs
; let searchPath' = prevSearchInfoAdaptedSearchPath mbPrev searchPath
; fpsFound <- cpFindFilesForFPathInLocations (fileLocSearch opts) (\(x,_,_) -> x) False fileSuffMpHs' searchPath' (Just nm) mbFp
; when (ehcOptVerbosity opts >= VerboseDebug)
(do { liftIO $ putStrLn $ show nm ++ ": " ++ show (fmap fpathToStr mbFp) ++ ": " ++ show (map fpathToStr fpsFound)
; liftIO $ putStrLn $ "searchPath: " ++ show searchPath'
})
; when isTopModule
(cpUpdCU nm (ecuSetIsTopMod True))
; cpUpdCU nm (ecuSetTarget (ehcOptTarget opts))
; case fpsFound of
(fp:_)
-> do { nm' <- cpEhcModuleCompile1 (Just desiredState) nm
; cr <- get
; let (ecu,_,_,_) = crBaseInfo nm' cr
; return (nm',Just (nm',(fp, ecuFileLocation ecu)))
}
_ -> return (nm,Nothing)
}