From dd991a558759ee4c7147e058fabfdaa4038d3f5b Mon Sep 17 00:00:00 2001
From: Adam Sampson <ats@offog.org>
Date: Wed, 25 Apr 2007 16:07:12 +0000
Subject: [PATCH] Nicer option parsing, and a -o option to write output to a
 file

---
 fco2/Main.hs       | 38 ++++++++++++++++++++++++++------------
 fco2/Makefile      |  2 +-
 fco2/ParseState.hs | 13 +++++++------
 fco2/Pass.hs       | 20 ++++++++++++--------
 fco2/TODO          |  7 ++-----
 5 files changed, 48 insertions(+), 32 deletions(-)

diff --git a/fco2/Main.hs b/fco2/Main.hs
index 2f134ad..3b8cc3d 100644
--- a/fco2/Main.hs
+++ b/fco2/Main.hs
@@ -22,14 +22,26 @@ passes =
   , ("Flatten nested declarations", unnest)
   ]
 
-options :: [OptDescr Flag]
+type OptFunc = ParseState -> IO ParseState
+
+options :: [OptDescr OptFunc]
 options =
-  [ Option [] ["parse-only"] (NoArg ParseOnly) "only parse input file"
-  , Option ['v'] ["verbose"] (NoArg Verbose) "show progress information"
-  , Option [] ["debug"] (NoArg Debug) "show detailed information for debugging"
+  [ Option [] ["parse-only"] (NoArg optParseOnly) "only parse input file"
+  , Option ['v'] ["verbose"] (NoArg $ optVerboseLevel 1) "show progress information"
+  , Option [] ["debug"] (NoArg $ optVerboseLevel 2) "show detailed information for debugging"
+  , Option ['o'] ["output"] (ReqArg optOutput "FILE") "output file (default \"-\")"
   ]
 
-getOpts :: [String] -> IO ([Flag], [String])
+optParseOnly :: OptFunc
+optParseOnly ps = return $ ps { psParseOnly = True }
+
+optVerboseLevel :: Int -> OptFunc
+optVerboseLevel n ps = return $ ps { psVerboseLevel = max (psVerboseLevel ps) n }
+
+optOutput :: String -> OptFunc
+optOutput s ps = return $ ps { psOutputFile = s }
+
+getOpts :: [String] -> IO ([OptFunc], [String])
 getOpts argv =
   case getOpt RequireOrder options argv of
     (o,n,[]  ) -> return (o,n)
@@ -48,11 +60,7 @@ main = do
               [fn] -> fn
               _ -> error "Must specify a single input file"
 
-  let state0 = emptyState { psFlags = opts }
-
-  progressIO state0 $ "Options: " ++ show opts
-  progressIO state0 $ "Compiling " ++ fn
-  progressIO state0 ""
+  state0 <- foldl (>>=) (return emptyState) opts
 
   debugIO state0 "{{{ Preprocess"
   state0a <- loadSource fn state0
@@ -64,7 +72,7 @@ main = do
   debugASTIO state1 ast1
   debugIO state1 "}}}"
 
-  if ParseOnly `elem` opts then
+  if psParseOnly state1 then
       putStrLn $ show ast1
     else do
       progressIO state1 "Passes:"
@@ -73,7 +81,13 @@ main = do
       debugIO state2 "{{{ Generate C"
       progressIO state2 "Generate C"
       c <- generateC state2 ast2
-      putStr c
+      case psOutputFile state2 of
+        "-" -> putStr c
+        file ->
+          do progressIO state2 $ "Writing output file " ++ file
+             f <- openFile file WriteMode
+             hPutStr f c
+             hClose f
       debugIO state2 "}}}"
       progressIO state2 "Done"
 
diff --git a/fco2/Makefile b/fco2/Makefile
index e6cbe88..16d32a1 100644
--- a/fco2/Makefile
+++ b/fco2/Makefile
@@ -27,7 +27,7 @@ $(targets): $(sources)
 CFLAGS = -g -std=gnu99 -Wall `kroc --cflags` `kroc --ccincpath`
 
 %.fco.c: %.occ fco
-	./fco -v $< >$@ || ( rm -f $@; exit 1 )
+	./fco -v -o $@ $<
 	indent -kr -pcs $@
 
 %.fco: %.fco.o fco_support.h kroc-wrapper-c.o kroc-wrapper.occ
diff --git a/fco2/ParseState.hs b/fco2/ParseState.hs
index 425f3c6..9bdf7f6 100644
--- a/fco2/ParseState.hs
+++ b/fco2/ParseState.hs
@@ -8,13 +8,12 @@ import qualified AST as A
 import Errors
 import Metadata
 
-data Flag = ParseOnly | Verbose | Debug
-  deriving (Eq, Show, Data, Typeable)
-
 -- | State necessary for compilation.
 data ParseState = ParseState {
-    -- Set by Main
-    psFlags :: [Flag],
+    -- Set by Main (from command-line options)
+    psVerboseLevel :: Int,
+    psParseOnly :: Bool,
+    psOutputFile :: String,
 
     -- Set by preprocessor
     psSourceFiles :: [(String, String)],
@@ -41,7 +40,9 @@ instance Show (A.Process -> A.Process) where
 
 emptyState :: ParseState
 emptyState = ParseState {
-    psFlags = [],
+    psVerboseLevel = 0,
+    psParseOnly = False,
+    psOutputFile = "-",
 
     psSourceFiles = [],
 
diff --git a/fco2/Pass.hs b/fco2/Pass.hs
index 80c5a1c..8b825d3 100644
--- a/fco2/Pass.hs
+++ b/fco2/Pass.hs
@@ -38,25 +38,29 @@ runPasses ((s, p):ps) ast
           debug $ "}}}"
           runPasses ps ast'
 
+verboseMessage :: Int -> String -> PassM ()
+verboseMessage n s
+    =  do ps <- get
+          liftIO $ verboseMessageIO n ps s
+
+verboseMessageIO :: Int -> ParseState -> String -> IO ()
+verboseMessageIO n ps s = when (psVerboseLevel ps >= n) $ hPutStrLn stderr s
+
 -- | Print a progress message if appropriate.
 progress :: String -> PassM ()
-progress s
-    =  do ps <- get
-          liftIO $ progressIO ps s
+progress = verboseMessage 1
 
 -- | Print a progress message if appropriate (in the IO monad).
 progressIO :: ParseState -> String -> IO ()
-progressIO ps s = when (Verbose `elem` psFlags ps) $ hPutStrLn stderr s
+progressIO = verboseMessageIO 1
 
 -- | Print a debugging message if appropriate.
 debug :: String -> PassM ()
-debug s
-    =  do ps <- get
-          liftIO $ debugIO ps s
+debug = verboseMessage 2
 
 -- | Print a debugging message if appropriate (in the IO monad).
 debugIO :: ParseState -> String -> IO ()
-debugIO ps s = when (Debug `elem` psFlags ps) $ hPutStrLn stderr s
+debugIO = verboseMessageIO 2
 
 -- | Dump the AST and parse state if appropriate.
 debugAST :: A.Process -> PassM ()
diff --git a/fco2/TODO b/fco2/TODO
index dd91fd9..cf1f950 100644
--- a/fco2/TODO
+++ b/fco2/TODO
@@ -23,8 +23,6 @@ Types needs cleaning up and Haddocking.
 
 Add an option for whether to compile out overflow/bounds checks.
 
-Add a -o option to control where the output goes (stdout by default for now).
-
 ## Parser
 
 The indentation parser is way too simplistic.
@@ -37,6 +35,8 @@ Record literals aren't implemented.
 
 Expression simplification -- this should use generics, so that we can have a
 default behaviour that simplifies expressions inside another one.
+(More generally, simplifyExpressions should really be split into a simplifier
+and a constant-finder -- or should return two values.)
 
 Output item expressions should be pulled up to variables.
 
@@ -73,9 +73,6 @@ to be a bad idea for very large counts (since I assume it'll allocate off the
 stack). We should probably do a malloc if it's not determinable at compile
 time.
 
-The operator functions need to have the type name attached -- they'll only work
-for INT at the moment.
-
 Real-to-integer conversions don't work correctly.
 
 ## Long-term