Run.hs

module UHC.Light.Compiler.EHC.CompilePhase.Run
( cpRunCoreRun
, cpRunCoreRun2
, cpRunCoreRun3 )
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.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

{-# LINE 45 "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 72 "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 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 109 "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