module UHC.Light.Compiler.EHC.CompilePhase.Run ( cpRunCoreRun , cpRunCoreRun2 , cpRunCoreRun3 , cpRunCoreRun4 , cpRunCoreRun5 ) where import UHC.Light.Compiler.EHC.Common import UHC.Light.Compiler.EHC.CompileUnit import UHC.Light.Compiler.EHC.CompileRun import Data.Maybe import Control.Monad.State import Control.Exception import UHC.Util.Lens import qualified UHC.Util.RelMap as Rel import qualified Data.Set as Set import UHC.Light.Compiler.Base.Trace import UHC.Light.Compiler.EHC.CompilePhase.Parsers import UHC.Light.Compiler.Core.ToCoreRun import UHC.Light.Compiler.CoreRun import UHC.Light.Compiler.CoreRun.Run import UHC.Light.Compiler.CoreRun.Run.Val.RunExplStk as RE import UHC.Light.Compiler.EHC.BuildFunction.Run import UHC.Light.Compiler.EHC.CompilePhase.Output import UHC.Light.Compiler.EHC.ASTHandler import UHC.Light.Compiler.EHC.ASTHandler.Instances import qualified UHC.Light.Compiler.Config as Cfg {-# LINE 66 "src/ehc/EHC/CompilePhase/Run.chs" #-} -- | Run CoreRun. -- TBD: fix dependence on whole program linked cpRunCoreRun :: EHCCompileRunner m => HsName -> EHCompilePhaseT m () cpRunCoreRun modNm = do cr <- get let (ecu,_,opts,_) = crBaseInfo modNm cr mbCore = _ecuMbCore ecu cpMsg modNm VerboseNormal "Run Core" when (isJust mbCore) $ do let mod = cmod2CoreRun $ fromJust mbCore res <- liftIO $ catch (runCoreRun opts [] mod $ cmodRun opts mod) (\(e :: SomeException) -> hFlush stdout >> (return $ Left $ strMsg $ "cpRunCoreRun: " ++ show e)) either (\e -> cpSetLimitErrsWhen 1 "Run Core(Run) errors" [e]) (\_ -> return ()) res {-# LINE 93 "src/ehc/EHC/CompilePhase/Run.chs" #-} -- | Run CoreRun. -- 20150130: TBD: does not work yet cpRunCoreRun2 :: EHCCompileRunner m => HsName -> EHCompilePhaseT m () cpRunCoreRun2 modNm = do cr <- get let (ecu,_,opts,_) = crBaseInfo modNm cr mbCore = _ecuMbCore ecu let hasMain = ecuHasMain ecu (impModL, mainMod) <- fmap (fromJust . initlast) $ case crPartitionMainAndImported cr $ map head $ _crCompileOrder cr of (_, impl) -> do cores <- forM (impl ++ [modNm]) cpGetPrevCore return $ flip evalState emptyNm2RefMp $ do forM (zip cores [0..]) $ \(cr,modnr) -> do prevNm2Ref <- get let (m,nm2ref,_) = cmod2CoreRun' opts hasMain (Just modnr) prevNm2Ref cr put $ nm2refUnion nm2ref prevNm2Ref return m cpMsg modNm VerboseNormal "Run Core" res <- liftIO $ catch (runCoreRun opts impModL mainMod $ cmodRun opts mainMod) (\(e :: SomeException) -> hFlush stdout >> (return $ Left $ strMsg $ "cpRunCoreRun: " ++ show e)) either (\e -> cpSetLimitErrsWhen 1 "Run Core(Run) errors" [e]) (\_ -> return ()) res {-# LINE 130 "src/ehc/EHC/CompilePhase/Run.chs" #-} -- | Run CoreRun. cpRunCoreRun3 :: EHCCompileRunner m => HsName -> EHCompilePhaseT m () cpRunCoreRun3 modNm = do cr <- get let (ecu,_,opts,_) = crBaseInfo modNm cr mbCore = _ecuMbCore ecu let hasMain = ecuHasMain ecu (impModL, mainMod) <- fmap (fromJust . initlast) $ case crPartitionMainAndImported cr $ map head $ _crCompileOrder cr of (_, impl) -> do forM (impl ++ [modNm]) cpGetPrevCoreRun cpMsg modNm VerboseNormal "Run Core" res <- liftIO $ catch (runCoreRun opts impModL mainMod $ cmodRun opts mainMod) (\(e :: SomeException) -> hFlush stdout >> (return $ Left $ strMsg $ "cpRunCoreRun: " ++ show e)) either (\e -> cpSetLimitErrsWhen 1 "Run Core(Run) errors" [e]) (\_ -> return ()) res {-# LINE 160 "src/ehc/EHC/CompilePhase/Run.chs" #-} -- | Run CoreRun. Variant for new build plan/driver -- TBD: fix dependence on whole program linked, in progress as cpRunCoreRun5 cpRunCoreRun4 :: EHCCompileRunner m => BuildGlobal -> PrevFileSearchKey -> ASTBuildPlan -> EHCompilePhaseT m () cpRunCoreRun4 bglob modSearchKey@(PrevFileSearchKey {_pfsrchKey=FileSearchKey {_fsrchNm=modNm}}) astplan@(ASTBuildPlan {_astbplPipe=astpipe}) = do maybeM (bcall $ ASTPlMb bglob modSearchKey astplan) (return ()) $ \(ASTResult {_astresAST=(mod :: AST_CoreRun)}) -> do {- crsi <- bcall $ CRSIOfNamePl modSearchKey astplan let impModNmL = crsi ^. crsiCoreRunState ^. crcrsiReqdModules impModL <- forM impModNmL $ \nm -> maybeM (bcall $ ASTPMb (mkPrevFileSearchKeyWithName nm) astpipe) (do cpSetLimitErrsWhen 1 "Run Core(Run) errors" [rngLift emptyRange Err_Str $ "Cannot load CoreRun module: " ++ show nm] return $ panic "cpRunCoreRun4: not allowed to use AST result!!" ) $ \(ASTResult {_astresAST=(mod :: AST_CoreRun)}) -> return mod -} opts <- bcall $ EHCOptsOf modSearchKey cpMsg modNm VerboseNormal "Run Core (4)" res <- liftIO $ catch (runCoreRun opts [] mod $ cmodRun opts mod) (\(e :: SomeException) -> hFlush stdout >> (return $ Left $ strMsg $ "cpRunCoreRun4: " ++ show e)) either (\e -> cpSetLimitErrsWhen 1 "Run Core(Run) errors" [e]) (\_ -> return ()) res {-# LINE 192 "src/ehc/EHC/CompilePhase/Run.chs" #-} -- | Run CoreRun. Variant for new build plan/driver -- TBD: fix dependence on whole program linked cpRunCoreRun5 :: EHCCompileRunner m => BuildGlobal -> PrevFileSearchKey -> ASTBuildPlan -> EHCompilePhaseT m () cpRunCoreRun5 bglob modSearchKey@(PrevFileSearchKey {_pfsrchKey=FileSearchKey {_fsrchNm=modNm}}) astplan@(ASTBuildPlan {_astbplPipe=astpipe}) = do maybeM (bcall $ ASTPlMb bglob modSearchKey astplan) (return ()) $ \(ASTResult {_astresAST=(mod :: AST_CoreRun)}) -> do -- debug -- ecu <- bcall $ EcuOf modNm -- cpOutputSomeModule (const mod) astHandler'_CoreRun ASTFileContent_Text "-cpRunCoreRun5" Cfg.suffixDotlessOutputTextualCoreRun (ecuModNm ecu) crsi <- bcall $ CRSIOfNamePl bglob modSearchKey astplan let impModNmL = (crsi ^. crsiCoreRunState ^. crcrsiReqdModules) \\ [modNm] cpTrPP TraceOn_BldMod $ [ "cpRunCoreRun5 mod=" >|< modNm , "astplan:" >#< astplan , "imps:" >-< indent 2 (vlist impModNmL) , "crsi nm2ref mods:" >-< indent 2 (vlist $ Set.toList $ Set.map fromJust $ Set.filter isJust $ Set.map hsnQualifier $ Rel.dom $ crsi ^. crsiCoreRunState ^. crcrsiNm2RefMp) ] -- ++ [ n >#< ppCommas rs | (n,rs) <- Rel.toDomList $ crsi ^. crsiCoreRunState ^. crcrsiNm2RefMp ] impModL <- forM impModNmL $ \nm -> maybeM (bcall $ ASTPMb bglob (mkPrevFileSearchKeyWithName nm) astpipe) (do cpSetLimitErrsWhen 1 "Run Core(Run) errors" [rngLift emptyRange Err_Str $ "Cannot load CoreRun module: " ++ show nm] return $ panic "cpRunCoreRun5: not allowed to use AST result!!" ) $ \(ASTResult {_astresAST=(mod :: AST_CoreRun)}) -> return mod opts <- bcall $ EHCOptsOf modSearchKey cpMsg modNm VerboseNormal "Run Core (5)" {- res <- liftIO $ catch (runCoreRun opts impModL mod $ cmodRun opts mod) (\(e :: SomeException) -> hFlush stdout >> (return $ Left $ strMsg $ "cpRunCoreRun5: " ++ show e)) -} res <- liftIO $ runCoreRun2 opts impModL mod $ cmodRun opts mod either (\e -> cpSetLimitErrsWhen 1 "Run Core(Run) errors" [e]) (\r -> when (CoreRunOpt_PrintResult `Set.member` ehcOptCoreRunOpts opts) $ liftIO $ putStrLn $ show $ pp r ) res