diff --git a/.gitignore b/.gitignore index 450f32ec..a4caccaf 100644 --- a/.gitignore +++ b/.gitignore @@ -18,3 +18,4 @@ cabal.sandbox.config .stack-work/ cabal.project.local .HTF/ +output/ diff --git a/grin/app/Main.hs b/grin/app/Main.hs index ec400af5..8fff1d86 100644 --- a/grin/app/Main.hs +++ b/grin/app/Main.hs @@ -6,40 +6,44 @@ import System.Environment import Text.Printf import Text.PrettyPrint.ANSI.Leijen hiding ((<$>)) +import AbstractRunGrin import Eval -import ParseGrin hiding (value) import Grin +import ParseGrin hiding (value) +import Pipeline import Pretty import PrettyHPT -import Transformations -import TrafoPlayground -import AbstractRunGrin -import qualified CodeGenX64 as CGX64 -import qualified CodeGenLLVM as CGLLVM -import qualified JITLLVM -import VarGen import System.Process +import TrafoPlayground +import Transformations +import VarGen + +import qualified CodeGenLLVM as CGLLVM +import qualified CodeGenX64 as CGX64 +import qualified JITLLVM import Data.IntMap as IntMap import Data.Map as Map -import qualified Text.Show.Pretty as PS import LLVM.Pretty (ppllvm) -import qualified Data.Text.Lazy.IO as Text import System.FilePath -import Control.Monad.Trans.State.Strict import Control.Monad.IO.Class -import Lens.Micro -import Lens.Micro.TH -import Lens.Micro.Mtl +import Control.Monad.Trans.State.Strict import Data.Set +import Lens.Micro +import Lens.Micro.Mtl +import Lens.Micro.TH import Options.Applicative -import Pipeline +import qualified Text.Show.Pretty as PS +import qualified Data.Text.Lazy.IO as Text + + data Options = Options - { optFiles :: [FilePath] - , optTrans :: [Pipeline] + { optFiles :: [FilePath] + , optTrans :: [Pipeline] + , optOutputDir :: FilePath } deriving Show flg c l h = flag' c (mconcat [long l, help h]) @@ -88,11 +92,18 @@ options = execParser $ info pipelineArgs = Options <$> some (argument str (metavar "FILES...")) <*> many pipelineOpts + <*> strOption (mconcat + [ short 'o' + , long "output-dir" + , help "Output directory for generated files" + , value "./output" + ]) defaultPipeline :: Options -> Options defaultPipeline = \case - Options files [] -> - Options files + Options files [] output -> + Options + files [ HPT , T CaseSimplification , T Vectorisation @@ -104,11 +115,12 @@ defaultPipeline = \case , SaveLLVM "code" , JITLLVM ] + output opts -> opts main :: IO () main = do - Options files steps <- defaultPipeline <$> options + Options files steps outputDir <- defaultPipeline <$> options forM_ files $ \fname -> do grin <- either (fail . show) id <$> parseGrin fname let program = Program grin @@ -117,4 +129,5 @@ main = do putStrLn $ unlines result putStrLn "* tag info *" putStrLn . show . collectTagInfo $ program - pipeline program steps + let opts = PipelineOpts { _poOutputDir = outputDir } + pipeline opts program steps diff --git a/grin/grin.cabal b/grin/grin.cabal index cac05918..b2043b07 100644 --- a/grin/grin.cabal +++ b/grin/grin.cabal @@ -57,7 +57,8 @@ library process, text, llvm-hs-pretty, - optparse-applicative + optparse-applicative, + directory default-language: Haskell2010 executable grin @@ -79,6 +80,7 @@ executable grin , microlens-th , microlens-mtl , optparse-applicative + , directory default-language: Haskell2010 test-suite grin-test diff --git a/grin/src/Pipeline.hs b/grin/src/Pipeline.hs index 08a9d734..9886a444 100644 --- a/grin/src/Pipeline.hs +++ b/grin/src/Pipeline.hs @@ -3,7 +3,7 @@ module Pipeline where import Control.Monad import Text.Printf -import Text.PrettyPrint.ANSI.Leijen hiding ((<$>)) +import Text.PrettyPrint.ANSI.Leijen hiding ((<$>), ()) import Eval import Grin @@ -13,17 +13,20 @@ import TrafoPlayground import AbstractRunGrin import qualified CodeGenLLVM as CGLLVM import qualified JITLLVM +import System.Directory import System.Process import Data.Map as Map import LLVM.Pretty (ppllvm) import qualified Data.Text.Lazy.IO as Text +import Control.Monad.Trans.Reader import Control.Monad.Trans.State.Strict import Control.Monad.IO.Class import Lens.Micro.TH import Lens.Micro.Mtl import Data.Set +import System.FilePath type RenameVariablesMap = Map String String @@ -73,8 +76,12 @@ pattern PrintGrin :: (Doc -> Doc) -> Pipeline pattern PrintGrin c <- PrintGrinH (H c) where PrintGrin c = PrintGrinH (H c) +data PipelineOpts = PipelineOpts + { _poOutputDir :: FilePath + } + type TagInfo = Set Tag -type PipelineM a = StateT PState IO a +type PipelineM a = ReaderT PipelineOpts (StateT PState IO) a data PState = PState { _psExp :: Exp , _psTransStep :: Int @@ -83,6 +90,7 @@ data PState = PState } makeLenses ''PState +makeLenses ''PipelineOpts pipelineStep :: Pipeline -> PipelineM () pipelineStep = \case @@ -135,13 +143,19 @@ saveGrin :: FilePath -> PipelineM () saveGrin fn = do n <- use psTransStep e <- use psExp - liftIO . writeFile (concat [fn,".", show n]) . show $ pretty e + outputDir <- view poOutputDir + let fname = (concat [fn,".", show n]) + let content = show $ pretty e + liftIO $ do + createDirectoryIfMissing True outputDir + writeFile (outputDir fname) content saveLLVM :: FilePath -> PipelineM () saveLLVM fname' = do e <- use psExp n <- use psTransStep - let fname = concat [fname',".",show n] + o <- view poOutputDir + let fname = o concat [fname',".",show n] code = CGLLVM.codeGen e llName = printf "%s.ll" fname sName = printf "%s.s" fname @@ -153,9 +167,9 @@ saveLLVM fname' = do callProcess "llc-5.0" [llName] readFile sName >>= putStrLn -pipeline :: Exp -> [Pipeline] -> IO () -pipeline e p = do +pipeline :: PipelineOpts -> Exp -> [Pipeline] -> IO () +pipeline o e p = do print p - flip evalStateT start . sequence_ $ Prelude.map pipelineStep p + flip evalStateT start . flip runReaderT o . sequence_ $ Prelude.map pipelineStep p where start = PState e 0 Nothing Nothing