Solved 30+ WARNINGS!! 😎

This commit is contained in:
Samuel Hammersberg 2023-03-28 17:49:47 +02:00
parent c77139dfa8
commit d8a75d6643
2 changed files with 25 additions and 43 deletions

View file

@ -312,13 +312,13 @@ defaultStart =
] ]
compileExp :: ExpT -> CompilerState () 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 (MIR.EAdd e1 e2, t) = emitAdd t e1 e2
-- compileExp (ESub t e1 e2) = emitSub 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 (MIR.EApp e1 e2, t) = emitApp t e1 e2
-- compileExp (EAbs t ti e) = emitAbs t ti e -- 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) compileExp (MIR.ECase e cs, t) = emitECased t e (map (t,) cs)
-- go (EMul e1 e2) = emitMul e1 e2 -- go (EMul e1 e2) = emitMul e1 e2
@ -348,7 +348,7 @@ emitECased t e cases = do
emit $ SetVariable res (Load ty Ptr stackPtr) emit $ SetVariable res (Load ty Ptr stackPtr)
where where
emitCases :: LLVMType -> LLVMType -> TIR.Ident -> TIR.Ident -> LLVMValue -> Branch -> CompilerState () 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" emit $ Comment "Inj"
cons <- gets constructors cons <- gets constructors
let r = fromJust $ Map.lookup consId cons let r = fromJust $ Map.lookup consId cons
@ -376,10 +376,10 @@ emitECased t e cases = do
PVar x -> do PVar x -> do
emit . Comment $ "ident " <> show x emit . Comment $ "ident " <> show x
emit $ SetVariable (fst x) (ExtractValue (CustomType (coerce consId)) (VIdent casted Ptr) i) emit $ SetVariable (fst x) (ExtractValue (CustomType (coerce consId)) (VIdent casted Ptr) i)
PLit (l, t) -> undefined PLit (_l, _t) -> undefined
PInj id ps -> undefined PInj _id _ps -> undefined
PCatch -> pure () PCatch -> pure ()
PEnum id -> undefined PEnum _id -> undefined
-- case c of -- case c of
-- CIdent x -> do -- CIdent x -> do
-- emit . Comment $ "ident " <> show x -- emit . Comment $ "ident " <> show x
@ -398,7 +398,7 @@ emitECased t e cases = do
emit $ Store ty val Ptr stackPtr emit $ Store ty val Ptr stackPtr
emit $ Br label emit $ Br label
emit $ Label lbl_failPos 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" emit $ Comment "Plit"
let i' = case i of let i' = case i of
(MIR.LInt i, _) -> VInteger i (MIR.LInt i, _) -> VInteger i
@ -425,7 +425,7 @@ emitECased t e cases = do
emit $ Br label emit $ Br label
lbl_failPos <- (\x -> TIR.Ident $ "failed_" <> show x) <$> getNewLabel lbl_failPos <- (\x -> TIR.Ident $ "failed_" <> show x) <$> getNewLabel
emit $ Label lbl_failPos 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" emit $ Comment "Penum"
val <- exprToValue exp val <- exprToValue exp
emit $ Store ty val Ptr stackPtr emit $ Store ty val Ptr stackPtr
@ -440,18 +440,6 @@ emitECased t e cases = do
lbl_failPos <- (\x -> TIR.Ident $ "failed_" <> show x) <$> getNewLabel lbl_failPos <- (\x -> TIR.Ident $ "failed_" <> show x) <$> getNewLabel
emit $ Label lbl_failPos 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 :: MIR.Type -> ExpT -> ExpT -> CompilerState ()
emitApp rt e1 e2 = appEmitter e1 e2 [] emitApp rt e1 e2 = appEmitter e1 e2 []
where where
@ -500,16 +488,9 @@ emitAdd t e1 e2 = do
v <- getNewVar v <- getNewVar
emit $ SetVariable v (Add (type2LlvmType t) v1 v2) 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 :: ExpT -> CompilerState LLVMValue
exprToValue = \case exprToValue = \case
(MIR.ELit i, t) -> pure $ case i of (MIR.ELit i, _t) -> pure $ case i of
(MIR.LInt i) -> VInteger i (MIR.LInt i) -> VInteger i
(MIR.LChar i) -> VChar $ ord i (MIR.LChar i) -> VChar $ ord i
(MIR.EVar name, t) -> do (MIR.EVar name, t) -> do

View file

@ -1,25 +1,26 @@
module Compiler (compile) where module Compiler (compile) where
import Grammar.ErrM (Err) import System.Process.Extra (
import System.Exit (exitFailure, exitSuccess) readCreateProcess,
import System.IO (BufferMode (NoBuffering), hClose, hFlush, shell,
hGetContents, hPutStr, hPutStrLn, )
hSetBuffering, stderr)
import System.Process.Extra (CreateProcess (..),
StdStream (CreatePipe), createProcess,
proc, readCreateProcess, shell,
spawnCommand, waitForProcess)
--spawnWait s = spawnCommand s >>= \s >>= waitForProcess -- spawnWait s = spawnCommand s >>= \s >>= waitForProcess
optimize :: String -> IO String optimize :: String -> IO String
optimize = readCreateProcess (shell "opt --O3 -S") optimize = readCreateProcess (shell "opt --O3 -S")
compileClang :: String -> IO String compileClang :: String -> IO String
compileClang = readCreateProcess . shell compileClang =
$ unwords ["clang++"--, "-Lsrc/GC/lib/", "-l:libgcoll.a" readCreateProcess . shell $
, "-fno-exceptions -x", "ir" ,"-o" ,"output/hello_world" unwords
, "-"] [ "clang++" -- , "-Lsrc/GC/lib/", "-l:libgcoll.a"
, "-fno-exceptions -x"
, "ir"
, "-o"
, "output/hello_world"
, "-"
]
compile :: String -> IO String compile :: String -> IO String
compile s = optimize s >>= compileClang compile s = optimize s >>= compileClang