uhc-light-1.1.9.1: src-main/EHCRun.hs

module Main
where
import UHC.Light.Compiler.EHC.Main
import UHC.Light.Compiler.EHC.Main.Utils
import UHC.Light.Compiler.Base.API
import UHC.Light.Compiler.CoreRun.API
import UHC.Util.Pretty
import UHC.Util.FPath
import System.Exit
import System.FilePath
import System.Console.GetOpt
import System.IO
import Control.Monad
import System.Environment
import Data.List
import qualified Data.ByteString.Char8 as B


{-# LINE 25 "src/ehc/EHCRun.chs" #-}
-- | Top level main. TBD: hooks & customization
main :: IO ()
main = do
    args <- getArgs
    progName <- getProgName
    let opts0         = defaultEHCOpts
                          {ehcProgName = mkFPath progName}
        oo@(o,n,errs) = ehcrunCmdLineOptsApply args opts0
        opts          = maybe opts0 id o
        exts          = [ "bcrr", "tcrr", "bcr", "tcr" ]

    case ehcOptImmQuit opts of
      Just immq     -> handleImmQuitOption ehcrunCmdLineOpts exts immq opts
      _             -> case (n,errs) of
        ([fname], []) -> do
          let (bname,ext) = splitExtension fname
          case ext of
            e | e `elem` map ('.':) exts
                   -> mainEHC $ opts
                        { ehcOptMbTarget = JustOk Target_None_Core_AsIs
                        , ehcOptCoreOpts = {- CoreOpt_RunTrace : -} CoreOpt_Run : CoreOpt_LoadOnly : ehcOptCoreOpts opts
                        -- required only for original compiler driver
                        -- , ehcOptOptimizationScope = OptimizationScope_WholeCore
                        , ehcOptVerbosity = VerboseQuiet
                        , ehcOptAltDriver = not $ ehcOptAltDriver opts
                        }
            _      -> handleImmQuitOption ehcrunCmdLineOpts exts ImmediateQuitOption_Help opts
        (_      , es) -> do
          putStr (head errs)
          exitFailure

  where runRCR opts fname = do
            inp <- B.readFile fname
            case parseModFromString $ B.unpack inp of
              Left  es  -> forM_ es putStrLn
              Right mod -> do
                res <- runCoreRunIO opts mod
                case res of
                  Left  e   -> putStrLn $ show $ pp e
                  Right val -> putStrLn $ show $ pp val