diff --git a/language.cabal b/language.cabal index a098bd7..bfdaa0f 100644 --- a/language.cabal +++ b/language.cabal @@ -69,6 +69,7 @@ Test-suite language-testsuite TypeChecker.TypeChecker TypeChecker.TypeCheckerIr Renamer.Renamer + Compiler hs-source-dirs: src, tests @@ -81,5 +82,6 @@ Test-suite language-testsuite , array , hspec , QuickCheck + , process default-language: GHC2021 diff --git a/src/Compiler.hs b/src/Compiler.hs new file mode 100644 index 0000000..76a3a1d --- /dev/null +++ b/src/Compiler.hs @@ -0,0 +1,27 @@ +module Compiler where + +import Grammar.ErrM (Err) +import System.Exit (exitFailure, exitSuccess) +import System.IO (BufferMode (NoBuffering), hClose, hFlush, + hGetContents, hPutStr, hPutStrLn, + hSetBuffering, stderr) +import System.Process.Extra (CreateProcess (..), + StdStream (CreatePipe), createProcess, + proc, readCreateProcess, shell, + spawnCommand, waitForProcess) + +--spawnWait s = spawnCommand s >>= \s >>= waitForProcess + +optimize :: String -> IO String +optimize prg = do + result <- readCreateProcess (shell "opt --O3") prg + putStrLn result + + + -- (Just hin, Just hout, _, _) <- createProcess (proc "opt" ["--O3"]){ std_in = CreatePipe, std_out = CreatePipe } + -- hSetBuffering hin NoBuffering + -- hPutStrLn hin prg + -- hFlush hin + --bytes <- hGetContents hout + --putStrLn bytes + pure "" diff --git a/src/Main.hs b/src/Main.hs index d0f544c..ba5b387 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -2,30 +2,28 @@ module Main where -import Codegen.Codegen (generateCode) -import GHC.IO.Handle.Text (hPutStrLn) -import Grammar.ErrM (Err) -import Grammar.Par (myLexer, pProgram) -import Grammar.Print (printTree) +import Codegen.Codegen (generateCode) +import GHC.IO.Handle.Text (hPutStrLn) +import Grammar.ErrM (Err) +import Grammar.Par (myLexer, pProgram) +import Grammar.Print (printTree) -import Monomorphizer.Monomorphizer (monomorphize) +import Monomorphizer.Monomorphizer (monomorphize) -import Control.Monad (when) -import Data.List.Extra (isSuffixOf) +import Control.Monad (when) +import Data.List.Extra (isSuffixOf) -import Renamer.Renamer (rename) -import System.Directory ( - createDirectory, - doesPathExist, - getDirectoryContents, - removeDirectoryRecursive, - setCurrentDirectory, - ) -import System.Environment (getArgs) -import System.Exit (exitFailure, exitSuccess) -import System.IO (stderr) -import System.Process.Extra (spawnCommand, waitForProcess) -import TypeChecker.TypeChecker (typecheck) +import Compiler (optimize) +import Renamer.Renamer (rename) +import System.Directory (createDirectory, doesPathExist, + getDirectoryContents, + removeDirectoryRecursive, + setCurrentDirectory) +import System.Environment (getArgs) +import System.Exit (exitFailure, exitSuccess) +import System.IO (stderr) +import System.Process.Extra (spawnCommand, waitForProcess) +import TypeChecker.TypeChecker (typecheck) main :: IO () main = @@ -50,19 +48,22 @@ main' debug s = do typechecked <- fromTypeCheckerErr $ typecheck renamed printToErr $ printTree typechecked - printToErr "\n-- Lambda Lifter --" + -- printToErr "\n-- Lambda Lifter --" -- let lifted = lambdaLift typechecked -- printToErr $ printTree lifted -- - printToErr "\n -- Printing compiler output to stdout --" - compiled <- fromCompilerErr $ generateCode (monomorphize typechecked) - putStrLn compiled + printToErr "\n -- Compiler --" + generatedCode <- fromCompilerErr $ generateCode (monomorphize typechecked) + --putStrLn generatedCode check <- doesPathExist "output" when check (removeDirectoryRecursive "output") createDirectory "output" - writeFile "output/llvm.ll" compiled - -- if debug then debugDotViz else putStrLn compiled + when debug $ do + writeFile "output/llvm.ll" generatedCode + debugDotViz + + optimize generatedCode -- interpred <- fromInterpreterErr $ interpret lifted -- putStrLn "\n-- interpret"