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 UHC.Light.Compiler.EHC.Common import UHC.Light.Compiler.EHC.Environment import UHC.Util.Lens 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 UHC.Util.Error import UHC.Light.Compiler.EHC.CompilePhase.Run import UHC.Light.Compiler.Base.Target import UHC.Light.Compiler.Base.Optimize (allOptimizeMp) import UHC.Light.Compiler.EHC.Main.Utils import UHC.Light.Compiler.Base.Trace 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 {-# LINE 96 "src/ehc/EHC/Main/Compile.chs" #-} -- | Alternate compiler driver using (20150806 under construction) new build system compileN_Alternate :: EHCCompileRunner m => [FPath] -> [HsName] -> EHCompilePhaseT m () compileN_Alternate fpL topModNmL@(modNm:_) = do cpMsg modNm VerboseDebug $ "compileN_Alternate topModNmL: " ++ show topModNmL crsi <- bcall $ CRSI let opts = crsi ^. crsiOpts astpipe = astpipeForEHCOpts opts bglob = BuildGlobal astpipe case (ehcOptTarget opts, fpL, topModNmL) of {- (Target_None_Core_AsIs, (fp:_), (modNm:_)) | CoreOpt_Run `elem` ehcOptCoreOpts opts -> do (_ :: AST_Core) <- bcall $ ASTP ((modNm, ASTFileNameOverride_FPathAsTop fp), Nothing) astpipe -- cr <- get -- cpTr TraceOn_BldResult ["compileN_Alternate", show $ Map.keys $ cr ^. crCUCache, show $ cr ^. crNmForward] (bcall $ ActualModNm modNm) >>= cpRunCoreRun -} (Target_None_Core_AsIs, (fp:_), (modNm:_)) | CoreOpt_Run `elem` ehcOptCoreOpts opts -> do let modSearchKey = PrevFileSearchKey (FileSearchKey modNm $ ASTFileNameOverride_FPathAsTop fp) Nothing maybeM (bcall $ BuildPlanPMb bglob modSearchKey astpipe) (return ()) $ \astplan -> do -- cpRunCoreRun4 bglob modSearchKey astplan cpRunCoreRun5 bglob modSearchKey astplan (_, fpL, topModNmL) -> do zipWithM (\fp topModNm -> bcall $ EcuOfPrevNameAndPath (PrevFileSearchKey (FileSearchKey topModNm $ ASTFileNameOverride_FPathAsTop fp) Nothing)) fpL topModNmL return () {-# LINE 125 "src/ehc/EHC/Main/Compile.chs" #-} 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 -- check module import relationship for builtin module ; cpCheckModsModWith (const emptyModMpInfo) [modBuiltin] -- start with directly importing top modules, providing the filepath directly ; topModNmL' <- zipWithM (\fp topModNm -> imp (ECUS_Haskell HSOnlyImports) (Just fp) Nothing topModNm) fpL topModNmL -- follow the import relation to chase modules which have to be analysed ; cpImportGatherFromModsWithImp ({- if ehcOptPriv opts then \ecu -> case ecuState ecu of -- ECUS_Haskell HIStart -> Set.toList $ ecuTransClosedOrphanModS ecu ECUS_Haskell HIOnlyImports -> [] -- Set.toList $ ecuTransClosedOrphanModS ecu _ -> ecuImpNmL ecu else -} ecuImpNmL ) (imp (ECUS_Haskell HSOnlyImports) Nothing) (map fst topModNmL') -- import orphans {- ; when (ehcOptPriv opts) (do { -- import orphans importAlso (ECUS_Haskell HSOnlyImports) ecuTransClosedOrphanModS -- import used remaining modules, but just minimally ; importAlso (ECUS_Haskell HMOnlyMinimal) (Set.unions . Map.elems . ecuTransClosedUsedModMp) }) -} -- inhibit mutual recursiveness ; cpEhcCheckAbsenceOfMutRecModules -- and compile it all ; cpEhcFullProgCompileAllModules -- cleanup ; unless (ehcOptKeepIntermediateFiles opts) cpRmFilesToRm } where -- abbrev for import1 imp = import1 opts fileSuffMpHs searchPath -- import others, but then in a (slightly) different way {- 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) } -} {-# LINE 187 "src/ehc/EHC/Main/Compile.chs" #-} 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) tup1234to1 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 newPrev = Just (nm',(fp, ecuFileLocation ecu)) ; cpUpdCU nm' $ ecuMbPrevSearchInfo ^= newPrev ; return (nm', newPrev) } _ -> return (nm,Nothing) }