{-# LANGUAGE CPP, NamedFieldPuns #-}
{-# OPTIONS_GHC -fwarn-incomplete-patterns  #-}

-- This file puts the pieces together and defines the main entyrpoints into the CnC tool.

module Intel.Cnc.Spec.MainExecutable
 ( readCnCFile, readCnCFromStr,
   mainExecutableCommand )
  where

import Intel.Cnc.Spec.CncLexer hiding (main)
import Intel.Cnc.Spec.CncGrammar
import Intel.Cnc.Spec.SrcLoc
import Intel.Cnc.Spec.CncGraph
import Intel.Cnc.Spec.GatherGraph
import Intel.Cnc.Spec.Util hiding(t)
import Intel.Cnc.Spec.TraceVacuum

import Intel.Cnc.Spec.GraphAnalysis
import Intel.Cnc.Spec.Codegen.CppOld
import Intel.Cnc.Spec.Codegen.CodegenShared
import Intel.Cnc.Spec.Codegen.Plugins
import Intel.Cnc.Spec.Codegen.Plugins.ReductionDone
import Intel.Cnc.Spec.Codegen.Plugins.TagFunCorrectness
import Intel.Cnc.Spec.Codegen.Plugins.Depends

import qualified  Intel.Cnc.EasyEmit as EE -- TEMPTOGGLE

import Intel.Cnc.Spec.Codegen.Haskell
import Intel.Cnc.Spec.Passes.TypeDef
import Intel.Cnc.Spec.Passes.ReadHarch
import Intel.Cnc.Spec.Version

import Data.Maybe ( fromJust )
import qualified Data.Map as M
import qualified Data.Set as S
import Data.List

import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Char8 as BL

import Codec.Compression.GZip (decompress)
import Control.Monad hiding (when)
import Control.Exception 

import System.Environment
import System.Console.GetOpt
import System.Console.ANSI 
import System.FilePath.Posix
import System.IO
import System.IO.Unsafe
import System.Exit
import qualified System.Directory as Dir

import Text.Printf
import Text.PrettyPrint.HughesPJClass
import Test.HUnit
-- import Debug.Trace

-- These expand the file size quite a bit.  Not committing to include right now:
-- #define CNCVIZ
#ifdef CNCVIZ 
import Intel.Cnc.Spec.CncViz as Viz
import Control.Concurrent
#endif

----------------------------------------------------------------------------------------------------486

data Flag 
    = Verbose Int | Version | Help | Debug 
    | GenTracing | GenDepends | NoStepDefs | SelfTest
    | AutoDone | AutoDoneDbg
    | Cpp | CppOld | Haskell
 -- | Input String  | LibDir String
    | Output String 
    | HarchPart String
    | HarchViz String
    | NullOpt
    | DotOpt
    | VizOpt
    | UbigraphOpt
    -- Trace mode:
    | Pack String 
    | VacuumViz  | Vacuum
    | SynthSpec String    
  deriving (Show, Eq, Ord)
    

run_modes :: [(String, [OptDescr Flag], String)]
run_modes = 
  [ ("translate", translate_options, "Translates .cnc specification files to host language code")
  , ("trace"    , trace_options, "Works with Traces, e.g. the output of CnC::debug::trace.\n"++
                                 " (Reads a trace from an input file, if provided, or stdin.)")
  , ("harchpart", harchpart_options, "Uses Harch, the hierarchical graph partitioner for CnC.\n"++
--                                     " (This mode expects one .harch as input and produces a .part.harch)")
                                     " (This mode enriches a .harch file with partition info.)")
  ]

common_options :: [OptDescr Flag]
common_options = 
     [ Option ['V']     ["version"] (NoArg Version)   "show version number"
     , Option ['v']     ["verbose"] (OptArg (\x -> case x of Just n  -> Verbose (read n); 
					                     Nothing -> Verbose (-1)) "N") 
                                    "verbosity level {0,1,2} default 1 (-v with no arg increments)"
     , Option []     ["selftest"]   (NoArg SelfTest)    "run internal unit tests"
     , Option []     ["help"]       (NoArg Help)        "print this help information"
     ]

translate_options ::  [OptDescr Flag]
translate_options = 
     [ 
       Option []        ["cpp"]     (NoArg Cpp)          "translate spec to C++ code [default]"
     , Option ['c']     ["cppold"]  (NoArg CppOld)       "translate spec to C++ code (legacy 0.5 API)"
     , Option ['h']     ["haskell"] (NoArg Haskell)      "translate spec to Haskell code"
     , Option ['o']     ["output"]  (ReqArg Output "FILE")    "use FILE as a prefix for output header/codinghints"
     , Option []        ["harch"]   (ReqArg HarchPart "FILE") "read Harch graph metadata from FILE (used for translation)"
     , Option []        ["debug"]   (NoArg Debug)             "generate extra code for correctness checking"
     , Option []        ["tracing"] (NoArg GenTracing)        "generate code in which tracing is on by default"
     , Option []        ["depends"] (NoArg GenDepends)        "generate depends functions from spec where possible"
    , Option []        ["autodone"] (NoArg AutoDone)          "track collection completion and signal reduction-completion automatically"
    , Option []        ["autodonedbg"] (NoArg AutoDoneDbg)    "print additional messages for debugging autodone facility"

     -- , Option []     ["autodone"] (OptArg 
     -- 				   (\ arg -> case arg of 
     -- 				              Just str -> trace str $ AutoDone
     -- 				              Nothing -> AutoDone)
     -- 				   "mode")
     -- 		                  "track collection completion and signal reduction-completion automatically"

--     , Option []        ["defsteps"] (NoArg GenTracing)$  "[c++] rather than the user defining custom types for each step,\n"++
--	                                                  "      emit default versions within the generated header"
--		                                          "      create a standard definition in the generate header"

     -- , Option []        ["defsteps"] (NoArg GenStepDefs)$ "[c++] define default step structs in the generated header \n"++
     -- 		                                          "      (rather than custom, user-defined type definitions)"

     , Option []        ["customsteps"] (NoArg NoStepDefs)$ "[c++] Don't define default step structs in the generated header \n"++
		                                              "      (Instead the user provides custom type definitions.)"


#ifdef CNCVIZ
     , Option []        []           (NoArg NullOpt)  ""
     , Option []        ["dot"]      (NoArg DotOpt)   "output CnC graph in graphviz .dot format instead of translating"
     , Option []        ["viz"]      (NoArg VizOpt)   "similar to --dot, a shortcut to visualize a CnC graph in a X11 window"
     , Option []        ["ubigraph"] (NoArg UbigraphOpt)  "like --viz, but visualize on a local Ubigraph server"
#endif

     ]

trace_options ::  [OptDescr Flag]
trace_options = 
     [ 
        Option ['p']    ["pack"]   (ReqArg Pack "FILE")   "write the captured trace to FILE in compressed binary format"
#ifdef CNCVIZ
     ,  Option []       ["viz"] (NoArg VacuumViz) "use trace to visualize graph execution using ubigraph"
#endif


-- TEMPTOGGLE: This feature is not implemented yet:
#if 0
     ,  Option []       ["synth"] (ReqArg SynthSpec "FILE") "use trace to synthesize a draft .cnc Spec for the program"
#endif
     ,  Option []       ["debug"] (NoArg Debug)             "print parsed trace to validate parsing"
     ]


harchpart_options ::  [OptDescr Flag]
harchpart_options = 
     [ 
       Option ['o']     ["output"] (ReqArg Output "FILE") "output the graph-partitioned harchfile to FILE"
#ifdef CNCVIZ
     , Option []        ["viz"]    (ReqArg HarchViz "FILE")  "visualize the graph stored in FILE with Harch clustering"
#endif
     ]



printHeader = do
--  putStrLn$ "Intel(R) Concurrent Collections Specification Tool, version "++ version
  putStrLn$ "The fabulous, multi-purpose CnC Specification Tool, version "++ version
  putStrLn$ "Part of the Intel(R) Concurrent Collections (CnC) Project"
  putStrLn$ "Built on: " ++ builddate
  putStrLn$ "Copyright 2011 Intel Corporation."

when b action = if b then action else return ()


------------------------------------------------------------------------------------------------------------------------
-- The translator front-end: parse a file, convert to graph:
------------------------------------------------------------------------------------------------------------------------



-- This is a primary entrypoint.
-- It invokes the parser and creates the graph coelescence.
readCnCFile :: Int -> String -> IO CncSpec
readCnCFile verbosity file = do 
  handle <- openFile file ReadMode
  str <- hGetContents handle

--  let appname = takeBaseName file
  final <- readCnCFromStr verbosity file str
  hClose handle -- Cleaner to do this than to wait for garbage collection.
  return final

-- This works on strings... it take an file argument that is just
-- metadata, which file did the string come from and what should the
-- spec be named.
readCnCFromStr :: Int -> String -> String -> IO CncSpec
readCnCFromStr verbosity file str = do
  when (verbosity > 2)$ putStrLn "\n                            All Lexed Tokens "
  when (verbosity > 2)$ putStrLn "================================================================================"

  --when verbose$ print $ hcat $ intersperse (text ", ") $ map (\ (L _ cl str) -> text (show cl) <+> pp str) $ scan_to_list str
  when (verbosity > 2)$ print $ sep $ map (\ (L _ cl str) -> text (show cl) <+> pp str) $ scan_to_list str
       --filter (not . is_comment) $ scan_to_list str -- Even filtering the long lines still doesn't `sep` to do the right thing.

  let parsed = runCncParser file str

      parsed' = if null parsed 
                then error "ERROR: CnC file contained no statements!\n Empty spec not considered valid."
		else parsed
      ----------------------------------------
      -- Pass 1: desugar type
      p1 = desugarTypeDefs parsed'

      ----------------------------------------
      final_statements = p1

  ----------------------------------------
  when (verbosity > 2)$ putStrLn "\n                          Parsed AST (detailed)"
  when (verbosity > 2)$ putStrLn "================================================================================"
  when (verbosity > 2)$ sequence_ $ map (print . stripDecor) parsed

  -- when verbose$ putStrLn "\nParsed AST rendered as a SExp:"
  -- when verbose$ putStrLn "================================================================================"
  -- when verbose$ sequence_ $ map (\stmt -> putStrLn $ buildList $ sexpSerialize stmt) parsed

  when (verbosity > 1)$ putStrLn "\n                         Pretty printed parsed AST"
  when (verbosity > 1)$ putStrLn "================================================================================"
  when (verbosity > 1)$ putStrLn$ renderStyle style $ hcat $ map pPrint parsed

  -- [2010.07.23] Lazy parsing complicates this, it must happen after IO that touches the parse:
  evaluate (length str)

  when (verbosity > 1)$ putStrLn "                            Coalesced CnC Graph"
  when (verbosity > 1)$ putStrLn "================================================================================"
  -- The name of the module is derived from the file name:	   
  let appname = takeBaseName file
  let graph = coalesceGraph appname final_statements

  when (verbosity > 1)$ putStrLn ""
  when (verbosity > 1)$ print $ pp graph

  when (verbosity > 1)$ putStrLn "================================================================================"
  return graph


  
------------------------------------------------------------------------------------------------------------------------

-- If this module is used as an executable, this handles arguments and does the appropriate thing.
mainExecutableCommand = 
 do 
    argv <- getArgs
    mainWithArgStrings argv

baseline = [SetColor Background Dull Black]
withCol viv col act = 
    do setSGR [SetColor Foreground viv col]
       act 
       setSGR []
       --setSGR baseline

simpleErr "" msg = error$ "ERROR!\n  " ++ msg
simpleErr mode msg = error$ "ERROR! ("++hcnc_name++" "++ mode ++" mode)\n  " ++ msg


mainWithArgStrings argv = do  
  let 

      print_usage_common = 
         do withCol Vivid Black$ putStr$ "Common Options (all modes):"
            putStr$ usageInfo "" common_options 		    

      mode_usage (mode, opts, help) = do 
	    withCol Dull Green$ putStr$ "\n '"++ mode ++"' mode:\n "
            --withCol Dull Cyan  $ putStr$ help ++":\n"
	    withCol Vivid Black  $ putStr$ help ++":\n"
            withCol Dull Red   $ putStr$ take 80$ repeat '-'
	    putStr$ usageInfo ""  opts
            setSGR []

      print_usage_all = 
       do withCol Dull Green$ putStr$ "Usage: "++hcnc_name++" mode [OPTION...] files..." 
	  putStr$ "\n\n"
	  print_usage_common
          forM_ run_modes mode_usage

      defaultErr mode errs = 
       do 
          --setSGR baseline
          withCol Vivid Red$ putStr$ "ERROR!  " ++ (if null mode then "" else "("++hcnc_name++" "++mode++" mode)  ") ++errs++"\n"
	  print_usage_all
          putStrLn ""
          error $ "ERROR!  "

      -- simpleErr mode msg = do 
      -- 	 withCol Vivid Red$ 
      -- 	   case mode of 
      -- 	     "" -> 

  ----------------------------------------------------------------------------------------------------
  -- Read and process option flags:
  ----------------------------------------------------------------------------------------------------

  -- Do a little pre-processing of the opts so we can catch --version:
  -- On first look we just look at the common options.  Later on we include the mode options as well.
  let (common_opts,_,_) = getOpt Permute common_options argv

  when (Version `elem` common_opts) $  do printHeader; exitSuccess
  when (SelfTest `elem` common_opts) $ 
    do (Counts{errors,failures},_) <- cncRunAllTests
       if errors+failures == 0 
        then exitSuccess
	else exitWith (ExitFailure (errors+failures))

  when (null argv) $ defaultErr ""$ "First argument to "++hcnc_name++" must specify a mode!\n"
  
  let helpmode = Help `elem` common_opts
      (first:__rest) = argv
      (__mode, __mode_opts, _) = case filter (isPrefixOf first . fst3) run_modes of  
	       [] | helpmode -> unsafePerformIO$ do { print_usage_all; exitSuccess }
	       []  -> simpleErr ""$ first ++ " does not correspond to any "++hcnc_name++" mode\n"
	       [m] -> m
	       ls  -> simpleErr ""$ "Prefix '"++first++"' could refer to multiple modes:  "
	                          ++ concat (intersperse ", "$ map fst3 ls)
      verbosity = foldl (\ lvl opt -> case opt of Verbose (-1) -> lvl+1; Verbose n -> n; _ -> lvl) 1 common_opts

      -- uncommon: filter out options that get special treatment first:
      -- This is annoying but I can't think of a systematic way:							      
      uncommmon (Verbose _) = False
      uncommmon (Version  ) = False
      uncommmon (Help     ) = False
      uncommmon (SelfTest ) = False
      uncommmon _           = True

      -- HACKish SHORTCUT to make things easy for people.  A ".cnc" file is allowed as the first argument.
      (mode, mode_opts, rest) = 
	if takeExtension first == ".cnc" 
	   -- Switch us implicitly into translate mode:
	then let Just (a,b,_) = find ((== "translate") . fst3) run_modes in 
	     (a,b, argv)
	else (__mode, __mode_opts, __rest)

  evaluate mode -- Force the above unsafePerformIO 

  -- For now none of the command line flags attach any meaning to
  -- DUPLICATES, and some of the configuration actions need to only
  -- take place once.  (For example, it would be disasterous to enable
  -- DonePlugins more than once.)  Thus we treat 'opts' as a set:
  (opts_set,files) <- 
     case getOpt' Permute (common_options ++ mode_opts) rest of 
       (o,n,[], [] ) -> return (S.fromList$ filter uncommmon o, n)
       (o,n,bad,[] ) -> simpleErr ""$ "Unrecognized options in "++mode++" mode: "++ concat (intersperse " " bad)
       (_,_,_,errs)  -> simpleErr mode$ concat errs  
  let opts = S.toList opts_set

  when helpmode $ 
    do --putStrLn "Mode specific options:"
       let do_mode = mode_usage$ fromJust$ find ((== mode) . fst3) run_modes 
       case mode of 
         "harchpart" -> do_mode
         "trace"     -> do_mode
         "translate" -> do_mode
         _ -> error "Really egregious internal error"
       putStrLn ""
       print_usage_common
       exitSuccess

  ----------------------------------------------------------------------------------------------------
  -- Now begins the per-mode behavior:
  ----------------------------------------------------------------------------------------------------
  case mode of 

   "harchpart" -> harchpartCommand opts

   ------------------------------------------------------------	       
   "trace" -> do
      handle <- if null files 
		then do putStrLn$ cnctag++"Reading trace from stdin."
			return stdin 
		else do putStrLn$ cnctag++"Reading trace from file "++ show(head files)
			(openFile (head files) ReadMode)
      str <- BL.hGetContents handle
      let is_packed  = isPackedTrace str
	  is_gzipped = isGZipped str
      when is_packed  $ putStrLn$ cnctag++"Trace is in packed (binary) format."
      when is_gzipped $ putStrLn$ cnctag++"Trace is GZipped, decompressing."
      let thetrace = if is_packed
		     then unpackCncTrace str
--		     else parseCncTrace$ lines$  BL.unpack str
		     else parseCncTrace$ 
			  -- TODO: We need to examine the efficiency of this:
			  -- Currently the parser works in terms of a list of lines, with lines being STRICT bytestrings.
			  -- But the extra conversion may make this pointless.  Perhaps the parser should use lazy bytestrings directly.
			  map (B.concat . BL.toChunks) $ 
			  BL.lines$ 
			  (if is_gzipped then decompress str else str)
          debug = foldl fn False opts
	  fn deb opt =  
            case opt of 
	       VacuumViz      -> deb
	       Debug          -> True
	       SynthSpec file -> error "Internal error, spec synthesis not implemented yet"
	       Pack file   -> deb
	       _ -> error$ "Internal error, not handled in this mode: "++ show opt

          ispack (Pack _)   = True
          ispack _          = False
	  alldone = do let len = length thetrace
		       evaluate len 
		       putStrLn$ cnctag++"Reached end of trace (length "++ show len++").  Exiting."
		       exitSuccess

     --------------------------------------------------------------------------------
     -- PROOF OF CONCEPT:
      -- TEMPTOGGLE -- GETCOUNT SUMMARIZATION PRINTOUTS : this is just for testing:
     -- Disabling for now [2011.01.25], bring back later:
      when (False && debug) $ do
	    let 
	        -- Here we need to collect all get events and take statistics:
	        fn (GetI _ (_,tag)) = map fst (reads (B.unpack tag) :: [((Int,Int,Int), String)])
		fn _ = [] 
                -- TEMP: TODO: GENERALIZE
                getname (GetI _ (nm,_)) = [nm]
		getname _ = []
                names = concat$ map getname thetrace
                tags  = concat$ map fn thetrace

		collected = foldl (\ acc tup -> M.insertWith (+) tup 1 acc) M.empty tags
		keys = M.keys collected
		bounds keys = ( foldl1 min $ map fst3 keys
			      , foldl1 min $ map snd3 keys
			      , foldl1 min $ map thd3 keys
			      , foldl1 max $ map fst3 keys
			      , foldl1 max $ map snd3 keys
			      , foldl1 max $ map thd3 keys)
	        -- Text formatting details:
		(l1,l2,l3,u1,u2,u3) = bounds keys
		biggest = foldl1 max $ M.elems collected
		-- Amount of space needed for biggest number:
		size = 1 + (ceiling$ log (fromIntegral biggest) / log 10.0)
		padtail size str = str ++ take (size - length str) (repeat ' ') 

            print collected
	    putStrLn$ "LOWER BOUNDS: " ++ show (l1,l2,l3)
	    putStrLn$ "UPPER BOUNDS: " ++ show (u1,u2,u3)

	    putStrLn$ "\n\nTags for collection " ++ show (names !! 3) ++ " have schema (Int,Int,Int)."
	    putStrLn$ "Observed getcounts were:"
            forM_ [l3..u3] $ \k -> do
	        let (i1,i2,_,j1,j2,_) = bounds $ filter ((== k) . thd3) keys
		--putStrLn$ "\n i/j getcounts grid for k = " ++ show k ++ " i in ["++ show l1 ++","++ show u1 ++"], j in ["++ show l2 ++","++ show u2 ++"]:"
	        printf "\n i/j getcounts grid for k = %d,  i in [%d,%d], j in [%d,%d]:\n" k i1 i2 j1 j2
		putStr$ "+-------------------"
		forM_ [l1..u1] $ \i -> do
		    putStr$ "\n|"
		    forM_ [l2..u2] $ \j -> do
		      case M.lookup (i,j,k) collected of 
			Nothing -> putStr$ take size (repeat ' ')
			Just n  -> putStr$ padtail size (show n)
		putStrLn$ ""
	    putStrLn$ "\n"

	    --mapM_ print tags
	    --mapM_ print (sortBy (compare `on` snd) $ M.toList collected)

	    alldone

     -- END PROOF OF CONCEPT
     --------------------------------------------------------------------------------

--      case sort $ filter ispack opts of 
      case filter ispack opts of 
       [] -> return ()
       [Pack file] -> do putStrLn$ cnctag++"Packing trace to file "++ show file
			 BL.writeFile file (packCncTrace thetrace)
			 alldone 
       ls -> error$ "ERROR: bad combination of pack/unpack options: "++ show ls

      -- In debugging mode we just print the parsed trace:
      when (debug) $ do
	    mapM_ print thetrace
	    alldone

#ifdef CNCVIZ
      when (VacuumViz `S.member` opts_set) $ do
	    let guiactions = traceToGUI thetrace

	    -- This prints it out ASAP so it doesn't follow the actual playback unfortunately...
	    -- TODO: Push this functionality down into "playback".
	    when (verbosity>1) $ do (forkIO $ mapM_ print guiactions); return ()
	    when (verbosity>1) $ do (forkIO $ mapM_ print thetrace); return ()

	    playback emptyGUIState guiactions
	    alldone
#endif

      -- Well, with nothing else to do might as well read to the end and then exit:
      alldone

   ------------------------------------------------------------------- 
   -- The most important mode of all: translate .cnc files to headers.
   ------------------------------------------------------------------- 
   "translate" -> translateCommand verbosity opts_set files

   _ -> error "Really egregious internal error"

  --------------------------------------------------------------------------------
  -- Finished with mode dispatch
  --------------------------------------------------------------------------------
  when (verbosity>0)$ putStrLn$ cnctag++"Done."


----------------------------------------------------------------------------------------------------
----------------------------------------------------------------------------------------------------

harchpartCommand opts = do 
      forM_ opts $ \ opt -> 
        case opt of 
#ifdef CNCVIZ
	 HarchViz file -> 
	     do putStrLn$ "Reading (and visualizing) harch file from: "++ file
		spec@(HarchSpec g _) <- readHarchFile file
--		simple_graphviz name g
		harch_graphviz name spec
		putStrLn$ "Done with visualization, exiting without performing any .cnc spec translation."
		exitSuccess
#endif
	 Output file -> error "Internal error, trace output not implemented yet"
	 _ -> error$ "Internal error, not handled: "++ show opt

      -- HarchPart file -> 
      error "harchpart not implemented yet"
      return ()


----------------------------------------------------------------------------------------------------
----------------------------------------------------------------------------------------------------


----------------------------------------------------------------------------------------------------
-- Implementation of translate mode.
----------------------------------------------------------------------------------------------------

translateCommand verbosity opts_set files =   
   do 
      let 
          opts = S.toList opts_set
	  mode = "translate"

          codegenmode_option o = o `elem` [Cpp, CppOld, Haskell] 
	  codegenmode = case filter codegenmode_option opts of
               [] -> Cpp
  	       [o] -> o 
  	       ls -> simpleErr mode ("\nAsked to generate output in more than one format!  Not allowed presently. "++show ls++"\n")
	  file = case files of 
	           [file] -> file
		   []     -> simpleErr mode$ "\nNo files provided!\n"
		   ls     -> simpleErr mode$ "\nCurrently the translator expects exactly one input file, got "
			                     ++show (length ls)++":\n  " ++ concat (intersperse ", " ls) ++ "\n"

      -- Force evaluation to make sure we hit the error:
      case codegenmode of 
	 Cpp -> return ()
	 _   -> return ()

      -- Sanity check on mode flags:
      when (AutoDone `S.member` opts_set && AutoDoneDbg `S.member` opts_set) $
	   error$ "translate: cannot activate --autodone and --autodonedbg at the same time"

      -- Process options for this mode:
      protoconfig <- foldM (\ cfg opt -> do 
       case opt of 
         Help        -> return cfg
#ifdef CNCVIZ
	 UbigraphOpt -> 
	     do CncSpec{graph} <- readCnCFile verbosity file
		cncUbigraph True graph
		putStrLn$ "Done with visualization, exiting without performing any .cnc spec translation."
		exitSuccess
#endif
         Debug       -> return cfg{ gendebug=True, wrapall=True }
         GenTracing  -> return cfg{ gentracing=True } 
         GenDepends  -> return cfg{ gendepends=True
				  , plugins = dependsPlugin : plugins cfg } 

         AutoDone    -> return cfg{ done_plugins= reductionDonePlugin : done_plugins cfg }
         AutoDoneDbg -> return cfg{ done_plugins= reductionDonePlugin : done_plugins cfg
				  , debug_autodone = True } 
         NoStepDefs  -> return cfg{ genstepdefs=False } 

	 m | codegenmode_option m -> return cfg
	 o -> simpleErr mode ("Internal error: Currently unhandled option: "++ show o ++"\n")
       ) default_codegen_config opts

      -- Finally, squish all done plugins into one and add them into the main plugin list:
      let config = case done_plugins protoconfig of 
		    [] -> protoconfig
		    ls -> protoconfig 
			  { done_plugins = [],
			    plugins = let all_dones = foldl1 composeDonePlugins ls in 
			              convertDonePlugin (debug_autodone protoconfig) all_dones 
			               : plugins protoconfig
			  }

      -- Now do the actual translation (if we get to here):
      ------------------------------------------------------------

      graph <- readCnCFile verbosity file 

      -- For clarity of error messages, let's force this before begin "emitCpp" below:
      evaluate graph

      let appname = takeBaseName file  
	  base = takeDirectory file </> appname 
	  toFile outname msg str = 
           do x <- try 
		    (do outhand <- openFile outname WriteMode
		        when (verbosity>0)$ putStrLn$ cnctag++"Generating "++msg++", output to: " ++ outname
		        writeSB outhand $ str
		        hClose outhand)
              case x of 
	        Left (ex) -> 
		    do let err = outname ++ ".ERR"
		       putStrLn$ cnctag++"Spec "++ verb ++" failed, moving partially written file to " ++ err
		       putStrLn$ cnctag++"Rethrowing error, see below: "
		       Dir.renameFile outname err
		       throw (ex :: SomeException)
		Right _ -> return ()

      case codegenmode of
	CppOld -> 
	   toFile (base ++ ".h") "header (legacy CnC 0.5 API)"
		  (emitCpp config graph :: EE.EasyEmit ())
--True (GenStepDefs `elem` opts)
	Cpp ->        
	   toFile (base ++ ".h") "header"
		  (emitCpp config graph :: EE.EasyEmit ())
--False (GenStepDefs `elem` opts)

	Haskell -> 
	   toFile (base ++ "_heaader.hs") "header"
		  (emitHaskell graph :: EE.EasyEmit ())

	_ -> error$ "Not a codegen mode: "++ show codegenmode



verb = "translation" 
-- verb = "compilation" 

------------------------------------------------------------------------------------------------------------------------
-- Testing 
------------------------------------------------------------------------------------------------------------------------

-- Aggregate the unit tests from all the modules that provide them:
all_unit_tests = 
 --test $ 
 TestLabel "All cnc tool unit tests" $ TestList $
 [ test_desugarTypeDefs
 , test_traceVacuum
 , EE.tests_easyemit
 , test_readharch
 , tests_graphanalysis
 , tests_gathergraph
 ]

cncRunAllTests :: IO (Counts, ())
cncRunAllTests = 
 --    runTestText (putTextToHandle stdout True) all_unit_tests
    runTestText (PutText myPut ()) all_unit_tests
 where myPut msg True  () = do putStrLn ""; putStrLn$ msg
       myPut msg False () = return ()

t = cncRunAllTests -- Lazy shorthand

{-

testread = 
-- do file <- openFile "/Users/newton/cnc/experimental/graphPartitioner/test.harch" ReadMode 
 do file <- openFile "/Users/newton/cnc/experimental/graphPartitioner/test2.harch" ReadMode 
-- do file <- openFile "/Users/newton/cnc/experimental/graphPartitioner/outputs/pipes.harch.partitioned" ReadMode 
    txt <- hGetContents file
    let ls = run harchfile txt
    --sequence_$ map print ls

    putStrLn "\n Now partitions: \n"
    let part = extractPartitions ls
    --print part
	  
    let gr = convertHarchGraph ls

    print gr
    simple_graphviz name gr

    --sequence_$ map print ppaths
    return part

-}