Run.hs

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