From 738525cc17531b6cb1bc41529ec6cead7619dfee Mon Sep 17 00:00:00 2001
From: eb <eb@cs.st-and.ac.uk>
Date: Thu, 17 Dec 2009 12:24:52 +0000
Subject: [PATCH] Moved Main.lhs

Ignore-this: 6bd53353340074fe26df80716b5989a7

darcs-hash:20091217122452-6ac22-47e0d89be4f0105341b9752efa084b3021637322.gz
---
 Epic/Scopecheck.lhs |   3 +-
 Main.lhs            | 118 ++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 119 insertions(+), 2 deletions(-)
 create mode 100644 Main.lhs

diff --git a/Epic/Scopecheck.lhs b/Epic/Scopecheck.lhs
index 5088d34..6cf9655 100644
--- a/Epic/Scopecheck.lhs
+++ b/Epic/Scopecheck.lhs
@@ -45,8 +45,7 @@ declarations will *not* have been scopechecked.
 >    tc env (R n) = case lookup n env of
 >                      Nothing -> case lookup n ctxt of
 >                         Nothing -> return $ Const (MkInt 1234567890)
-> -- lift $ fail $ 
->    --                                  "Unknown name " ++ showuser n
+>                                    -- lift $ fail $ "Unknown name " ++ showuser n
 >                         (Just _) -> return $ R n
 >                      (Just i) -> return $ V i
 >    tc env (Let n ty v sc) = do
diff --git a/Main.lhs b/Main.lhs
new file mode 100644
index 0000000..900737c
--- /dev/null
+++ b/Main.lhs
@@ -0,0 +1,118 @@
+> module Main where
+
+> import System
+> import System.Directory
+> import System.Environment
+> import System.IO
+> import Monad
+
+> import Epic.Compiler
+
+> main = do args <- getArgs
+>           (fns, opts) <- getInput args
+>           outfile <- getOutput opts
+>           ofiles <- compileFiles fns (mkOpts opts)
+>           copts <- getCOpts opts
+>           extras <- getExtra opts
+>           if ((length ofiles) > 0 && (not (elem Obj opts)))
+>              then link (ofiles ++ copts) extras outfile (not (elem ExtMain opts))
+>              else return ()
+>   where mkOpts (KeepInt:xs) = KeepC:(mkOpts xs)
+>         mkOpts (TraceOn:xs) = Trace:(mkOpts xs)
+>         mkOpts (Header f:xs) = MakeHeader f:(mkOpts xs)
+>         mkOpts (_:xs) = mkOpts xs
+>         mkOpts [] = []
+
+> compileFiles [] _ = return []
+> compileFiles (fn:xs) opts
+>     | isDotE fn = do
+>        let ofile = getRoot fn ++ ".o"
+>        compileOpts fn ofile (Just (getRoot fn ++ ".ei")) opts
+>        rest <- compileFiles xs opts
+>        return (ofile:rest)
+>     | isDotO fn = do
+>        rest <- compileFiles xs opts
+>        return (fn:rest)
+>     | otherwise = do -- probably autogenerated, just build it.
+>        let ofile = fn ++ ".o"
+>        compileOpts fn ofile Nothing opts
+>        rest <- compileFiles xs opts
+>        return (ofile:rest)
+
+> isDotE ('.':'e':[]) = True
+> isDotE (_:xs) = isDotE xs
+> isDotE [] = False
+
+> isDotC ('.':'c':[]) = True
+> isDotC (_:xs) = isDotC xs
+> isDotC [] = False
+
+> isDotO ('.':'o':[]) = True
+> isDotO (_:xs) = isDotO xs
+> isDotO [] = False
+
+> mkExecname fn = case span (/='.') fn of
+>     (stem,".e") -> stem
+>     (stem,_) -> fn ++ ".exe"
+
+> getRoot fn = case span (/='.') fn of
+>     (stem,_) -> stem
+
+> getInput :: [String] -> IO ([FilePath],[Option])
+> getInput args = do let opts = parseArgs args
+>                    fns <- getFile opts
+>                    if (length fns == 0) 
+>                       then do showUsage
+>                               return (fns,opts)
+>                       else return (fns,opts)
+
+> showUsage = do putStrLn "Epigram Supercombinator Compiler version 0.1"
+>                putStrLn "Usage:\n\tepic <input file> [options]"
+>                exitWith (ExitFailure 1)
+
+> data Option = KeepInt -- Don't delete intermediate file
+>             | TraceOn -- Trace while running (debug option)
+>             | Obj -- Just make the .o, don't link
+>             | File String -- File to send the compiler
+>             | Output String -- Output filename
+>             | Header String -- Header output filename
+>             | ExtraInc String -- extra files to inlude
+>             | COpt String -- option to send straight to gcc
+>             | ExtMain -- external main (i.e. in a .o)
+>   deriving Eq
+
+> parseArgs :: [String] -> [Option]
+> parseArgs [] = []
+> parseArgs ("-keepc":args) = KeepInt:(parseArgs args)
+> parseArgs ("-trace":args) = TraceOn:(parseArgs args)
+> parseArgs ("-c":args) = Obj:(parseArgs args)
+> parseArgs ("-extmain":args) = ExtMain:(parseArgs args)
+> parseArgs ("-o":name:args) = (Output name):(parseArgs args)
+> parseArgs ("-h":name:args) = (Header name):(parseArgs args)
+> parseArgs ("-i":inc:args) = (ExtraInc inc):(parseArgs args)
+> parseArgs (('$':x):args) = (COpt (x ++ concat (map (" "++) args))):[]
+> parseArgs (('-':x):args) = (COpt x):(parseArgs args)
+> parseArgs (x:args) = (File x):(parseArgs args)
+
+> getFile :: [Option] -> IO [FilePath]
+> getFile ((File x):xs) = do fns <- getFile xs
+>                            return (x:fns)
+> getFile (_:xs) = getFile xs
+> getFile [] = return []
+
+> getOutput :: [Option] -> IO FilePath
+> getOutput ((Output fn):xs) = return fn
+> getOutput (_:xs) = getOutput xs
+> getOutput [] = return "a.out"
+
+> getCOpts :: [Option] -> IO [String]
+> getCOpts ((COpt x):xs) = do fns <- getCOpts xs
+>                             return (x:fns)
+> getCOpts (_:xs) = getCOpts xs
+> getCOpts [] = return []
+
+> getExtra :: [Option] -> IO [String]
+> getExtra ((ExtraInc x):xs) = do fns <- getExtra xs
+>                                 return (x:fns)
+> getExtra (_:xs) = getExtra xs
+> getExtra [] = return []