egisonc.hs

module Main where
import Language.Egison.Core
import Language.Egison.Types
import Language.Egison.Parser
import Control.Monad.Error
import System.Cmd (system)
import System.Console.GetOpt
import System.FilePath (dropExtension)
import System.Environment
import System.Directory (doesFileExist, copyFile, removeFile)
import System.Exit (ExitCode (..), exitWith, exitFailure)
import System.IO
import Paths_egison

templateFile :: String
templateFile = "etc/template.hs"

main :: IO ()
main = do 
  args <- getArgs
  let (actions, nonOpts, _) = getOpt Permute options args
  let opts = foldl (flip id) defaultOptions actions
  case opts of
    Options {optShowHelp = True} -> printHelp
    Options {optShowVersion = True} -> printVersionNumber
    Options {optOutput = output, optProf = prof} ->
      if null nonOpts
        then showUsage
        else do
          let inFile = nonOpts !! 0
              outExec = case output of
                Just outFile -> outFile
                Nothing -> dropExtension inFile
          process prof inFile outExec

data Options = Options {
    optShowVersion :: Bool,
    optShowHelp :: Bool,
    optOutput :: Maybe String,
    optProf :: Bool
    }

showUsage :: IO ()
showUsage = do
  putStrLn "egisonc: no input files"
  
defaultOptions :: Options
defaultOptions = Options {
    optShowVersion = False,
    optShowHelp = False,
    optOutput = Nothing,
    optProf = False
    }

options :: [OptDescr (Options -> Options)]
options = [
  Option ['v', 'V'] ["version"]
    (NoArg (\opts -> opts {optShowVersion = True}))
    "show version number",
  Option ['h', '?'] ["help"]
    (NoArg (\opts -> opts {optShowHelp = True}))
    "show usage information",
  Option ['o'] ["output"]
    (ReqArg (\out opts -> opts {optOutput = Just out})
            "FILE")
    "output file to write",
  Option ['p'] ["prof"]
    (NoArg (\opts -> opts {optProf = True}))
    "use profiling system"
  ]

printVersionNumber :: IO ()
printVersionNumber = do
  putStrLn egisonVersion
  exitWith ExitSuccess

printHelp :: IO ()
printHelp = do
  putStrLn "Usage: egisonc [options] file"
  putStrLn ""
  putStrLn "Options:"
  putStrLn "  --help                Display this information"
  putStrLn "  --version             Display egison version information"
  putStrLn "  --output filename     Write executable to the given filename"
  putStrLn "  --prof                Make use of GHC profiling system"
  putStrLn ""
  exitWith ExitSuccess

process :: Bool -> String -> String -> IO ()
process prof inFile outExec = do
  result <- (runIOThrows $ liftM show $ createHaskellFile inFile)
  case result of
   Just errMsg -> putStrLn errMsg
   _ -> compileHaskellFile prof outExec

appendLoadExprForCoreLibraries :: [TopExpr] -> [TopExpr]
appendLoadExprForCoreLibraries topExprs = [(Load "lib/core/base.egi"),
                                           (Load "lib/core/number.egi"),
                                           (Load "lib/core/collection.egi"),
                                           (Load "lib/core/array.egi")
                                           ] ++ topExprs
   
createHaskellFile :: String -> IOThrowsError ()
createHaskellFile inFile = do
  templatePath <- liftIO $ getDataFileName templateFile
  liftIO $ copyFile templatePath "./_tmp.hs"
  egisonProgram <- liftIO $ readFile inFile
  topExprs <- liftThrows $ readTopExprList egisonProgram
  topExprs2 <- expandLoadExprs $ appendLoadExprForCoreLibraries topExprs
  liftIO $ appendFile "./_tmp.hs" "\ntopExprs :: [TopExpr]\n"
  liftIO $ appendFile "./_tmp.hs" "topExprs = "
  liftIO $ appendFile "./_tmp.hs" $ show topExprs2
  return ()

expandLoadExprs :: [TopExpr] -> IOThrowsError [TopExpr]
expandLoadExprs [] = return []
expandLoadExprs ((LoadFile filename):topExprs) = do
  result <- liftIO $ doesFileExist filename
  if result
    then do
      loadProgram <- liftIO $ readFile filename
      loadTopExprs <- liftThrows $ readTopExprList loadProgram
      rets <- expandLoadExprs topExprs
      return $ loadTopExprs ++ rets
    else throwError $ Default $ "File does not exist: " ++ filename
expandLoadExprs ((Load libname):topExprs) = do
  filename <- liftIO (getDataFileName libname)
  result <- liftIO $ doesFileExist filename
  if result
    then do
      loadProgram <- liftIO $ readFile filename
      loadTopExprs <- liftThrows $ readTopExprList loadProgram
      rets <- expandLoadExprs topExprs
      return $ loadTopExprs ++ rets
    else throwError $ Default $ "Library does not exist: " ++ libname
expandLoadExprs (topExpr:topExprs) = do
  rets <- expandLoadExprs topExprs
  return $ topExpr:rets
  
compileHaskellFile :: Bool -> String -> IO ()
compileHaskellFile prof filename = do
  let ghc = "ghc"
  if prof
    then system $ ghc ++ " -prof -auto-all -o " ++ filename ++ " _tmp.hs"
    else system $ ghc ++ " -O2 -o " ++ filename ++ " _tmp.hs"
  removeFile "./_tmp.hs"
  removeFile "./_tmp.hi"
  removeFile "./_tmp.o"
  return ()