diff --git a/example/1.hear b/example/1.hear index 98aa9bf..8c60c2a 100644 --- a/example/1.hear +++ b/example/1.hear @@ -5,4 +5,9 @@ printBool(5 * 3 >= 5 + 9); printBool(5*(3-2)+-4-4 < -3); printBool(5 == 5); printBool(5 == 6); -printBool(5 != 5); \ No newline at end of file +printBool(5 != 5); +printBool(true == true); +printBool(true && true); +printBool(true && false); +printBool(!true); +printBool(!(5 == 5)); \ No newline at end of file diff --git a/src/Main.hs b/src/Main.hs index dee11e3..3030c5d 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -22,11 +22,15 @@ run opts = do let fileName = filePath opts contents <- T.readFile fileName T.putStrLn "- Generating LLVM to './a.out.ll'..." - result <- (llvmGen . parse) contents - B.writeFile "a.out.ll" result - T.putStrLn "- Compiling to executable './a.out'..." - callCommand "clang a.out.ll" - T.putStrLn "- Done." + let parseResult = parse contents + case parseResult of + Right r -> do + result <- llvmGen r + B.writeFile "a.out.ll" result + T.putStrLn "- Compiling to executable './a.out'..." + callCommand "clang a.out.ll" + T.putStrLn "- Done." + Left l -> putStrLn l main :: IO () main = execParser opts >>= run diff --git a/src/Main/LLVMGen.hs b/src/Main/LLVMGen.hs index 9a0bbcf..c4f00e2 100644 --- a/src/Main/LLVMGen.hs +++ b/src/Main/LLVMGen.hs @@ -155,6 +155,25 @@ boolExprToLLVM (T.IntEq T.NE a b) = mdo lhs <- intExprToLLVM a rhs <- intExprToLLVM b icmp LLVM.AST.IntegerPredicate.NE lhs rhs +boolExprToLLVM (T.BoolEq T.EQ a b) = mdo + lhs <- boolExprToLLVM a + rhs <- boolExprToLLVM b + icmp LLVM.AST.IntegerPredicate.EQ lhs rhs +boolExprToLLVM (T.BoolEq T.NE a b) = mdo + lhs <- boolExprToLLVM a + rhs <- boolExprToLLVM b + icmp LLVM.AST.IntegerPredicate.NE lhs rhs +boolExprToLLVM (T.BoolLogic T.AND a b) = mdo + lhs <- boolExprToLLVM a + rhs <- boolExprToLLVM b + LLVM.IRBuilder.Instruction.and lhs rhs +boolExprToLLVM (T.BoolLogic T.OR a b) = mdo + lhs <- boolExprToLLVM a + rhs <- boolExprToLLVM b + LLVM.IRBuilder.Instruction.or lhs rhs +boolExprToLLVM (T.BoolNeg a) = mdo + l <- boolExprToLLVM a + LLVM.IRBuilder.Instruction.xor l $ bit 1 llvmGen :: [T.Statement] -> IO ByteString llvmGen expr = do diff --git a/src/Main/Parser/Megaparsec.hs b/src/Main/Parser/Megaparsec.hs index 64f9712..ee82942 100644 --- a/src/Main/Parser/Megaparsec.hs +++ b/src/Main/Parser/Megaparsec.hs @@ -78,6 +78,31 @@ intEqExpr = do c <- intExpr return (a, b, c) +boolExprTable :: [[Operator Parser M.Bool]] +boolExprTable = + [ [ binaryOp "==" (M.BoolEq M.EQ), + binaryOp "!=" (M.BoolEq M.NE) + ], + [prefixOp "!" M.BoolNeg], + [binaryOp "&&" (M.BoolLogic M.AND)], + [binaryOp "||" (M.BoolLogic M.OR)] + ] + +-- boolEqExpr :: ParsecT Void Text Data.Functor.Identity.Identity (M.EqOp, M.Bool, M.Bool) +-- boolEqExpr = do +-- b <- +-- choice +-- [ + +-- ] +-- a <- +-- choice +-- [ M.EQ <$ string "==" <* C.space, +-- M.NE <$ string "!=" <* C.space +-- ] +-- c <- intExpr +-- return (a, b, c) + uncurry3 :: (a -> b -> c -> d) -> (a, b, c) -> d uncurry3 f (x, y, z) = f x y z @@ -86,27 +111,35 @@ boolExprTerm = choice [ try (uncurry3 M.IntOrdCmp <$> intOrdCmpExpr), uncurry3 M.IntEq <$> intEqExpr, - M.Bool True <$ string "true", - M.Bool False <$ string "false", - parens boolExprTerm + M.Bool True <$ string "true" <* C.space, + M.Bool False <$ string "false" <* C.space, + parens boolExpr ] -binaryOp name f = InfixL $ f <$ symbol name +boolExpr :: ParsecT Void Text Data.Functor.Identity.Identity M.Bool +boolExpr = makeExprParser boolExprTerm boolExprTable + +binaryOp :: Text -> (a -> a -> a) -> Operator (ParsecT Void Text Data.Functor.Identity.Identity) a +binaryOp name f = InfixL $ f <$ string name <* C.space + +prefixOp :: Text -> (a -> a) -> Operator (ParsecT Void Text Data.Functor.Identity.Identity) a +prefixOp name f = Prefix $ f <$ symbol name statement :: Parser M.Statement statement = choice [ string "printInt" *> (M.PrintInt <$> parens intExpr), - string "printBool" *> (M.PrintBool <$> parens boolExprTerm) + string "printBool" *> (M.PrintBool <$> parens boolExpr) ] <* symbol ";" parseStatements :: Text -> Either (ParseErrorBundle Text Void) [M.Statement] parseStatements = MP.parse (C.space *> many statement <* eof) "" -parse :: Text -> [M.Statement] +parse :: Text -> Either String [M.Statement] parse t = case parseStatements t of - Right r -> r + Right r -> Right r + Left e -> Left (errorBundlePretty e) -- TODO: add error handling \ No newline at end of file diff --git a/src/Main/Types.hs b/src/Main/Types.hs index aa504a8..3061817 100644 --- a/src/Main/Types.hs +++ b/src/Main/Types.hs @@ -2,6 +2,7 @@ module Main.Types ( ArithOp (..), EqOp (..), OrdCmpOp (..), + LogicOp (..), -- BinExpr (..), Int (..), Bool (..), @@ -17,6 +18,8 @@ data EqOp = EQ | NE deriving (P.Show) data OrdCmpOp = GT | GTE | LT | LTE deriving (P.Show) +data LogicOp = AND | OR deriving (P.Show) + -- newtype BinExpr op i o = BinExpr (op -> i -> i -> o) data Int @@ -26,9 +29,11 @@ data Int data Bool = Bool P.Bool + | BoolNeg Bool | IntEq EqOp Int Int -- (BinExpr EqOp Int Bool) | IntOrdCmp OrdCmpOp Int Int -- (BinExpr OrdCmpOp Int Bool) | BoolEq EqOp Bool Bool -- (BinExpr EqOp Bool Bool) + | BoolLogic LogicOp Bool Bool deriving (P.Show) data Statement