optimusprime-0.0.1.20091113: OptimusPrime.hs

{-# LANGUAGE DeriveDataTypeable #-}

import System
import System.IO
import Flite.Identify
import Flite.Parsec.Parse
import Optimus.CallGraph
import Optimus.Pretty
import Optimus.Strategy
import Optimus.Util
import System.Console.CmdArgs hiding (prog)

data SCArgs = SCArgs { scOption :: SCOption
					 , targets :: String
					 , numTargets :: Int
					 , scFile :: [String] }
	deriving (Show, Data, Typeable)

data SCOption = Normal | Graph | Auto | List
	deriving (Show, Data, Typeable, Eq)

version = "OptimusPrime v0.0.1, (C) Jason Reich <jason@cs.york.ac.uk>"
optimusprime = mode $ SCArgs
		{ scOption = enum Normal [ Graph &= text "Produce call graph in graphviz DOT format"
								 , Auto &= text "Automagically select targets for sc"
								 , List &= text "Output the automagically selected targets" ]
		, targets = def &= typ "FUNCTIONS" & text "Space-delimited list of functions to target (overrides auto)"
		, numTargets = def &= typ "NUM" & text "Number of targets to supercompile (default=5)"
		, scFile = def &= args & typFile
		} &=
		text "Supercompiler for f-lite" &
		helpSuffix [""]
		
main = do
		SCArgs m ts num fs <- cmdArgs version [optimusprime]
		case fs of
			[f] -> do
				p <- parseProgFile f >>= return . identifyFuncs . freshProg desugar
				let num' = if num == 0 then 5 else num
				let ts' = if null ts then selectFuncs num' p else words ts
				case m of
					Normal 	-> (putProg . supercompile) p
					Graph 	-> (putStrLn . produceDotTrav . travGraph . freshProg desugar) p
					Auto	-> (putProg . supercompileMany ts') p
					List	-> putStrLn $ "Targetted functions: " ++ unwords ts'
				putStrLn ""
			otherwise -> cmdArgsHelp version [optimusprime] Text >>= putStr