temp merge

This commit is contained in:
Samuel Hammersberg 2023-03-24 18:22:37 +01:00
parent 56ccd793ac
commit 23c174607b
3 changed files with 57 additions and 27 deletions

View file

@ -69,6 +69,7 @@ Test-suite language-testsuite
TypeChecker.TypeChecker TypeChecker.TypeChecker
TypeChecker.TypeCheckerIr TypeChecker.TypeCheckerIr
Renamer.Renamer Renamer.Renamer
Compiler
hs-source-dirs: src, tests hs-source-dirs: src, tests
@ -81,5 +82,6 @@ Test-suite language-testsuite
, array , array
, hspec , hspec
, QuickCheck , QuickCheck
, process
default-language: GHC2021 default-language: GHC2021

27
src/Compiler.hs Normal file
View file

@ -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 ""

View file

@ -2,30 +2,28 @@
module Main where module Main where
import Codegen.Codegen (generateCode) import Codegen.Codegen (generateCode)
import GHC.IO.Handle.Text (hPutStrLn) import GHC.IO.Handle.Text (hPutStrLn)
import Grammar.ErrM (Err) import Grammar.ErrM (Err)
import Grammar.Par (myLexer, pProgram) import Grammar.Par (myLexer, pProgram)
import Grammar.Print (printTree) import Grammar.Print (printTree)
import Monomorphizer.Monomorphizer (monomorphize) import Monomorphizer.Monomorphizer (monomorphize)
import Control.Monad (when) import Control.Monad (when)
import Data.List.Extra (isSuffixOf) import Data.List.Extra (isSuffixOf)
import Renamer.Renamer (rename) import Compiler (optimize)
import System.Directory ( import Renamer.Renamer (rename)
createDirectory, import System.Directory (createDirectory, doesPathExist,
doesPathExist, getDirectoryContents,
getDirectoryContents, removeDirectoryRecursive,
removeDirectoryRecursive, setCurrentDirectory)
setCurrentDirectory, import System.Environment (getArgs)
) import System.Exit (exitFailure, exitSuccess)
import System.Environment (getArgs) import System.IO (stderr)
import System.Exit (exitFailure, exitSuccess) import System.Process.Extra (spawnCommand, waitForProcess)
import System.IO (stderr) import TypeChecker.TypeChecker (typecheck)
import System.Process.Extra (spawnCommand, waitForProcess)
import TypeChecker.TypeChecker (typecheck)
main :: IO () main :: IO ()
main = main =
@ -50,19 +48,22 @@ main' debug s = do
typechecked <- fromTypeCheckerErr $ typecheck renamed typechecked <- fromTypeCheckerErr $ typecheck renamed
printToErr $ printTree typechecked printToErr $ printTree typechecked
printToErr "\n-- Lambda Lifter --" -- printToErr "\n-- Lambda Lifter --"
-- let lifted = lambdaLift typechecked -- let lifted = lambdaLift typechecked
-- printToErr $ printTree lifted -- printToErr $ printTree lifted
-- --
printToErr "\n -- Printing compiler output to stdout --" printToErr "\n -- Compiler --"
compiled <- fromCompilerErr $ generateCode (monomorphize typechecked) generatedCode <- fromCompilerErr $ generateCode (monomorphize typechecked)
putStrLn compiled --putStrLn generatedCode
check <- doesPathExist "output" check <- doesPathExist "output"
when check (removeDirectoryRecursive "output") when check (removeDirectoryRecursive "output")
createDirectory "output" createDirectory "output"
writeFile "output/llvm.ll" compiled when debug $ do
-- if debug then debugDotViz else putStrLn compiled writeFile "output/llvm.ll" generatedCode
debugDotViz
optimize generatedCode
-- interpred <- fromInterpreterErr $ interpret lifted -- interpred <- fromInterpreterErr $ interpret lifted
-- putStrLn "\n-- interpret" -- putStrLn "\n-- interpret"