ministg-0.3: src/Main.hs

-----------------------------------------------------------------------------
-- |
-- Module      : Main 
-- Copyright   : (c) 2009 Bernie Pope 
-- License     : BSD-style
-- Maintainer  : bjpop@csse.unimelb.edu.au
-- Stability   : experimental
-- Portability : ghc
--
-- The main module of ministg. An interpreter for the operational semantics
-- of the STG machine, as set out in the "How to make a fast curry" paper
-- by Simon Marlow and Simon Peyton Jones.
-----------------------------------------------------------------------------

module Main where

import System.Exit (exitFailure)
import Ministg.AST (Program (Program))
import Ministg.Parser (parser)
import Ministg.Lexer (lexer, Token)
import Control.Monad (when, unless)
import System.Environment (getArgs)
import System.Directory (doesDirectoryExist, createDirectory)
import Ministg.Utils (safeReadFile)
import Ministg.Arity (runArity)
import Ministg.Eval (run)
import Ministg.Pretty (prettyText)
import Ministg.Options (processOptions, Flag (..), Dumped (..), existsFlag, getTraceDir)
import Ministg.Annotate

-- | The main driver of the program.
main :: IO ()
main = do
   args <- getArgs
   (flags, file) <- processOptions args
   -- create trace directory if necessary
   when (existsFlag flags Trace) $ do
      let traceDir = getTraceDir flags
      dirExist <- doesDirectoryExist traceDir
      unless dirExist $ createDirectory traceDir 
   -- parse the file
   Program userProgram <- parseFile flags file
   -- optionally include the Prelude
   fullProgram 
      <- if existsFlag flags NoPrelude
            then return (Program userProgram)
            else do Program preludeProgram <- parseFile flags "Prelude.stg"
                    return $ Program (preludeProgram ++ userProgram)
   -- possibly annotate the program with stack markers
   let annotated = if existsFlag flags Annotate 
                      then annotate fullProgram else fullProgram 
   -- compute arities of known functions
   let arityProgram = runArity annotated 
   dump flags DumpArity (prettyText arityProgram) $
      "The program after arity analysis:\n"
   -- interpret the program
   run flags arityProgram

parseFile :: [Flag] -> FilePath -> IO Program
parseFile flags file = do
   tryContents <- safeReadFile file
   case tryContents of
      Left error -> putStrLn error >> exitFailure
      Right contents -> do
         -- parse the program
         case parser file contents of
            Left e -> (putStrLn $ "Parse error: " ++ show e) >> exitFailure
            Right program -> do 
               dump flags DumpAST (show program) $ "The AST of the program from " ++ file ++ ":\n"
               dump flags DumpParsed (prettyText program) $
                    "The parsed program from " ++ file ++ ":\n"
               return program 

dump :: [Flag] -> Dumped -> String -> String -> IO () 
dump flags dumped str msg = 
   when (existsFlag flags $ Dump dumped) $ do
      putStrLn msg 
      putStrLn str 
      putStr "\n"