From d8a75d66437510c110c502428d7fdfbfeb929eb9 Mon Sep 17 00:00:00 2001 From: Samuel Hammersberg Date: Tue, 28 Mar 2023 17:49:47 +0200 Subject: [PATCH] =?UTF-8?q?Solved=2030+=20WARNINGS!!=20=F0=9F=98=8E?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- src/Codegen/Codegen.hs | 39 ++++++++++----------------------------- src/Compiler.hs | 29 +++++++++++++++-------------- 2 files changed, 25 insertions(+), 43 deletions(-) diff --git a/src/Codegen/Codegen.hs b/src/Codegen/Codegen.hs index ffe1f91..9827571 100644 --- a/src/Codegen/Codegen.hs +++ b/src/Codegen/Codegen.hs @@ -312,13 +312,13 @@ defaultStart = ] compileExp :: ExpT -> CompilerState () -compileExp (MIR.ELit lit, t) = emitLit lit +compileExp (MIR.ELit lit, _t) = emitLit lit compileExp (MIR.EAdd e1 e2, t) = emitAdd t e1 e2 -- compileExp (ESub t e1 e2) = emitSub t e1 e2 -compileExp (MIR.EVar name, t) = emitIdent name +compileExp (MIR.EVar name, _t) = emitIdent name compileExp (MIR.EApp e1 e2, t) = emitApp t e1 e2 -- compileExp (EAbs t ti e) = emitAbs t ti e -compileExp (MIR.ELet binds e, t) = undefined -- emitLet binds (fst e) +compileExp (MIR.ELet _binds _e, _t) = undefined -- emitLet binds (fst e) compileExp (MIR.ECase e cs, t) = emitECased t e (map (t,) cs) -- go (EMul e1 e2) = emitMul e1 e2 @@ -348,7 +348,7 @@ emitECased t e cases = do emit $ SetVariable res (Load ty Ptr stackPtr) where emitCases :: LLVMType -> LLVMType -> TIR.Ident -> TIR.Ident -> LLVMValue -> Branch -> CompilerState () - emitCases rt ty label stackPtr vs (Branch (MIR.PInj consId cs, t) exp) = do + emitCases rt ty label stackPtr vs (Branch (MIR.PInj consId cs, _t) exp) = do emit $ Comment "Inj" cons <- gets constructors let r = fromJust $ Map.lookup consId cons @@ -376,10 +376,10 @@ emitECased t e cases = do PVar x -> do emit . Comment $ "ident " <> show x emit $ SetVariable (fst x) (ExtractValue (CustomType (coerce consId)) (VIdent casted Ptr) i) - PLit (l, t) -> undefined - PInj id ps -> undefined + PLit (_l, _t) -> undefined + PInj _id _ps -> undefined PCatch -> pure () - PEnum id -> undefined + PEnum _id -> undefined -- case c of -- CIdent x -> do -- emit . Comment $ "ident " <> show x @@ -398,7 +398,7 @@ emitECased t e cases = do emit $ Store ty val Ptr stackPtr emit $ Br label emit $ Label lbl_failPos - emitCases rt ty label stackPtr vs (Branch (MIR.PLit i, _) exp) = do + emitCases _rt ty label stackPtr vs (Branch (MIR.PLit i, _) exp) = do emit $ Comment "Plit" let i' = case i of (MIR.LInt i, _) -> VInteger i @@ -425,7 +425,7 @@ emitECased t e cases = do emit $ Br label lbl_failPos <- (\x -> TIR.Ident $ "failed_" <> show x) <$> getNewLabel emit $ Label lbl_failPos - emitCases rt ty label stackPtr vs (Branch (MIR.PEnum id, _) exp) = do + emitCases _rt ty label stackPtr _vs (Branch (MIR.PEnum _id, _) exp) = do emit $ Comment "Penum" val <- exprToValue exp emit $ Store ty val Ptr stackPtr @@ -440,18 +440,6 @@ emitECased t e cases = do lbl_failPos <- (\x -> TIR.Ident $ "failed_" <> show x) <$> getNewLabel emit $ Label lbl_failPos --- emitLet :: Bind -> Exp -> CompilerState () -emitLet xs e = do - emit $ - Comment $ - concat - [ "ELet (" - , show xs - , " = " - , show e - , ") is not implemented!" - ] - emitApp :: MIR.Type -> ExpT -> ExpT -> CompilerState () emitApp rt e1 e2 = appEmitter e1 e2 [] where @@ -500,16 +488,9 @@ emitAdd t e1 e2 = do v <- getNewVar emit $ SetVariable v (Add (type2LlvmType t) v1 v2) -emitSub :: MIR.Type -> ExpT -> ExpT -> CompilerState () -emitSub t e1 e2 = do - v1 <- exprToValue e1 - v2 <- exprToValue e2 - v <- getNewVar - emit $ SetVariable v (Sub (type2LlvmType t) v1 v2) - exprToValue :: ExpT -> CompilerState LLVMValue exprToValue = \case - (MIR.ELit i, t) -> pure $ case i of + (MIR.ELit i, _t) -> pure $ case i of (MIR.LInt i) -> VInteger i (MIR.LChar i) -> VChar $ ord i (MIR.EVar name, t) -> do diff --git a/src/Compiler.hs b/src/Compiler.hs index a10a642..0b34936 100644 --- a/src/Compiler.hs +++ b/src/Compiler.hs @@ -1,25 +1,26 @@ module Compiler (compile) 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) +import System.Process.Extra ( + readCreateProcess, + shell, + ) ---spawnWait s = spawnCommand s >>= \s >>= waitForProcess +-- spawnWait s = spawnCommand s >>= \s >>= waitForProcess optimize :: String -> IO String optimize = readCreateProcess (shell "opt --O3 -S") compileClang :: String -> IO String -compileClang = readCreateProcess . shell - $ unwords ["clang++"--, "-Lsrc/GC/lib/", "-l:libgcoll.a" - , "-fno-exceptions -x", "ir" ,"-o" ,"output/hello_world" - , "-"] +compileClang = + readCreateProcess . shell $ + unwords + [ "clang++" -- , "-Lsrc/GC/lib/", "-l:libgcoll.a" + , "-fno-exceptions -x" + , "ir" + , "-o" + , "output/hello_world" + , "-" + ] compile :: String -> IO String compile s = optimize s >>= compileClang