From 76106309aadc3382cd1114a9bfe22ab104209620 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Timoth=C3=A9?= Date: Mon, 8 Jan 2024 10:20:38 +0100 Subject: [PATCH 01/11] feature(tokenization): add tokenization + handling interpretation and compilation --- LobsterLang/app/Main.hs | 30 +++--- LobsterLang/src/Parse.hs | 73 +++++++++++-- LobsterLang/src/Token.hs | 8 ++ LobsterLang/test/ParseSpec.hs | 196 +++++++++++++++++----------------- 4 files changed, 182 insertions(+), 125 deletions(-) create mode 100644 LobsterLang/src/Token.hs diff --git a/LobsterLang/app/Main.hs b/LobsterLang/app/Main.hs index 0113768..eb98a59 100644 --- a/LobsterLang/app/Main.hs +++ b/LobsterLang/app/Main.hs @@ -20,39 +20,37 @@ inputLoop :: [Scope.ScopeMb] -> IO () -- inputLoop = print inputLoop stack = isEOF >>= \end -> if end then print "End of Interpretation GLaDOS" else getLine >>= \line -> case runParser parseLisp (0, 0) line of - Left err -> print err >> exitWith (ExitFailure 84) + Left err -> putStrLn ("\ESC[34m\ESC[1mThe lobster is angry: " ++ err ++ "\ESC[0m") >> inputLoop stack Right (res, _, _) -> interpretateInfo res stack interpretateInfo :: [SExpr] -> [Scope.ScopeMb] -> IO () -interpretateInfo [] _ = putStr "" +interpretateInfo [] stack = inputLoop stack interpretateInfo (x:xs) stack = case interpretateLisp x stack of - Left err -> print err + Left err -> putStrLn ("\ESC[31m\ESC[1mThe lobster is angry: " ++ err ++ "\ESC[0m") >> inputLoop stack Right (res, stack') -> case res of Nothing -> interpretateInfo xs stack' - Just value -> print value >> print stack' >> interpretateInfo xs stack' + Just value -> print value >> interpretateInfo xs stack' + +compileInfo :: [SExpr] -> [Scope.ScopeMb] -> IO () +compileInfo [] _ = putStr "" +compileInfo (x:xs) stack = case interpretateLisp x stack of + Left err -> putStrLn ("\ESC[31m\ESC[1mThe lobster is angry: " ++ err ++ "\ESC[0m") >> exitWith (ExitFailure 84) + Right (res, stack') -> case res of + Nothing -> compileInfo xs stack' + Just value -> print value >> compileInfo xs stack' compileFile :: String -> IO () compileFile s = case runParser parseLisp (0, 0) s of Left err -> print err >> exitWith (ExitFailure 84) - Right (res, _, _) -> interpretateInfo res [] + Right (res, _, _) -> compileInfo res [] checkArgs :: [String] -> IO () -checkArgs ("-i": _) = print "Launch Interpreter" >> inputLoop [] +checkArgs [] = print "Launch Interpreter" >> inputLoop [] checkArgs (file:_) = either (\_ -> print "File doesn't exist" >> exitWith (ExitFailure 84)) compileFile =<< (try (readFile file) :: IO (Either SomeException String)) -checkArgs _ = exitWith (ExitFailure 84) -- | Main main :: IO () main = getArgs >>= \argv -> checkArgs argv --- inputLoop new = isEOF >>= \end -> if end then putStrLn "End of Interpretation GLaDOS" else --- getLine >>= \line -> case parseLisp line new of --- (Left err, _) -> putStrLn ("\ESC[31m\ESC[1mThe lobster is angry: " ++ err ++ "\ESC[0m") >> inputLoop new --- (Right Nothing, stack) -> inputLoop stack --- (Right (Just res), stack') -> print res >> inputLoop stack' - --- -- | Main --- main :: IO () --- main = putStrLn "Start of Interpretation Lisp" >> inputLoop [] diff --git a/LobsterLang/src/Parse.hs b/LobsterLang/src/Parse.hs index 83ebe38..74f2847 100644 --- a/LobsterLang/src/Parse.hs +++ b/LobsterLang/src/Parse.hs @@ -31,6 +31,9 @@ module Parse ( parseSpace, parseLine, interpretateLisp, + + + parseToken, -- parseTuple, ) where @@ -40,10 +43,7 @@ import Control.Applicative (Alternative (..)) import qualified AstEval import qualified AST import qualified Scope -import GHC.IO.SubSystem (IoSubSystem(IoPOSIX)) -type Col = Int -type Row = Int type Position = (Int, Int) data Parser a = Parser { @@ -52,6 +52,12 @@ data Parser a = Parser { } +data Token = Number Int + | Sym String + | Identifier String + deriving(Show, Eq) + + -- | Instance Functor of the data Parser instance Functor Parser where fmap fct parser = @@ -64,7 +70,7 @@ instance Functor Parser where -- | Instance Applicative of the data Parser instance Applicative Parser where - -- pure result = Parser (\_ -> Left (result, "",)) + pure result = Parser (\pos s -> Right (result, s, pos)) (<*>) parserA parserB = Parser @@ -174,10 +180,7 @@ parseSign = parseChar '-' <|> parseChar '+' -- | Return a data Parser that parse a digit parseDigit :: Parser Char -parseDigit = parseChar '0' <|> parseChar '1' <|> parseChar '2' <|> - parseChar '3' <|> parseChar '4' <|> parseChar '5' <|> - parseChar '6' <|> parseChar '7' <|> parseChar '8' <|> - parseChar '9' +parseDigit = parseAnyChar ['0'..'9'] -- | Return a data Parser that parse a Int parseInt :: Parser Int @@ -189,11 +192,14 @@ parseInt = Parser f -- | Return a data Parser that parse multiple space parseSpace :: Parser [Char] -parseSpace = parseMany (parseChar ' ') +parseSpace = parseMany (parseChar ' ' <|> parseChar '\n') parseLine :: Parser [Char] parseLine = parseMany (parseChar '\n') +parseWhiteSpace :: Parser [Char] +parseWhiteSpace = parseSpace <|> parseLine + -- | Parse with a parser and, if possible with a space -- Return a Parser that parse element with the given parser and, if possible with multiple space parseElem :: Parser a -> Parser a @@ -216,7 +222,7 @@ parseValue = Value <$> parseElem parseInt parseList :: Parser a -> Parser [a] parseList parser = parseStart *> parseListValue <* parseEnd where - parseEnd = parseChar ')' <* parseSpace <* parseLine + parseEnd = parseChar ')' <* parseSpace parseListValue = parseSpace *> parseMany (parseElem parser) <* parseSpace parseStart = parseSpace *> parseChar '(' @@ -268,6 +274,48 @@ parseFalse = Parser f Left err -> Left err Right (_, s', pos') -> Right (False, s', pos') +parseSymbolToken :: Parser Token +parseSymbolToken = Sym <$> ( + parseAnyString "==" <|> + parseAnyString "<=" <|> + parseAnyString ">=" <|> + parseAnyString "=" <|> + parseAnyString "<" <|> + parseAnyString ">" <|> + parseAnyString "!=" <|> + parseAnyString "->" <|> + parseAnyString ":" <|> + parseAnyString "+" <|> + parseAnyString "-" <|> + parseAnyString "*" <|> + parseAnyString "/" <|> + parseAnyString "%" <|> + parseAnyString "{" <|> + parseAnyString "}" <|> + parseAnyString "(|" <|> + parseAnyString "|)" <|> + parseAnyString "if" <|> + parseAnyString "else" <|> + parseAnyString "fn" + ) + + -- where + -- parseCall = + -- parseFuncArg = parseName *> parseList parseString + -- parseName = parseString + +parseIdentifierToken :: Parser Token +parseIdentifierToken = Identifier <$> parseSome (parseAnyChar (['a'..'z'] ++ ['A'..'Z'])) + +parseNumberToken :: Parser Token +parseNumberToken = Number <$> parseInt + +parseToken :: Parser [Token] +parseToken = parseSome (parseWhiteSpace *> parseElem parseSymbolToken <|> + parseWhiteSpace *> parseElem parseIdentifierToken <|> + parseWhiteSpace *> parseElem parseNumberToken) + <|> parseWhiteSpace *> parseElem parseToken + -- | Return a Parser that parse a SExpr parseSExpr :: Parser SExpr parseSExpr = @@ -275,8 +323,11 @@ parseSExpr = parseSpace *> parseValue <|> List <$> parseList (parseSpace *> parseValue <|> parseSpace *> parseSymbol <|> parseSpace *> parseSExpr) <* parseSpace +-- tokenization :: Parser [Token] +-- tokenization = + parseLisp :: Parser [SExpr] -parseLisp = parseSome parseSExpr +parseLisp = parseSome parseSExpr <* parseSpace -- | Return a Result that contain the evaluation of our Lisp String -- Takes as parameter the string that need to be evaluated and the Stack (Environment) diff --git a/LobsterLang/src/Token.hs b/LobsterLang/src/Token.hs new file mode 100644 index 0000000..c06dde7 --- /dev/null +++ b/LobsterLang/src/Token.hs @@ -0,0 +1,8 @@ +{- +-- EPITECH PROJECT, 2024 +-- Token.hs +-- File description: +-- Token +-} + + diff --git a/LobsterLang/test/ParseSpec.hs b/LobsterLang/test/ParseSpec.hs index 904daaa..b7a8c7a 100644 --- a/LobsterLang/test/ParseSpec.hs +++ b/LobsterLang/test/ParseSpec.hs @@ -14,104 +14,104 @@ import qualified AST import Data.Bool (Bool(True, False)) spec :: Spec -spec = do - describe "ParseTest" $ do - it "Check parseChar Success" $ do - runParser (parseChar ' ') " Hello" `shouldBe` Just (' ', "Hello") - it "Check parseChar Failure" $ do - runParser (parseChar ' ') "Hello" `shouldBe` Nothing - it "Check parseOr Success first arg" $ do - runParser (parseOr (parseChar 'a') (parseChar ' ')) "aHello" `shouldBe` Just ('a', "Hello") - it "Check parseOr Success second arg" $ do - runParser (parseOr (parseChar 'a') (parseChar ' ')) " Hello" `shouldBe` Just (' ', "Hello") - it "Check parseOr Failure" $ do - runParser (parseOr (parseChar 'f') (parseChar 'O')) " Oui" `shouldBe` Nothing - it "Check parseAnd Success" $ do - runParser (parseAnd (parseChar 'a') (parseChar 'p')) "apHello" `shouldBe` Just (('a', 'p'), "Hello") - it "Check parseAnd Failure" $ do - runParser (parseAnd (parseChar 'e') (parseChar 'p')) "apHello" `shouldBe` Nothing - it "Check parseAndWith Number Success" $ do - runParser (parseAndWith (\x y -> [x, y]) (parseAnyChar ['0'..'9']) (parseAnyChar ['0'..'9'])) "42Hello" `shouldBe` Just ("42", "Hello") - it "Check parseAndWith Character Success" $ do - runParser (parseAndWith (\x y -> [x, y]) (parseAnyChar ['a'..'z']) (parseAnyChar ['a'..'z'])) "ohHello" `shouldBe` Just ("oh", "Hello") - it "Check parseAndWith Failure" $ do - runParser (parseAndWith (\x y -> [x, y]) (parseAnyChar ['a'..'z']) (parseAnyChar ['0'..'9'])) "42Hello" `shouldBe` Nothing - it "Check parseMany Character Success" $ do - runParser (parseMany (parseAnyChar ['a'..'z'])) "bonjournoHello" `shouldBe` Just ("bonjourno", "Hello") - it "Check parseMany Number Success" $ do - runParser (parseMany (parseAnyChar ['0'..'9'])) "424554Hello" `shouldBe` Just ("424554", "Hello") - it "Check parseMany Failure" $ do - runParser (parseMany (parseAnyChar ['0'..'9'])) "Hello" `shouldBe` Just ("", "Hello") - it "Check parseSome Number Success" $ do - runParser (parseSome (parseAnyChar ['0'..'9'])) "042Hello" `shouldBe` Just ("042", "Hello") - it "Check parseSome Character Success" $ do - runParser (parseSome (parseAnyChar ['a'..'z'])) "buenos42Hello" `shouldBe` Just ("buenos", "42Hello") - it "Check parseSome Failure" $ do - runParser (parseSome (parseAnyChar ['0'..'9'])) "HelloWorld" `shouldBe` Nothing - it "Check parseUInt Success" $ do - runParser parseUInt "5463Hello" `shouldBe` Just (5463, "Hello") - it "Check parseUInt Failure" $ do - runParser parseUInt "Hola" `shouldBe` Nothing - it "Check parseUInt Empty" $ do - runParser parseUInt "" `shouldBe` Nothing - it "Check parseUInt Negative value Failure" $ do - runParser parseUInt "-42Hello" `shouldBe` Nothing - it "Check parseInt Success" $ do - runParser parseInt "4234Hello" `shouldBe` Just (4234, "Hello") - it "Check parseInt Negative value Success" $ do - runParser parseInt "-42Hello" `shouldBe` Just (-42, "Hello") - it "Check parseInt Failure" $ do - runParser parseInt "Hello" `shouldBe` Nothing - it "Check parsesign '-' Success" $ do - runParser parseSign "-llg" `shouldBe` Just ('-', "llg") - it "Check parsesign '+' Success" $ do - runParser parseSign "+llg" `shouldBe` Just ('+', "llg") - it "Check parsesign Failure" $ do - runParser parseSign "lg" `shouldBe` Nothing - it "Check parseString Success n°1" $ do - runParser parseString "bonjourno " `shouldBe` Just ("bonjourno", "") - it "Check parseString Success n°2" $ do - runParser parseString "bon12*/p journo " `shouldBe` Just ("bon", "12*/p journo ") - it "Check parseString Failure" $ do - runParser parseString "^bon12*/p journo " `shouldBe` Nothing - it "Check parseElem with parseInt Success" $ do - runParser (parseElem parseInt) "12 " `shouldBe` Just (12, "") - it "Check parseElem with parseString Success" $ do - runParser (parseElem parseString) "hello la " `shouldBe` Just ("hello", "la ") - it "Check parseElem with parseSymbol Success" $ do - runParser (parseElem parseSymbol) "hello la " `shouldBe` Just (SExpr.Symbol "hello", "la ") - it "Check parseValue Success" $ do - runParser parseValue "432 la " `shouldBe` Just (SExpr.Value 432, "la ") - it "Check parseSymbol Success" $ do - runParser parseSymbol "symbol la " `shouldBe` Just (SExpr.Symbol "symbol", "la ") - it "Check parseList with parseInt Success" $ do - runParser (parseList parseInt) "(1 2 3 4 5) " `shouldBe` Just ([1, 2 ,3 , 4, 5], "") - it "Check parseList with parseInt Failure (without a number inside)" $ do - runParser (parseList parseInt) "(1 2 3 d 4 5) " `shouldBe` Nothing - it "Check parseList with parseInt Failure (without a ending ')')" $ do - runParser (parseList parseInt) "(1 2 3 4 5 " `shouldBe` Nothing - it "Check parseList with parseInt Failure (without a starting '(')" $ do - runParser (parseList parseInt) "1 2 3 4 5)" `shouldBe` Nothing - it "Check parseList with parseString Success" $ do - runParser (parseList parseString) "(buenos owow k ye )1 2 3 4 5)" `shouldBe` Just (["buenos", "owow", "k", "ye"], "1 2 3 4 5)") - it "Check parseList with parseString Failure" $ do - runParser (parseList parseString) "(buenos 3 owow k ye )1 2 3 4 5)" `shouldBe` Nothing - it "Check parseBool true Success" $ do - runParser parseBool "#t lp" `shouldBe` Just (True, "lp") - it "Check parseBool false Success" $ do - runParser parseBool "#f lp" `shouldBe` Just (False, "lp") - it "Check parseBool Failure" $ do - runParser parseBool "#tlp" `shouldBe` Nothing - it "Check parseSExpr Success n°1" $ do - runParser parseSExpr "(define foo (* 3 3))" `shouldBe` Just (SExpr.List [SExpr.Symbol "define",SExpr.Symbol "foo",SExpr.List [SExpr.Symbol "*",SExpr.Value 3,SExpr.Value 3]], "") - it "Check parseSExpr Success n°2" $ do - runParser parseSExpr "( define foo 3 )" `shouldBe` Just (SExpr.List [SExpr.Symbol "define",SExpr.Symbol "foo",SExpr.Value 3], "") - it "Check ParseLisp Success n°1" $ do - parseLisp "(* 3 (+ 2 2))" [] `shouldBe` (Right (Just (AST.Value 12)), []) - it "Check ParseLisp Success n°2" $ do - parseLisp "(* 3 (+ 2 (/ 12 6)))" [] `shouldBe` (Right (Just (AST.Value 12)), []) - it "Check ParseLisp Failure n°1" $ do - parseLisp "(* 3 (+ 2 (/ 12 6))" [] `shouldBe` (Left "Input is unparsable", []) +-- spec = do +-- describe "ParseTest" $ do +-- it "Check parseChar Success" $ do +-- runParser (parseChar ' ') " Hello" `shouldBe` Just (' ', "Hello") +-- it "Check parseChar Failure" $ do +-- runParser (parseChar ' ') "Hello" `shouldBe` Nothing +-- it "Check parseOr Success first arg" $ do +-- runParser (parseOr (parseChar 'a') (parseChar ' ')) "aHello" `shouldBe` Just ('a', "Hello") +-- it "Check parseOr Success second arg" $ do +-- runParser (parseOr (parseChar 'a') (parseChar ' ')) " Hello" `shouldBe` Just (' ', "Hello") +-- it "Check parseOr Failure" $ do +-- runParser (parseOr (parseChar 'f') (parseChar 'O')) " Oui" `shouldBe` Nothing +-- it "Check parseAnd Success" $ do +-- runParser (parseAnd (parseChar 'a') (parseChar 'p')) "apHello" `shouldBe` Just (('a', 'p'), "Hello") +-- it "Check parseAnd Failure" $ do +-- runParser (parseAnd (parseChar 'e') (parseChar 'p')) "apHello" `shouldBe` Nothing +-- it "Check parseAndWith Number Success" $ do +-- runParser (parseAndWith (\x y -> [x, y]) (parseAnyChar ['0'..'9']) (parseAnyChar ['0'..'9'])) "42Hello" `shouldBe` Just ("42", "Hello") +-- it "Check parseAndWith Character Success" $ do +-- runParser (parseAndWith (\x y -> [x, y]) (parseAnyChar ['a'..'z']) (parseAnyChar ['a'..'z'])) "ohHello" `shouldBe` Just ("oh", "Hello") +-- it "Check parseAndWith Failure" $ do +-- runParser (parseAndWith (\x y -> [x, y]) (parseAnyChar ['a'..'z']) (parseAnyChar ['0'..'9'])) "42Hello" `shouldBe` Nothing +-- it "Check parseMany Character Success" $ do +-- runParser (parseMany (parseAnyChar ['a'..'z'])) "bonjournoHello" `shouldBe` Just ("bonjourno", "Hello") +-- it "Check parseMany Number Success" $ do +-- runParser (parseMany (parseAnyChar ['0'..'9'])) "424554Hello" `shouldBe` Just ("424554", "Hello") +-- it "Check parseMany Failure" $ do +-- runParser (parseMany (parseAnyChar ['0'..'9'])) "Hello" `shouldBe` Just ("", "Hello") +-- it "Check parseSome Number Success" $ do +-- runParser (parseSome (parseAnyChar ['0'..'9'])) "042Hello" `shouldBe` Just ("042", "Hello") +-- it "Check parseSome Character Success" $ do +-- runParser (parseSome (parseAnyChar ['a'..'z'])) "buenos42Hello" `shouldBe` Just ("buenos", "42Hello") +-- it "Check parseSome Failure" $ do +-- runParser (parseSome (parseAnyChar ['0'..'9'])) "HelloWorld" `shouldBe` Nothing +-- it "Check parseUInt Success" $ do +-- runParser parseUInt "5463Hello" `shouldBe` Just (5463, "Hello") +-- it "Check parseUInt Failure" $ do +-- runParser parseUInt "Hola" `shouldBe` Nothing +-- it "Check parseUInt Empty" $ do +-- runParser parseUInt "" `shouldBe` Nothing +-- it "Check parseUInt Negative value Failure" $ do +-- runParser parseUInt "-42Hello" `shouldBe` Nothing +-- it "Check parseInt Success" $ do +-- runParser parseInt "4234Hello" `shouldBe` Just (4234, "Hello") +-- it "Check parseInt Negative value Success" $ do +-- runParser parseInt "-42Hello" `shouldBe` Just (-42, "Hello") +-- it "Check parseInt Failure" $ do +-- runParser parseInt "Hello" `shouldBe` Nothing +-- it "Check parsesign '-' Success" $ do +-- runParser parseSign "-llg" `shouldBe` Just ('-', "llg") +-- it "Check parsesign '+' Success" $ do +-- runParser parseSign "+llg" `shouldBe` Just ('+', "llg") +-- it "Check parsesign Failure" $ do +-- runParser parseSign "lg" `shouldBe` Nothing +-- it "Check parseString Success n°1" $ do +-- runParser parseString "bonjourno " `shouldBe` Just ("bonjourno", "") +-- it "Check parseString Success n°2" $ do +-- runParser parseString "bon12*/p journo " `shouldBe` Just ("bon", "12*/p journo ") +-- it "Check parseString Failure" $ do +-- runParser parseString "^bon12*/p journo " `shouldBe` Nothing +-- it "Check parseElem with parseInt Success" $ do +-- runParser (parseElem parseInt) "12 " `shouldBe` Just (12, "") +-- it "Check parseElem with parseString Success" $ do +-- runParser (parseElem parseString) "hello la " `shouldBe` Just ("hello", "la ") +-- it "Check parseElem with parseSymbol Success" $ do +-- runParser (parseElem parseSymbol) "hello la " `shouldBe` Just (SExpr.Symbol "hello", "la ") +-- it "Check parseValue Success" $ do +-- runParser parseValue "432 la " `shouldBe` Just (SExpr.Value 432, "la ") +-- it "Check parseSymbol Success" $ do +-- runParser parseSymbol "symbol la " `shouldBe` Just (SExpr.Symbol "symbol", "la ") +-- it "Check parseList with parseInt Success" $ do +-- runParser (parseList parseInt) "(1 2 3 4 5) " `shouldBe` Just ([1, 2 ,3 , 4, 5], "") +-- it "Check parseList with parseInt Failure (without a number inside)" $ do +-- runParser (parseList parseInt) "(1 2 3 d 4 5) " `shouldBe` Nothing +-- it "Check parseList with parseInt Failure (without a ending ')')" $ do +-- runParser (parseList parseInt) "(1 2 3 4 5 " `shouldBe` Nothing +-- it "Check parseList with parseInt Failure (without a starting '(')" $ do +-- runParser (parseList parseInt) "1 2 3 4 5)" `shouldBe` Nothing +-- it "Check parseList with parseString Success" $ do +-- runParser (parseList parseString) "(buenos owow k ye )1 2 3 4 5)" `shouldBe` Just (["buenos", "owow", "k", "ye"], "1 2 3 4 5)") +-- it "Check parseList with parseString Failure" $ do +-- runParser (parseList parseString) "(buenos 3 owow k ye )1 2 3 4 5)" `shouldBe` Nothing +-- it "Check parseBool true Success" $ do +-- runParser parseBool "#t lp" `shouldBe` Just (True, "lp") +-- it "Check parseBool false Success" $ do +-- runParser parseBool "#f lp" `shouldBe` Just (False, "lp") +-- it "Check parseBool Failure" $ do +-- runParser parseBool "#tlp" `shouldBe` Nothing +-- it "Check parseSExpr Success n°1" $ do +-- runParser parseSExpr "(define foo (* 3 3))" `shouldBe` Just (SExpr.List [SExpr.Symbol "define",SExpr.Symbol "foo",SExpr.List [SExpr.Symbol "*",SExpr.Value 3,SExpr.Value 3]], "") +-- it "Check parseSExpr Success n°2" $ do +-- runParser parseSExpr "( define foo 3 )" `shouldBe` Just (SExpr.List [SExpr.Symbol "define",SExpr.Symbol "foo",SExpr.Value 3], "") +-- it "Check ParseLisp Success n°1" $ do +-- parseLisp "(* 3 (+ 2 2))" [] `shouldBe` (Right (Just (AST.Value 12)), []) +-- it "Check ParseLisp Success n°2" $ do +-- parseLisp "(* 3 (+ 2 (/ 12 6)))" [] `shouldBe` (Right (Just (AST.Value 12)), []) +-- it "Check ParseLisp Failure n°1" $ do +-- parseLisp "(* 3 (+ 2 (/ 12 6))" [] `shouldBe` (Left "Input is unparsable", []) -- "(define vie 42)" From 28a45ef6255c5f6404ae834c7d31460eccc0ef8d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Timoth=C3=A9?= Date: Mon, 8 Jan 2024 16:37:08 +0100 Subject: [PATCH 02/11] feature(remove-sexpr): add parser that transform the parsed string to AST directly --- LobsterLang/app/Main.hs | 13 ++-- LobsterLang/src/Parse.hs | 140 +++++++++++++++++++++++++++++---------- 2 files changed, 112 insertions(+), 41 deletions(-) diff --git a/LobsterLang/app/Main.hs b/LobsterLang/app/Main.hs index eb98a59..255ba47 100644 --- a/LobsterLang/app/Main.hs +++ b/LobsterLang/app/Main.hs @@ -13,17 +13,17 @@ import System.IO (isEOF) import System.Exit (exitWith, ExitCode (ExitFailure)) import System.Environment (getArgs) import Control.Exception -import SExpr (SExpr) +import qualified AST -- | Infinite loop until EOF from the user inputLoop :: [Scope.ScopeMb] -> IO () -- inputLoop = print inputLoop stack = isEOF >>= \end -> if end then print "End of Interpretation GLaDOS" else - getLine >>= \line -> case runParser parseLisp (0, 0) line of + getLine >>= \line -> case runParser parseLobster (0, 0) line of Left err -> putStrLn ("\ESC[34m\ESC[1mThe lobster is angry: " ++ err ++ "\ESC[0m") >> inputLoop stack Right (res, _, _) -> interpretateInfo res stack -interpretateInfo :: [SExpr] -> [Scope.ScopeMb] -> IO () +interpretateInfo :: [AST.Ast] -> [Scope.ScopeMb] -> IO () interpretateInfo [] stack = inputLoop stack interpretateInfo (x:xs) stack = case interpretateLisp x stack of Left err -> putStrLn ("\ESC[31m\ESC[1mThe lobster is angry: " ++ err ++ "\ESC[0m") >> inputLoop stack @@ -31,7 +31,7 @@ interpretateInfo (x:xs) stack = case interpretateLisp x stack of Nothing -> interpretateInfo xs stack' Just value -> print value >> interpretateInfo xs stack' -compileInfo :: [SExpr] -> [Scope.ScopeMb] -> IO () +compileInfo :: [AST.Ast] -> [Scope.ScopeMb] -> IO () compileInfo [] _ = putStr "" compileInfo (x:xs) stack = case interpretateLisp x stack of Left err -> putStrLn ("\ESC[31m\ESC[1mThe lobster is angry: " ++ err ++ "\ESC[0m") >> exitWith (ExitFailure 84) @@ -40,9 +40,10 @@ compileInfo (x:xs) stack = case interpretateLisp x stack of Just value -> print value >> compileInfo xs stack' compileFile :: String -> IO () -compileFile s = case runParser parseLisp (0, 0) s of +compileFile s = case runParser parseLobster (0, 0) s of Left err -> print err >> exitWith (ExitFailure 84) - Right (res, _, _) -> compileInfo res [] + Right (res, [], _) -> compileInfo res [] + Right (_, _, (row, col)) -> print ("Error on parsing on '" ++ show row ++ "' '" ++ show col) checkArgs :: [String] -> IO () checkArgs [] = print "Launch Interpreter" >> inputLoop [] diff --git a/LobsterLang/src/Parse.hs b/LobsterLang/src/Parse.hs index 74f2847..f1b3c48 100644 --- a/LobsterLang/src/Parse.hs +++ b/LobsterLang/src/Parse.hs @@ -22,27 +22,30 @@ module Parse ( parseSign, parseDigit, parseBool, - parseSExpr, + parseAst, parseSymbol, parseElem, parseValue, - parseLisp, + parseLobster, + -- parseLisp, parseAnyString, parseSpace, parseLine, interpretateLisp, + parseDefineValue, parseToken, + parseBinaryOperation, + parseUnaryOperation -- parseTuple, ) where -import SExpr - import Control.Applicative (Alternative (..)) import qualified AstEval import qualified AST import qualified Scope +import qualified Data.Bifoldable as AST type Position = (Int, Int) @@ -136,7 +139,7 @@ parseAnd parserA parserB = Parser (f parserA parserB) Right (res', s'', pos'') -> Right ((res, res'), s'', pos'') -- | Parse with function after the two parsers --- Takes two parsers and a function +-- Takes two parsers and a fh (\x _ -> x) unction -- Returns the result of the function with the result of the parseAnd parseAndWith :: (a -> b -> c) -> Parser a -> Parser b -> Parser c parseAndWith f' parserA parseB = Parser (f f' parserA parseB) @@ -207,15 +210,22 @@ parseElem parser = parseAndWith (\x _ -> x) parser parseSpace <|> parser -- | Return a data Parser that parse a String parseString :: Parser String -parseString = parseSpace *> parseSome (parseAnyChar (['a'..'z'] ++ ['A'..'Z'] ++ "-*/%+#")) <* parseSpace +parseString = parseWhiteSpace *> Parser f <* parseWhiteSpace + where + f :: Position -> String -> Either String (String, String, Position) + f pos s = case runParser (parseSome (parseAnyChar (['a'..'z'] ++ ['A'..'Z'] ++ "_"))) pos s of + Left err -> Left err + Right (res, s', pos') -> case runParser (parseMany (parseAnyChar (['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9'] ++ "_"))) pos' s' of + Left _ -> Right (res ++ res, s', pos') + Right (res', s'', pos'') -> Right (res ++ res', s'', pos'') -- | Return a data Parser that parse a String as a Symbol -parseSymbol :: Parser SExpr -parseSymbol = Symbol <$> parseElem parseString +parseSymbol :: Parser AST.Ast +parseSymbol = AST.Symbol <$> parseElem parseString -- | Return a data Parser that parse a Int as a Value -parseValue :: Parser SExpr -parseValue = Value <$> parseElem parseInt +parseValue :: Parser AST.Ast +parseValue = AST.Value <$> parseElem parseInt -- | Parse a list of element -- Return a Parser of list `element` that start with a '(' and end with a ')' @@ -253,15 +263,15 @@ parseAnyString s = Parser (f s s) f [] str pos s' = Right (str, s', pos) -- | Return a Parser that parse a Bool (#f or #t) -parseBool :: Parser Bool -parseBool = parseElem (parseTrue <|> parseFalse) +parseBool :: Parser AST.Ast +parseBool = AST.Boolean <$> (parseTrue <|> parseFalse) -- | Return a PArser that parse a True (in lisp -> #t) parseTrue :: Parser Bool parseTrue = Parser f where f :: Position -> String -> Either String (Bool, String, Position) - f pos s = case runParser (parseAnyString "#t") pos s of + f pos s = case runParser (parseAnyString "true") pos s of Left err -> Left err Right (_, s', pos') -> Right (True, s', pos') @@ -270,21 +280,25 @@ parseFalse :: Parser Bool parseFalse = Parser f where f :: Position -> String -> Either String (Bool, String, Position) - f pos s = case runParser (parseAnyString "#f") pos s of + f pos s = case runParser (parseAnyString "false") pos s of Left err -> Left err Right (_, s', pos') -> Right (False, s', pos') parseSymbolToken :: Parser Token parseSymbolToken = Sym <$> ( + parseAnyString "=" <|> + parseAnyString "->" <|> + parseAnyString ":" <|> parseAnyString "==" <|> parseAnyString "<=" <|> parseAnyString ">=" <|> - parseAnyString "=" <|> parseAnyString "<" <|> parseAnyString ">" <|> parseAnyString "!=" <|> - parseAnyString "->" <|> - parseAnyString ":" <|> + parseAnyString "^^" <|> + parseAnyString "||" <|> + parseAnyString "&&" <|> + parseAnyString "$" <|> parseAnyString "+" <|> parseAnyString "-" <|> parseAnyString "*" <|> @@ -299,11 +313,6 @@ parseSymbolToken = Sym <$> ( parseAnyString "fn" ) - -- where - -- parseCall = - -- parseFuncArg = parseName *> parseList parseString - -- parseName = parseString - parseIdentifierToken :: Parser Token parseIdentifierToken = Identifier <$> parseSome (parseAnyChar (['a'..'z'] ++ ['A'..'Z'])) @@ -316,25 +325,86 @@ parseToken = parseSome (parseWhiteSpace *> parseElem parseSymbolToken <|> parseWhiteSpace *> parseElem parseNumberToken) <|> parseWhiteSpace *> parseElem parseToken +parseDefineValue :: Parser AST.Ast +parseDefineValue = Parser f + where + f :: Position -> String -> Either String (AST.Ast, String, Position) + f pos s = case runParser parseString pos s of + Left err -> Left err + Right (res, s', pos') -> case runParser (parseChar '=') pos' s' of + Left err' -> Left err' + Right (_, s'', pos'') -> case runParser parseAst pos'' s'' of + Left err'' -> Left err'' + Right (res'', s''', pos''') -> Right (AST.Define res res'', s''', pos''') + +parseBinaryOperator :: Parser String +parseBinaryOperator = parseWhiteSpace *> parseAnyString "+" <|> + parseWhiteSpace *> parseAnyString "-" <|> + parseWhiteSpace *> parseAnyString "*" <|> + parseWhiteSpace *> parseAnyString "/" <|> + parseWhiteSpace *> parseAnyString "%" <|> + parseWhiteSpace *> parseAnyString "==" <|> + parseWhiteSpace *> parseAnyString "!=" <|> + parseWhiteSpace *> parseAnyString "<" <|> + parseWhiteSpace *> parseAnyString "<=" <|> + parseWhiteSpace *> parseAnyString ">" <|> + parseWhiteSpace *> parseAnyString ">=" <|> + parseWhiteSpace *> parseAnyString "&&" <|> + parseWhiteSpace *> parseAnyString "||" <|> + parseWhiteSpace *> parseAnyString "^^" <|> + parseWhiteSpace *> parseAnyString "++" <|> + parseWhiteSpace *> parseAnyString "--" <|> + parseWhiteSpace *> parseAnyString "!!" <|> + parseWhiteSpace *> parseAnyString "$" + +parseBinaryOperation :: Parser AST.Ast +parseBinaryOperation = Parser f + where + f :: Position -> String -> Either String (AST.Ast, String, Position) + f pos s = case runParser parseAstValue pos s of + Left err -> Left err + Right (res, s', pos') -> case runParser parseBinaryOperator pos' s' of + Left err' -> Left err' + Right (res', s'', pos'') -> case runParser parseAstValue pos'' s'' of + Left err'' -> Left err'' + Right (res'', s''', pos''') -> Right (AST.Call res' (res : [res'']), s''', pos''') + +parseUnaryOperator :: Parser String +parseUnaryOperator = parseWhiteSpace *> parseAnyString "!"<|> + parseWhiteSpace *> parseAnyString "@" <|> + parseWhiteSpace *> parseAnyString "~" + +parseUnaryOperation :: Parser AST.Ast +parseUnaryOperation = Parser f + where + f :: Position -> String -> Either String (AST.Ast, String, Position) + f pos s = case runParser parseUnaryOperator pos s of + Left err -> Left err + Right (res, s', pos') -> case runParser parseAst pos' s' of + Left err' -> Left err' + Right (res', s'', pos'') -> Right (AST.Call res [res'], s'', pos'') + +parseAstValue :: Parser AST.Ast +parseAstValue = parseWhiteSpace *> parseValue <|> parseWhiteSpace *> parseSymbol + -- | Return a Parser that parse a SExpr -parseSExpr :: Parser SExpr -parseSExpr = - parseSpace *> parseSymbol <|> - parseSpace *> parseValue <|> - List <$> parseList (parseSpace *> parseValue <|> parseSpace *> parseSymbol <|> parseSpace *> parseSExpr) <* parseSpace +parseAst :: Parser AST.Ast +parseAst = + parseWhiteSpace *> parseDefineValue + -- <|> parseWhiteSpace *> parseBinaryOperation + <|> parseWhiteSpace *> parseUnaryOperation + <|> parseWhiteSpace *> parseBool + <|> parseWhiteSpace *> parseSymbol + <|> parseWhiteSpace *> parseValue --- tokenization :: Parser [Token] --- tokenization = -parseLisp :: Parser [SExpr] -parseLisp = parseSome parseSExpr <* parseSpace +parseLobster :: Parser [AST.Ast] +parseLobster = parseSome parseAst -- | Return a Result that contain the evaluation of our Lisp String -- Takes as parameter the string that need to be evaluated and the Stack (Environment) -interpretateLisp :: SExpr -> [Scope.ScopeMb] -> Either String (Maybe AST.Ast, [Scope.ScopeMb]) -interpretateLisp value stack = case AstEval.sexprToAst value of - Nothing -> Left "Error on evaluation" - Just res -> case AstEval.evalAst stack res of +interpretateLisp :: AST.Ast -> [Scope.ScopeMb] -> Either String (Maybe AST.Ast, [Scope.ScopeMb]) +interpretateLisp value stack = case AstEval.evalAst stack value of (Left err, _) -> Left err (Right res', stack') -> Right (res', stack') From a77d642efec1af6f88ab93bf9a404169ec819aaa Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Timoth=C3=A9?= Date: Mon, 8 Jan 2024 18:51:40 +0100 Subject: [PATCH 03/11] feature(parsing-operator): add parsing operational interpretation of parsing expression --- LobsterLang/src/Parse.hs | 51 ++++++++++++++++++++++++++++++++++++---- 1 file changed, 46 insertions(+), 5 deletions(-) diff --git a/LobsterLang/src/Parse.hs b/LobsterLang/src/Parse.hs index f1b3c48..fdd57ca 100644 --- a/LobsterLang/src/Parse.hs +++ b/LobsterLang/src/Parse.hs @@ -37,7 +37,10 @@ module Parse ( parseToken, parseBinaryOperation, - parseUnaryOperation + parseUnaryOperation, + parseProduct, + parseSum, + parseExpr -- parseTuple, ) where @@ -45,7 +48,7 @@ import Control.Applicative (Alternative (..)) import qualified AstEval import qualified AST import qualified Scope -import qualified Data.Bifoldable as AST +import Control.Applicative type Position = (Int, Int) @@ -223,9 +226,46 @@ parseString = parseWhiteSpace *> Parser f <* parseWhiteSpace parseSymbol :: Parser AST.Ast parseSymbol = AST.Symbol <$> parseElem parseString +parseExpr :: Parser AST.Ast +parseExpr = parseSum + +parseSum :: Parser AST.Ast +parseSum = parseWhiteSpace *> Parser f <* parseWhiteSpace + where + f :: Position -> String -> Either String (AST.Ast, String, Position) + f pos s = case runParser parseProduct pos s of + Left err -> Left err + Right (res, s', pos') -> case runParser (parseAnyChar "+-") pos' s' of + Left _ -> Right (res, s', pos') + Right (res', s'', pos'') -> case runParser parseSum pos'' s'' of + Left err'' -> Left err'' + Right (res'', s''', pos''') -> Right (AST.Call [res'] (res : [res'']), s''', pos''') + +parseProduct :: Parser AST.Ast +parseProduct = parseWhiteSpace *> Parser f <* parseWhiteSpace + where + f :: Position -> String -> Either String (AST.Ast, String, Position) + f pos s = case runParser parseValue pos s of + Left err -> Left err + Right (res, s', pos') -> case runParser (parseAnyChar "*/") pos' s' of + Left _ -> Right (res, s', pos') + Right (res', s'', pos'') -> case runParser parseProduct pos'' s'' of + Left err'' -> Left err'' + Right (res'', s''', pos''') -> Right (AST.Call [res'] (res : [res'']), s''', pos''') + +-- parseProduct = parseValue >>= \res -> case optional (parseAnyChar "*/" >>= \res' -> parseProduct >>= \res'') of +-- -- -> return $ AST.Call [res'] [res, res''] of +-- Nothing -> +-- Just res -> res +-- parseProduct = do + -- (res, s, pos) <- parseValue + +-- parseProduct = parseValue >>= \(res, s, pos) -> parseAnyChar "*/" pos res +-- parseProduct = parseValue *> parseAnyChar "*/" <* parseProduct + -- | Return a data Parser that parse a Int as a Value parseValue :: Parser AST.Ast -parseValue = AST.Value <$> parseElem parseInt +parseValue = AST.Value <$> parseElem parseInt <|> parseChar '(' *> parseExpr <* parseChar ')' -- | Parse a list of element -- Return a Parser of list `element` that start with a '(' and end with a ')' @@ -358,6 +398,7 @@ parseBinaryOperator = parseWhiteSpace *> parseAnyString "+" <|> parseWhiteSpace *> parseAnyString "$" parseBinaryOperation :: Parser AST.Ast +-- parseBinaryOperation = parseAstValue >>= \(res, s', pos') -> parseBinaryOperator parseBinaryOperation = Parser f where f :: Position -> String -> Either String (AST.Ast, String, Position) @@ -365,7 +406,7 @@ parseBinaryOperation = Parser f Left err -> Left err Right (res, s', pos') -> case runParser parseBinaryOperator pos' s' of Left err' -> Left err' - Right (res', s'', pos'') -> case runParser parseAstValue pos'' s'' of + Right (res', s'', pos'') -> case runParser parseAst pos'' s'' of Left err'' -> Left err'' Right (res'', s''', pos''') -> Right (AST.Call res' (res : [res'']), s''', pos''') @@ -391,7 +432,7 @@ parseAstValue = parseWhiteSpace *> parseValue <|> parseWhiteSpace *> parseSymbol parseAst :: Parser AST.Ast parseAst = parseWhiteSpace *> parseDefineValue - -- <|> parseWhiteSpace *> parseBinaryOperation + <|> parseWhiteSpace *> parseBinaryOperation <|> parseWhiteSpace *> parseUnaryOperation <|> parseWhiteSpace *> parseBool <|> parseWhiteSpace *> parseSymbol From ded2b0f6b4d4d182cd0ddc3dd2c394e9dd54616c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Timoth=C3=A9?= Date: Tue, 9 Jan 2024 22:19:27 +0100 Subject: [PATCH 04/11] feature(expression): add parsing expression with binary operator --- LobsterLang/src/Parse.hs | 111 ++++++++++++++++++++++++++------------- 1 file changed, 74 insertions(+), 37 deletions(-) diff --git a/LobsterLang/src/Parse.hs b/LobsterLang/src/Parse.hs index fdd57ca..425484a 100644 --- a/LobsterLang/src/Parse.hs +++ b/LobsterLang/src/Parse.hs @@ -49,6 +49,8 @@ import qualified AstEval import qualified AST import qualified Scope import Control.Applicative +import Data.Maybe +import Text.ParserCombinators.ReadPrec (reset) type Position = (Int, Int) @@ -227,39 +229,78 @@ parseSymbol :: Parser AST.Ast parseSymbol = AST.Symbol <$> parseElem parseString parseExpr :: Parser AST.Ast -parseExpr = parseSum +parseExpr = parseFuncOperator + +parseFuncOperator :: Parser AST.Ast +parseFuncOperator = do res <- parseCondOperator + res' <- optional (parseChar '$' + >>= \res' -> parseFuncOperator + >>= \res'' -> return $ AST.Call [res'] [res, res'']) + return $ fromMaybe res res' + +parseCondOperator :: Parser AST.Ast +parseCondOperator = do res <- parseCompOperator + res' <- optional (parseAnyString "&&" <|> + parseAnyString "||" <|> + parseAnyString "^^" + >>= \res' -> parseCondOperator + >>= \res'' -> return $ AST.Call res' [res, res'']) + return $ fromMaybe res res' + +parseCompOperator :: Parser AST.Ast +parseCompOperator = do res <- parseSum + res' <- optional (parseAnyString "==" <|> + parseAnyString ">=" <|> + parseAnyString "!=" <|> + parseAnyString "<=" <|> + parseAnyString ">" <|> + parseAnyString "<" + >>= \res' -> parseCompOperator + >>= \res'' -> return $ AST.Call res' [res, res'']) + return $ fromMaybe res res' parseSum :: Parser AST.Ast -parseSum = parseWhiteSpace *> Parser f <* parseWhiteSpace - where - f :: Position -> String -> Either String (AST.Ast, String, Position) - f pos s = case runParser parseProduct pos s of - Left err -> Left err - Right (res, s', pos') -> case runParser (parseAnyChar "+-") pos' s' of - Left _ -> Right (res, s', pos') - Right (res', s'', pos'') -> case runParser parseSum pos'' s'' of - Left err'' -> Left err'' - Right (res'', s''', pos''') -> Right (AST.Call [res'] (res : [res'']), s''', pos''') +-- parseSum = parseWhiteSpace *> Parser f <* parseWhiteSpace +-- where +-- f :: Position -> String -> Either String (AST.Ast, String, Position) +-- f pos s = case runParser parseProduct pos s of +-- Left err -> Left err +-- Right (res, s', pos') -> case runParser (parseAnyChar "+-") pos' s' of +-- Left _ -> Right (res, s', pos') +-- Right (res', s'', pos'') -> case runParser parseSum pos'' s'' of +-- Left err'' -> Left err'' +-- Right (res'', s''', pos''') -> Right (AST.Call [res'] (res : [res'']), s''', pos''') +parseSum = do res <- parseProduct + res' <- optional (parseAnyChar "+-" >>= \res' -> parseSum >>= \res'' -> return $ AST.Call [res'] [res, res'']) + return $ fromMaybe res res' parseProduct :: Parser AST.Ast -parseProduct = parseWhiteSpace *> Parser f <* parseWhiteSpace - where - f :: Position -> String -> Either String (AST.Ast, String, Position) - f pos s = case runParser parseValue pos s of - Left err -> Left err - Right (res, s', pos') -> case runParser (parseAnyChar "*/") pos' s' of - Left _ -> Right (res, s', pos') - Right (res', s'', pos'') -> case runParser parseProduct pos'' s'' of - Left err'' -> Left err'' - Right (res'', s''', pos''') -> Right (AST.Call [res'] (res : [res'']), s''', pos''') - --- parseProduct = parseValue >>= \res -> case optional (parseAnyChar "*/" >>= \res' -> parseProduct >>= \res'') of --- -- -> return $ AST.Call [res'] [res, res''] of --- Nothing -> --- Just res -> res +-- parseProduct = parseWhiteSpace *> Parser f <* parseWhiteSpace +-- where +-- f :: Position -> String -> Either String (AST.Ast, String, Position) +-- f pos s = case runParser parseValue pos s of +-- Left err -> Left err +-- Right (res, s', pos') -> case runParser (parseAnyChar "*/") pos' s' of +-- Left _ -> Right (res, s', pos') +-- Right (res', s'', pos'') -> case runParser parseProduct pos'' s'' of +-- Left err'' -> Left err'' +-- Right (res'', s''', pos''') -> Right (AST.Call [res'] (res : [res'']), s''', pos''') + + +parseProduct = do res <- parseListOperator + res' <- optional (parseAnyChar "*/" >>= \res' -> parseProduct >>= \res'' -> return $ AST.Call [res'] [res, res'']) + return $ fromMaybe res res' + +parseListOperator :: Parser AST.Ast +parseListOperator = do res <- parseValue + res' <- optional (parseAnyString "--" <|> parseAnyString "++" <|> parseAnyString "!!" >>= \res' -> parseListOperator >>= \res'' -> return $ AST.Call res' [res, res'']) + return $ fromMaybe res res' +-- parseProduct = fromMaybe parseValue >>= + -- \res -> fromMaybe (return res) (optional (parseAnyChar "*/" >>= \res' -> parseProduct >>= \res'' -> return $ AST.Call [res'] [res, res''])) + -- \res -> optional (parseAnyChar "*/" >>= \res' -> parseProduct >>= \res'' -> return $ AST.Call [res'] [res, res'']) -- parseProduct = do -- (res, s, pos) <- parseValue - + -- parseProduct = parseValue >>= \(res, s, pos) -> parseAnyChar "*/" pos res -- parseProduct = parseValue *> parseAnyChar "*/" <* parseProduct @@ -378,12 +419,7 @@ parseDefineValue = Parser f Right (res'', s''', pos''') -> Right (AST.Define res res'', s''', pos''') parseBinaryOperator :: Parser String -parseBinaryOperator = parseWhiteSpace *> parseAnyString "+" <|> - parseWhiteSpace *> parseAnyString "-" <|> - parseWhiteSpace *> parseAnyString "*" <|> - parseWhiteSpace *> parseAnyString "/" <|> - parseWhiteSpace *> parseAnyString "%" <|> - parseWhiteSpace *> parseAnyString "==" <|> +parseBinaryOperator = parseWhiteSpace *> parseAnyString "==" <|> parseWhiteSpace *> parseAnyString "!=" <|> parseWhiteSpace *> parseAnyString "<" <|> parseWhiteSpace *> parseAnyString "<=" <|> @@ -399,14 +435,14 @@ parseBinaryOperator = parseWhiteSpace *> parseAnyString "+" <|> parseBinaryOperation :: Parser AST.Ast -- parseBinaryOperation = parseAstValue >>= \(res, s', pos') -> parseBinaryOperator -parseBinaryOperation = Parser f +parseBinaryOperation = parseExpr <|> Parser f where f :: Position -> String -> Either String (AST.Ast, String, Position) f pos s = case runParser parseAstValue pos s of Left err -> Left err Right (res, s', pos') -> case runParser parseBinaryOperator pos' s' of - Left err' -> Left err' - Right (res', s'', pos'') -> case runParser parseAst pos'' s'' of + Left err' -> Right (res, s', pos') + Right (res', s'', pos'') -> case runParser parseBinaryOperation pos'' s'' of Left err'' -> Left err'' Right (res'', s''', pos''') -> Right (AST.Call res' (res : [res'']), s''', pos''') @@ -432,7 +468,8 @@ parseAstValue = parseWhiteSpace *> parseValue <|> parseWhiteSpace *> parseSymbol parseAst :: Parser AST.Ast parseAst = parseWhiteSpace *> parseDefineValue - <|> parseWhiteSpace *> parseBinaryOperation + <|> parseWhiteSpace *> parseExpr + -- <|> parseWhiteSpace *> parseBinaryOperation <|> parseWhiteSpace *> parseUnaryOperation <|> parseWhiteSpace *> parseBool <|> parseWhiteSpace *> parseSymbol From b0f1418f7da01d3a9a08a2ee3bfe5b2a32efed13 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Timoth=C3=A9?= Date: Wed, 10 Jan 2024 16:58:42 +0100 Subject: [PATCH 05/11] feature(expression): add expression with the symbol --- LobsterLang/src/Parse.hs | 15 ++++++++++++++- 1 file changed, 14 insertions(+), 1 deletion(-) diff --git a/LobsterLang/src/Parse.hs b/LobsterLang/src/Parse.hs index 425484a..4ea943b 100644 --- a/LobsterLang/src/Parse.hs +++ b/LobsterLang/src/Parse.hs @@ -259,6 +259,19 @@ parseCompOperator = do res <- parseSum >>= \res'' -> return $ AST.Call res' [res, res'']) return $ fromMaybe res res' +-- parseSub :: Parser AST.Ast +-- parseSub = parseWhiteSpace *> Parser f <* parseWhiteSpace +-- where +-- f :: Position -> String -> Either String (AST.Ast, String, Position) +-- f pos s = case runParser parseSub pos s of +-- Left err -> Left err +-- Right (res, s', pos') -> case runParser (parseAnyChar "-") pos' s' of +-- Left _ -> Right (res, s', pos') +-- Right (res', s'', pos'') -> case runParser parseSum pos'' s'' of +-- Left err'' -> Left err'' +-- Right (res'', s''', pos''') -> Right (AST.Call [res'] (res : [res'']), s''', pos''') + + parseSum :: Parser AST.Ast -- parseSum = parseWhiteSpace *> Parser f <* parseWhiteSpace -- where @@ -306,7 +319,7 @@ parseListOperator = do res <- parseValue -- | Return a data Parser that parse a Int as a Value parseValue :: Parser AST.Ast -parseValue = AST.Value <$> parseElem parseInt <|> parseChar '(' *> parseExpr <* parseChar ')' +parseValue = AST.Value <$> parseElem parseInt <|> parseChar '(' *> parseExpr <* parseChar ')' <|> parseSymbol -- | Parse a list of element -- Return a Parser of list `element` that start with a '(' and end with a ')' From 4e40fe34fa2f15f18f7731e440dc6c70bfe8462a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Timoth=C3=A9?= Date: Wed, 10 Jan 2024 17:47:14 +0100 Subject: [PATCH 06/11] chore(file): remove useless file and refactor example Lobster language --- LobsterLang/src/Token.hs | 8 -------- exemple/Fibonacci.lob | 4 ++-- exemple/Lambda.lob | 2 +- foo.scm | 10 ---------- 4 files changed, 3 insertions(+), 21 deletions(-) delete mode 100644 LobsterLang/src/Token.hs delete mode 100644 foo.scm diff --git a/LobsterLang/src/Token.hs b/LobsterLang/src/Token.hs deleted file mode 100644 index c06dde7..0000000 --- a/LobsterLang/src/Token.hs +++ /dev/null @@ -1,8 +0,0 @@ -{- --- EPITECH PROJECT, 2024 --- Token.hs --- File description: --- Token --} - - diff --git a/exemple/Fibonacci.lob b/exemple/Fibonacci.lob index c36a726..883644c 100644 --- a/exemple/Fibonacci.lob +++ b/exemple/Fibonacci.lob @@ -1,9 +1,9 @@ -fn fibonacci(\ x: integer /) -> integer { +fn fibonacci(| x: integer |) -> integer { if x == 0 { 0 } else if x == 1 { 1 } else { - fibonacci(\ x - 1 /) + fibonacci(\ x - 2 /) + fibonacci(| x - 1 |) + fibonacci(| x - 2 |) } } diff --git a/exemple/Lambda.lob b/exemple/Lambda.lob index 13f82b2..5f3e156 100644 --- a/exemple/Lambda.lob +++ b/exemple/Lambda.lob @@ -8,7 +8,7 @@ add(\ 2, 9 /) # return 11 abs = λ (\ x: integer /) -> integer { if x < 0 { x * -1 - else { + } else { x } } diff --git a/foo.scm b/foo.scm deleted file mode 100644 index c6434b8..0000000 --- a/foo.scm +++ /dev/null @@ -1,10 +0,0 @@ -(define foo 21) -(define x 5) -(define value (* x foo)) -p -(* value 4) -(define value (* 4 (+ 1 2))) -value - -(define value (* (define x 5) (define foo 21))) -(define value (* 5 21)) \ No newline at end of file From e527cb4c8d7b056bf3d68f38fd66cc0e566f698b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Timoth=C3=A9?= Date: Wed, 10 Jan 2024 18:02:05 +0100 Subject: [PATCH 07/11] refactor(function): refactor name function + change '()' to '(| |)' --- LobsterLang/src/Parse.hs | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/LobsterLang/src/Parse.hs b/LobsterLang/src/Parse.hs index cf57940..801052f 100644 --- a/LobsterLang/src/Parse.hs +++ b/LobsterLang/src/Parse.hs @@ -219,21 +219,21 @@ parseSymbol :: Parser AST.Ast parseSymbol = AST.String <$> parseElem parseString parseExpr :: Parser AST.Ast -parseExpr = parseFuncOperator +parseExpr = parseCombinatorOperator -parseFuncOperator :: Parser AST.Ast -parseFuncOperator = do res <- parseCondOperator - res' <- optional (parseChar '$' - >>= \res' -> parseFuncOperator +parseCombinatorOperator :: Parser AST.Ast +parseCombinatorOperator = do res <- parseBoolOperator + res' <- optional (parseChar '$' + >>= \res' -> parseCombinatorOperator >>= \res'' -> return $ AST.Call [res'] [res, res'']) - return $ fromMaybe res res' + return $ fromMaybe res res' -parseCondOperator :: Parser AST.Ast -parseCondOperator = do res <- parseCompOperator +parseBoolOperator :: Parser AST.Ast +parseBoolOperator = do res <- parseCompOperator res' <- optional (parseAnyString "&&" <|> parseAnyString "||" <|> parseAnyString "^^" - >>= \res' -> parseCondOperator + >>= \res' -> parseBoolOperator >>= \res'' -> return $ AST.Call res' [res, res'']) return $ fromMaybe res res' @@ -309,7 +309,7 @@ parseListOperator = do res <- parseValue -- | Return a data Parser that parse a Int as a Value parseValue :: Parser AST.Ast -parseValue = AST.Value <$> parseElem parseInt <|> parseChar '(' *> parseExpr <* parseChar ')' <|> parseSymbol +parseValue = AST.Value <$> parseElem parseInt <|> parseAnyString "(|" *> parseExpr <* parseAnyString "|)" <|> parseSymbol -- | Parse a list of element -- Return a Parser of list `element` that start with a '(' and end with a ')' From 3f7a2c3fda56c2c5f3b1d851d73c6c5158035c4e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Timoth=C3=A9?= Date: Wed, 10 Jan 2024 18:12:01 +0100 Subject: [PATCH 08/11] refactor(lint): lint function --- LobsterLang/src/Parse.hs | 63 ++++++++++------------------------------ 1 file changed, 16 insertions(+), 47 deletions(-) diff --git a/LobsterLang/src/Parse.hs b/LobsterLang/src/Parse.hs index 801052f..59467dd 100644 --- a/LobsterLang/src/Parse.hs +++ b/LobsterLang/src/Parse.hs @@ -249,67 +249,36 @@ parseCompOperator = do res <- parseSum >>= \res'' -> return $ AST.Call res' [res, res'']) return $ fromMaybe res res' --- parseSub :: Parser AST.Ast --- parseSub = parseWhiteSpace *> Parser f <* parseWhiteSpace --- where --- f :: Position -> String -> Either String (AST.Ast, String, Position) --- f pos s = case runParser parseSub pos s of --- Left err -> Left err --- Right (res, s', pos') -> case runParser (parseAnyChar "-") pos' s' of --- Left _ -> Right (res, s', pos') --- Right (res', s'', pos'') -> case runParser parseSum pos'' s'' of --- Left err'' -> Left err'' --- Right (res'', s''', pos''') -> Right (AST.Call [res'] (res : [res'']), s''', pos''') - - parseSum :: Parser AST.Ast --- parseSum = parseWhiteSpace *> Parser f <* parseWhiteSpace --- where --- f :: Position -> String -> Either String (AST.Ast, String, Position) --- f pos s = case runParser parseProduct pos s of --- Left err -> Left err --- Right (res, s', pos') -> case runParser (parseAnyChar "+-") pos' s' of --- Left _ -> Right (res, s', pos') --- Right (res', s'', pos'') -> case runParser parseSum pos'' s'' of --- Left err'' -> Left err'' --- Right (res'', s''', pos''') -> Right (AST.Call [res'] (res : [res'']), s''', pos''') parseSum = do res <- parseProduct - res' <- optional (parseAnyChar "+-" >>= \res' -> parseSum >>= \res'' -> return $ AST.Call [res'] [res, res'']) + res' <- optional (parseAnyChar "+-" + >>= \res' -> parseSum + >>= \res'' -> return $ AST.Call [res'] [res, res'']) return $ fromMaybe res res' parseProduct :: Parser AST.Ast --- parseProduct = parseWhiteSpace *> Parser f <* parseWhiteSpace --- where --- f :: Position -> String -> Either String (AST.Ast, String, Position) --- f pos s = case runParser parseValue pos s of --- Left err -> Left err --- Right (res, s', pos') -> case runParser (parseAnyChar "*/") pos' s' of --- Left _ -> Right (res, s', pos') --- Right (res', s'', pos'') -> case runParser parseProduct pos'' s'' of --- Left err'' -> Left err'' --- Right (res'', s''', pos''') -> Right (AST.Call [res'] (res : [res'']), s''', pos''') - - parseProduct = do res <- parseListOperator - res' <- optional (parseAnyChar "*/" >>= \res' -> parseProduct >>= \res'' -> return $ AST.Call [res'] [res, res'']) + res' <- optional (parseAnyChar "*/" + >>= \res' -> parseProduct + >>= \res'' -> return $ AST.Call [res'] [res, res'']) return $ fromMaybe res res' parseListOperator :: Parser AST.Ast parseListOperator = do res <- parseValue - res' <- optional (parseAnyString "--" <|> parseAnyString "++" <|> parseAnyString "!!" >>= \res' -> parseListOperator >>= \res'' -> return $ AST.Call res' [res, res'']) + res' <- optional (parseAnyString "--" <|> + parseAnyString "++" <|> + parseAnyString "!!" + >>= \res' -> parseListOperator + >>= \res'' -> return $ AST.Call res' [res, res'']) return $ fromMaybe res res' --- parseProduct = fromMaybe parseValue >>= - -- \res -> fromMaybe (return res) (optional (parseAnyChar "*/" >>= \res' -> parseProduct >>= \res'' -> return $ AST.Call [res'] [res, res''])) - -- \res -> optional (parseAnyChar "*/" >>= \res' -> parseProduct >>= \res'' -> return $ AST.Call [res'] [res, res'']) --- parseProduct = do - -- (res, s, pos) <- parseValue - --- parseProduct = parseValue >>= \(res, s, pos) -> parseAnyChar "*/" pos res --- parseProduct = parseValue *> parseAnyChar "*/" <* parseProduct -- | Return a data Parser that parse a Int as a Value parseValue :: Parser AST.Ast -parseValue = AST.Value <$> parseElem parseInt <|> parseAnyString "(|" *> parseExpr <* parseAnyString "|)" <|> parseSymbol +parseValue = parseWhiteSpace *> ( + parseAnyString "(|" *> parseExpr <* parseAnyString "|)" + <|> AST.Value <$> parseElem parseInt + <|>parseSymbol + ) -- | Parse a list of element -- Return a Parser of list `element` that start with a '(' and end with a ')' From 7896cac45412e50d489ca9112fa4ee73d705cd98 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Timoth=C3=A9?= Date: Wed, 10 Jan 2024 18:22:31 +0100 Subject: [PATCH 09/11] feature(constant): add constant function that return constant value --- LobsterLang/src/Parse.hs | 25 +++++++++++++++++++------ 1 file changed, 19 insertions(+), 6 deletions(-) diff --git a/LobsterLang/src/Parse.hs b/LobsterLang/src/Parse.hs index 59467dd..8530f82 100644 --- a/LobsterLang/src/Parse.hs +++ b/LobsterLang/src/Parse.hs @@ -103,6 +103,15 @@ instance Monad Parser where Right (res, s', pos') -> runParser (b res) pos' s' ) +errorParsing :: (Int, Int) -> String +errorParsing (row, col) = "Error on parsing on '" ++ show row ++ "' '" ++ show col + +startCharacter :: String +startCharacter = ['a'..'z'] ++ ['A'..'Z'] ++ "_" + +lobsterCharacter :: String +lobsterCharacter = startCharacter ++ ['0'..'9'] + -- | Parse a character c -- Takes the character that need to be parsed -- Returns a data Parser that contain the character and the rest of the string @@ -110,9 +119,13 @@ parseChar :: Char -> Parser Char parseChar c = Parser (f c) where f :: Char -> Position -> String -> Either String (Char, String, Position) - f '\n' (row, col) (x:xs) = if '\n' == x then Right ('\n', xs, (row + 1, 0)) else Left ("Error on parsing on '" ++ show row ++ "' '" ++ show col) - f char (row, col) (x:xs) = if char == x then Right (char, xs, (row, col + 1)) else Left ("Error on parsing on '" ++ show row ++ "' '" ++ show col) - f _ (row, col) _ = Left ("Error on parsing on '" ++ show row ++ "' '" ++ show col) + f '\n' (row, col) (x:xs) + | x == '\n' = Right ('\n', xs, (row + 1, 0)) + | otherwise = Left (errorParsing (row, col)) + f char (row, col) (x:xs) + | x == char = Right (char, xs, (row, col + 1)) + | otherwise = Left (errorParsing (row, col)) + f _ (row, col) _ = Left (errorParsing (row, col)) -- | Parse with the first or the second parser -- Takes two parsers @@ -208,9 +221,9 @@ parseString :: Parser String parseString = parseWhiteSpace *> Parser f <* parseWhiteSpace where f :: Position -> String -> Either String (String, String, Position) - f pos s = case runParser (parseSome (parseAnyChar (['a'..'z'] ++ ['A'..'Z'] ++ "_"))) pos s of + f pos s = case runParser (parseSome (parseAnyChar startCharacter)) pos s of Left err -> Left err - Right (res, s', pos') -> case runParser (parseMany (parseAnyChar (['a'..'z'] ++ ['A'..'Z'] ++ ['0'..'9'] ++ "_"))) pos' s' of + Right (res, s', pos') -> case runParser (parseMany (parseAnyChar lobsterCharacter)) pos' s' of Left _ -> Right (res ++ res, s', pos') Right (res', s'', pos'') -> Right (res ++ res', s'', pos'') @@ -295,7 +308,7 @@ parseAnyChar :: String -> Parser Char parseAnyChar s = Parser (f s) where f :: String -> Position -> String -> Either String (Char, String, Position) - f [] (row, col) _ = Left ("Error on parsing on '" ++ show row ++ "' '" ++ show col) + f [] (row, col) _ = Left (errorParsing (row, col)) f (x:xs) pos s' = case parsed of Left _ -> runParser (parseAnyChar xs) pos s' _ -> parsed From 417d4000e8c3356d755362c1e57e4991436baa1e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Timoth=C3=A9?= Date: Thu, 11 Jan 2024 19:30:41 +0100 Subject: [PATCH 10/11] feature(test): add unit test --- LobsterLang/app/Main.hs | 13 ++- LobsterLang/src/AstEval.hs | 17 +-- LobsterLang/src/Parse.hs | 97 ++++++++--------- LobsterLang/test/ParserSpec.hs | 184 +++++++++++++++++++++++++++++++++ Makefile | 2 +- 5 files changed, 240 insertions(+), 73 deletions(-) create mode 100644 LobsterLang/test/ParserSpec.hs diff --git a/LobsterLang/app/Main.hs b/LobsterLang/app/Main.hs index fee9bcb..917a7d3 100644 --- a/LobsterLang/app/Main.hs +++ b/LobsterLang/app/Main.hs @@ -12,17 +12,26 @@ import Scope import System.IO (isEOF) import System.Exit (exitWith, ExitCode (ExitFailure)) import System.Environment (getArgs) +import qualified AstEval import Control.Exception import qualified AST -- import Compiler +-- | Return a Result that contain the evaluation of our Lisp String +-- Takes as parameter the string that need to be evaluated and the Stack (Environment) +interpretateLisp :: AST.Ast -> [Scope.ScopeMb] -> Either String (Maybe AST.Ast, [Scope.ScopeMb]) +interpretateLisp value stack = case AstEval.evalAst stack value of + (Left err, _) -> Left err + (Right res', stack') -> Right (res', stack') + -- | Infinite loop until EOF from the user inputLoop :: [Scope.ScopeMb] -> IO () -- inputLoop = print inputLoop stack = isEOF >>= \end -> if end then print "End of Interpretation GLaDOS" else getLine >>= \line -> case runParser parseLobster (0, 0) line of Left err -> putStrLn ("\ESC[34m\ESC[1mThe lobster is angry: " ++ err ++ "\ESC[0m") >> inputLoop stack - Right (res, _, _) -> interpretateInfo res stack + Right (res, [], _) -> interpretateInfo res stack + Right (_, _, pos) -> putStrLn ("\ESC[34m\ESC[1mThe lobster is angry: " ++ errorParsing pos ++ "\ESC[0m") >> inputLoop stack interpretateInfo :: [AST.Ast] -> [Scope.ScopeMb] -> IO () interpretateInfo [] stack = inputLoop stack @@ -43,7 +52,7 @@ compileInfo (x:xs) stack = case interpretateLisp x stack of compileFile :: String -> IO () compileFile s = case runParser parseLobster (0, 0) s of Left err -> print err >> exitWith (ExitFailure 84) - Right (res, [], _) -> compileInfo res [] + Right (res, [], _) -> print res >> compileInfo res [] Right (_, _, (row, col)) -> print ("Error on parsing on '" ++ show row ++ "' '" ++ show col) -- (Right (Just res), stack') -> let instructions = (astToInstructions (AST.Cond (Boolean True) (Value 1) (Just (AST.Call "CallHere" [(Value 0)])))) in showInstructions instructions >> writeCompiledInstructionsToFile "output" (compileInstructions instructions) diff --git a/LobsterLang/src/AstEval.hs b/LobsterLang/src/AstEval.hs index 8f64209..0930131 100644 --- a/LobsterLang/src/AstEval.hs +++ b/LobsterLang/src/AstEval.hs @@ -6,8 +6,7 @@ -} module AstEval - ( sexprToAst, - evalAst, + ( evalAst, evalBiValOp, evalBiBoolOp, evalBiCompValOp, @@ -16,22 +15,8 @@ where import AST import Data.Bifunctor -import SExpr import Scope --- | Convert a S-expression into an 'Ast', --- return Nothing if the expression is invalid or Just the Ast -sexprToAst :: SExpr -> Maybe Ast -sexprToAst (SExpr.List [SExpr.Symbol "define", SExpr.Symbol s, t]) = - Define s <$> sexprToAst t -sexprToAst (SExpr.List (SExpr.Symbol f : xs)) = - Call f <$> mapM sexprToAst xs -sexprToAst (SExpr.List _) = Nothing -sexprToAst (SExpr.Value i) = Just (AST.Value i) -sexprToAst (SExpr.Symbol "true") = Just (Boolean True) -sexprToAst (SExpr.Symbol "false") = Just (Boolean False) -sexprToAst (SExpr.Symbol s) = Just (AST.Symbol s Nothing) - -- | Evaluate a 'Ast'. -- Takes a stack representing variables and the Ast to evaluate. -- Returns a tuple containing either the resulting Ast diff --git a/LobsterLang/src/Parse.hs b/LobsterLang/src/Parse.hs index 8530f82..e0b2ed8 100644 --- a/LobsterLang/src/Parse.hs +++ b/LobsterLang/src/Parse.hs @@ -23,24 +23,23 @@ module Parse ( parseDigit, parseBool, parseAst, - parseSymbol, parseElem, parseValue, parseLobster, parseAnyString, - parseSpace, - parseLine, - interpretateLisp, parseDefineValue, parseUnaryOperation, parseProduct, parseSum, - parseExpr + parseExpr, + parseTrue, + parseFalse, + parseAstString, + parseWhiteSpace, + errorParsing ) where -import qualified AstEval import qualified AST -import qualified Scope import Control.Applicative import Data.Maybe @@ -104,7 +103,7 @@ instance Monad Parser where ) errorParsing :: (Int, Int) -> String -errorParsing (row, col) = "Error on parsing on '" ++ show row ++ "' '" ++ show col +errorParsing (row, col) = "Error on parsing on '" ++ show row ++ "' '" ++ show col ++ "'" startCharacter :: String startCharacter = ['a'..'z'] ++ ['A'..'Z'] ++ "_" @@ -201,20 +200,13 @@ parseInt = Parser f f pos ('-':xs) = runParser ((\x -> -x) <$> parseUInt) pos xs f pos s = runParser parseUInt pos s --- | Return a data Parser that parse multiple space -parseSpace :: Parser [Char] -parseSpace = parseMany (parseChar ' ' <|> parseChar '\n') - -parseLine :: Parser [Char] -parseLine = parseMany (parseChar '\n') - parseWhiteSpace :: Parser [Char] -parseWhiteSpace = parseSpace <|> parseLine +parseWhiteSpace = parseMany (parseAnyChar "\n\t ") -- | Parse with a parser and, if possible with a space -- Return a Parser that parse element with the given parser and, if possible with multiple space parseElem :: Parser a -> Parser a -parseElem parser = parseAndWith (\x _ -> x) parser parseSpace <|> parser +parseElem parser = parseAndWith (\x _ -> x) parser parseWhiteSpace <|> parser -- | Return a data Parser that parse a String parseString :: Parser String @@ -224,19 +216,22 @@ parseString = parseWhiteSpace *> Parser f <* parseWhiteSpace f pos s = case runParser (parseSome (parseAnyChar startCharacter)) pos s of Left err -> Left err Right (res, s', pos') -> case runParser (parseMany (parseAnyChar lobsterCharacter)) pos' s' of - Left _ -> Right (res ++ res, s', pos') + Left _ -> Right (res, s', pos') Right (res', s'', pos'') -> Right (res ++ res', s'', pos'') -- | Return a data Parser that parse a String as a Symbol -parseSymbol :: Parser AST.Ast -parseSymbol = AST.String <$> parseElem parseString +parseAstString :: Parser AST.Ast +parseAstString = AST.String <$> (parseChar '"' *> parseElem parseString <* parseChar '"') + +-- parseSymbol :: Parser AST.Ast +-- parseSymbol = AST.Symbol <$> parseElem parseString parseExpr :: Parser AST.Ast parseExpr = parseCombinatorOperator parseCombinatorOperator :: Parser AST.Ast parseCombinatorOperator = do res <- parseBoolOperator - res' <- optional (parseChar '$' + res' <- optional (parseWhiteSpace *> parseChar '$' >>= \res' -> parseCombinatorOperator >>= \res'' -> return $ AST.Call [res'] [res, res'']) return $ fromMaybe res res' @@ -252,35 +247,35 @@ parseBoolOperator = do res <- parseCompOperator parseCompOperator :: Parser AST.Ast parseCompOperator = do res <- parseSum - res' <- optional (parseAnyString "==" <|> - parseAnyString ">=" <|> - parseAnyString "!=" <|> - parseAnyString "<=" <|> - parseAnyString ">" <|> - parseAnyString "<" + res' <- optional (parseWhiteSpace *> parseAnyString "==" <|> + parseWhiteSpace *> parseAnyString ">=" <|> + parseWhiteSpace *> parseAnyString "!=" <|> + parseWhiteSpace *> parseAnyString "<=" <|> + parseWhiteSpace *> parseAnyString ">" <|> + parseWhiteSpace *> parseAnyString "<" >>= \res' -> parseCompOperator >>= \res'' -> return $ AST.Call res' [res, res'']) return $ fromMaybe res res' parseSum :: Parser AST.Ast parseSum = do res <- parseProduct - res' <- optional (parseAnyChar "+-" + res' <- optional (parseWhiteSpace *> parseAnyChar "+-" >>= \res' -> parseSum >>= \res'' -> return $ AST.Call [res'] [res, res'']) return $ fromMaybe res res' parseProduct :: Parser AST.Ast parseProduct = do res <- parseListOperator - res' <- optional (parseAnyChar "*/" + res' <- optional (parseWhiteSpace *> parseAnyChar "*/%" >>= \res' -> parseProduct >>= \res'' -> return $ AST.Call [res'] [res, res'']) return $ fromMaybe res res' parseListOperator :: Parser AST.Ast parseListOperator = do res <- parseValue - res' <- optional (parseAnyString "--" <|> - parseAnyString "++" <|> - parseAnyString "!!" + res' <- optional (parseWhiteSpace *> parseAnyString "--" <|> + parseWhiteSpace *> parseAnyString "++" <|> + parseWhiteSpace *> parseAnyString "!!" >>= \res' -> parseListOperator >>= \res'' -> return $ AST.Call res' [res, res'']) return $ fromMaybe res res' @@ -288,9 +283,8 @@ parseListOperator = do res <- parseValue -- | Return a data Parser that parse a Int as a Value parseValue :: Parser AST.Ast parseValue = parseWhiteSpace *> ( - parseAnyString "(|" *> parseExpr <* parseAnyString "|)" + parseWhiteSpace *> parseAnyString "(|" *> parseExpr <* parseAnyString "|)" <* parseWhiteSpace <|> AST.Value <$> parseElem parseInt - <|>parseSymbol ) -- | Parse a list of element @@ -298,9 +292,9 @@ parseValue = parseWhiteSpace *> ( parseList :: Parser a -> Parser [a] parseList parser = parseStart *> parseListValue <* parseEnd where - parseEnd = parseChar ')' <* parseSpace - parseListValue = parseSpace *> parseMany (parseElem parser) <* parseSpace - parseStart = parseSpace *> parseChar '(' + parseEnd = parseChar ')' <* parseWhiteSpace + parseListValue = parseWhiteSpace *> parseMany (parseElem parser) <* parseWhiteSpace + parseStart = parseWhiteSpace *> parseChar '(' -- | Parse any character from a String -- Return a Parser that parse every character from a String @@ -330,7 +324,7 @@ parseAnyString s = Parser (f s s) -- | Return a Parser that parse a Bool (#f or #t) parseBool :: Parser AST.Ast -parseBool = AST.Boolean <$> (parseTrue <|> parseFalse) +parseBool = AST.Boolean <$> (parseTrue <|> parseFalse) <* parseWhiteSpace -- | Return a PArser that parse a True (in lisp -> #t) parseTrue :: Parser Bool @@ -379,22 +373,17 @@ parseUnaryOperation = Parser f -- | Return a Parser that parse a SExpr parseAst :: Parser AST.Ast -parseAst = - parseWhiteSpace *> parseDefineValue - <|> parseWhiteSpace *> parseExpr - <|> parseWhiteSpace *> parseUnaryOperation - <|> parseWhiteSpace *> parseBool - <|> parseWhiteSpace *> parseSymbol - <|> parseWhiteSpace *> parseValue +parseAst = parseWhiteSpace *> + ( + parseDefineValue + <|> parseExpr + <|> parseUnaryOperation + <|> parseBool + <|> parseAstString + <|> parseValue + <|> parseAstString + ) parseLobster :: Parser [AST.Ast] -parseLobster = parseSome parseAst - --- | Return a Result that contain the evaluation of our Lisp String --- Takes as parameter the string that need to be evaluated and the Stack (Environment) -interpretateLisp :: AST.Ast -> [Scope.ScopeMb] -> Either String (Maybe AST.Ast, [Scope.ScopeMb]) -interpretateLisp value stack = case AstEval.evalAst stack value of - (Left err, _) -> Left err - (Right res', stack') -> Right (res', stack') - +parseLobster = parseSome (parseWhiteSpace *> parseAst) diff --git a/LobsterLang/test/ParserSpec.hs b/LobsterLang/test/ParserSpec.hs new file mode 100644 index 0000000..a14f74f --- /dev/null +++ b/LobsterLang/test/ParserSpec.hs @@ -0,0 +1,184 @@ +{- +-- EPITECH PROJECT, 2023 +-- ParserSpec.hs +-- File description: +-- ParserSpec +-} + +module ParserSpec where + +import Test.Hspec +import Parse +import Parse (parseExpr, parseDefineValue, errorParsing, parseBool, parseLobster, parseString, parseMany) +import qualified AST +import AST (Ast(Value)) + +spec :: Spec +spec = do + describe "ParserTest" $ do + it "Check parseChar Success" $ do + runParser (parseChar ' ') (0,0) " Hello" `shouldBe` Right (' ', "Hello", (0,1)) + it "Check parseChar Failure" $ do + runParser (parseChar ' ') (0,0) "Hello" `shouldBe` Left (errorParsing (0, 0)) + it "Check parseOr Success first arg" $ do + runParser (parseOr (parseChar 'a') (parseChar ' ')) (0,0) "aHello" `shouldBe` Right ('a', "Hello", (0,1)) + it "Check parseOr Success second arg" $ do + runParser (parseOr (parseChar 'a') (parseChar ' ')) (0,0) " Hello" `shouldBe` Right (' ', "Hello", (0,1)) + it "Check parseOr Failure" $ do + runParser (parseOr (parseChar 'f') (parseChar 'O')) (0,0) " Oui" `shouldBe` Left (errorParsing (0,0)) + it "Check parseAnd Success" $ do + runParser (parseAnd (parseChar 'a') (parseChar 'p')) (0,0) "apHello" `shouldBe` Right (('a', 'p'), "Hello", (0,2)) + it "Check parseAnd Failure" $ do + runParser (parseAnd (parseChar 'e') (parseChar 'p')) (0,0) "apHello" `shouldBe` Left (errorParsing (0,0)) + it "Check parseAndWith Number Success" $ do + runParser (parseAndWith (\x y -> [x, y]) (parseAnyChar ['0'..'9']) (parseAnyChar ['0'..'9'])) (0,0) "42Hello" `shouldBe` Right ("42", "Hello", (0, 2)) + it "Check parseAndWith Character Success" $ do + runParser (parseAndWith (\x y -> [x, y]) (parseAnyChar ['a'..'z']) (parseAnyChar ['a'..'z'])) (0,0) "ohHello" `shouldBe` Right ("oh", "Hello", (0, 2)) + it "Check parseAndWith Failure" $ do + runParser (parseAndWith (\x y -> [x, y]) (parseAnyChar ['a'..'z']) (parseAnyChar ['0'..'9'])) (0,0) "42Hello" `shouldBe` Left (errorParsing (0,0)) + it "Check parseMany Character Success" $ do + runParser (parseMany (parseAnyChar ['a'..'z'])) (0,0) "bonjournoHello" `shouldBe` Right ("bonjourno", "Hello", (0,9)) + it "Check parseMany Number Success" $ do + runParser (parseMany (parseAnyChar ['0'..'9'])) (0,0) "424554Hello" `shouldBe` Right ("424554", "Hello", (0,6)) + it "Check parseMany Failure" $ do + runParser (parseMany (parseAnyChar ['0'..'9'])) (0,0) "Hello" `shouldBe` Right ("", "Hello", (0,0)) + it "Check parseSome Number Success" $ do + runParser (parseSome (parseAnyChar ['0'..'9'])) (0,0) "042Hello" `shouldBe` Right ("042", "Hello", (0,3)) + it "Check parseSome Character Success" $ do + runParser (parseSome (parseAnyChar ['a'..'z'])) (0,0) "buenos42Hello" `shouldBe` Right ("buenos", "42Hello", (0,6)) + it "Check parseSome Failure" $ do + runParser (parseSome (parseAnyChar ['0'..'9'])) (0,0) "HelloWorld" `shouldBe` Left (errorParsing (0,0)) + it "Check parseUInt Success" $ do + runParser parseUInt (0,0) "5463Hello" `shouldBe` Right (5463, "Hello", (0,4)) + it "Check parseUInt Failure" $ do + runParser parseUInt (0,0) "Hola" `shouldBe` Left (errorParsing (0,0)) + it "Check parseUInt Empty" $ do + runParser parseUInt (0,0) "" `shouldBe` Left (errorParsing (0,0)) + it "Check parseUInt Negative Value Failure" $ do + runParser parseUInt (0,0) "-42Hello" `shouldBe` Left (errorParsing (0,0)) + it "Check parseInt Success" $ do + runParser parseInt (0,0) "4234Hello" `shouldBe` Right (4234, "Hello", (0, 4)) + it "Check parseInt Negative Value Success" $ do + runParser parseInt (0,0) "-42Hello" `shouldBe` Right (-42, "Hello", (0,2)) + it "Check parseInt Failure" $ do + runParser parseInt (0,0) "Hello" `shouldBe` Left (errorParsing (0,0)) + it "Check parsesign '-' Success" $ do + runParser parseSign (0,0) "-llg" `shouldBe` Right ('-', "llg", (0,1)) + it "Check parsesign '+' Success" $ do + runParser parseSign (0,0) "+llg" `shouldBe` Right ('+', "llg", (0,1)) + it "Check parsesign Failure" $ do + runParser parseSign (0,0) "lg" `shouldBe` Left (errorParsing (0,0)) + it "Check parseString Success n°1" $ do + runParser parseString (0,0) "bonjourno " `shouldBe` Right ("bonjourno", "", (0,10)) + it "Check parseString Success n°2" $ do + runParser parseString (0,0) "bon12*/p journo " `shouldBe` Right ("bon12", "*/p journo ", (0,5)) + it "Check parseString Failure" $ do + runParser parseString (0,0) "^bon12*/p journo " `shouldBe` Left (errorParsing (0,0)) + it "Check parseElem with parseInt Success" $ do + runParser (parseElem parseInt) (0,0) "12 " `shouldBe` Right (12, "", (0,3)) + it "Check parseElem with parseString Success" $ do + runParser (parseElem parseString) (0,0) "hello la " `shouldBe` Right ("hello", "la ", (0,6)) + it "Check parseValue Success" $ do + runParser parseValue (0,0) "432 la " `shouldBe` Right (AST.Value 432, "la ", (0,14)) + it "Check parseList with parseInt Success" $ do + runParser (parseList parseInt) (0,0) "(1 2 3 4 5)" `shouldBe` Right ([1, 2 ,3 , 4, 5], "", (0, 13)) + it "Check parseList with parseInt Failure (without a number inside)" $ do + runParser (parseList parseInt) (0,0) "(1 2 3 d 4 5) (0,0) " `shouldBe` Left (errorParsing (0,8)) + it "Check parseList with parseInt Failure (without a ending ')')" $ do + runParser (parseList parseInt) (0,0) "(1 2 3 4 5 " `shouldBe` Left (errorParsing (0,12)) + it "Check parseList with parseInt Failure (without a starting '(')" $ do + runParser (parseList parseInt) (0,0) "1 2 3 4 5)" `shouldBe` Left (errorParsing (0,0)) + it "Check parseList with parseString Success" $ do + runParser (parseList parseString) (0,0) "(buenos owow k ye )1 2 3 4 5)" `shouldBe` Right (["buenos", "owow", "k", "ye"], "1 2 3 4 5)", (0, 22)) + it "Check parseList with parseString Failure" $ do + runParser (parseList parseString) (0,0) "(buenos 3 owow k ye )1 2 3 4 5)" `shouldBe` Left (errorParsing (0,8)) + it "Check parseBool true Success" $ do + runParser parseBool (0,0) "true lp" `shouldBe` Right (AST.Boolean True, "lp", (0,5)) + it "Check parseBool false Success" $ do + runParser parseBool (0,0) "false lp" `shouldBe` Right (AST.Boolean False, "lp", (0,6)) + it "Check parseBool Failure" $ do + runParser parseBool (0,0) "#tlp" `shouldBe` Left (errorParsing (0,0)) + it "Check parseExpr Simple Addition Success" $ do + runParser parseExpr (0,0) "3 + 5" `shouldBe` Right (AST.Call "+" [AST.Value 3,AST.Value 5],"",(0,5)) + it "Check parseExpr Simple Multiplication Success" $ do + runParser parseExpr (0,0) "3 * 3" `shouldBe` Right (AST.Call "*" [AST.Value 3,AST.Value 3],"",(0,5)) + it "Check parseExpr Simple Substration Success" $ do + runParser parseExpr (0,0) "3 - 3" `shouldBe` Right (AST.Call "-" [AST.Value 3, AST.Value 3],"",(0,5)) + it "Check parseExpr Simple Division Success" $ do + runParser parseExpr (0,0) "3 / 3" `shouldBe` Right (AST.Call "/" [AST.Value 3, AST.Value 3],"",(0,5)) + it "Check parseExpr Simple Modulo Success" $ do + runParser parseExpr (0,0) "3 % 3" `shouldBe` Right (AST.Call "%" [AST.Value 3, AST.Value 3],"",(0,5)) + it "Check parseExpr Multiple Addition Success" $ do + runParser parseExpr (0, 0) "3 + 3 + 5 + 1" `shouldBe` Right (AST.Call "+" [AST.Value 3,AST.Call "+" [AST.Value 3,AST.Call "+" [AST.Value 5,AST.Value 1]]],"",(0,13)) + it "Check parseExpr Multiple Multiplication Success" $ do + runParser parseExpr (0, 0) "3 * 3 * 5 * 4" `shouldBe` Right (AST.Call "*" [AST.Value 3,AST.Call "*" [AST.Value 3,AST.Call "*" [AST.Value 5,AST.Value 4]]],"",(0,13)) + it "Check parseExpr with parenthesis Success" $ do + runParser parseExpr (0, 0) "3 * (| 3 + 4 |)" `shouldBe` Right (AST.Call "*" [AST.Value 3,AST.Call "+" [AST.Value 3,AST.Value 4]],"",(0,15)) + it "Check parseExpr with Multiple parenthesis Success n°1" $ do + runParser parseExpr (0, 0) "3 * (| 3 + (| 3 * (| 6 - 2 |)|)|)" `shouldBe` Right (AST.Call "*" [AST.Value 3,AST.Call "+" [AST.Value 3,AST.Call "*" [AST.Value 3,AST.Call "-" [AST.Value 6,AST.Value 2]]]],"",(0,33)) + it "Check parseExpr with Multiple parenthesis Success n°2" $ do + runParser parseExpr (0, 0) "3 + (| 64 - 34 |) + 54 * 43" `shouldBe` Right (AST.Call "+" [AST.Value 3,AST.Call "+" [AST.Call "-" [AST.Value 64,AST.Value 34],AST.Call "*" [AST.Value 54,AST.Value 43]]],"",(0,27)) + it "Check parseExpr with Multiple parenthesis Success n°3" $ do + runParser parseExpr (0, 0) "(| 34 + (| 43 - 123 |)|) + (| 4 + (| 23 - 4 |)|)" `shouldBe` Right (AST.Call "+" [AST.Call "+" [AST.Value 34,AST.Call "-" [AST.Value 43,AST.Value 123]],AST.Call "+" [AST.Value 4,AST.Call "-" [AST.Value 23,AST.Value 4]]],"",(0,48)) + it "Check parseExpr with Operator '==' Success" $ do + runParser parseExpr (0, 0) "3 == 3" `shouldBe` Right (AST.Call "==" [AST.Value 3,AST.Value 3],"",(0,6)) + it "Check parseExpr with Operator '>=' Success" $ do + runParser parseExpr (0, 0) "3 >= 3" `shouldBe` Right (AST.Call ">=" [AST.Value 3,AST.Value 3],"",(0,6)) + it "Check parseExpr with Operator '<=' Success" $ do + runParser parseExpr (0, 0) "3 <= 3" `shouldBe` Right (AST.Call "<=" [AST.Value 3,AST.Value 3],"",(0,6)) + it "Check parseExpr with Operator '>' Success" $ do + runParser parseExpr (0, 0) "3 > 3" `shouldBe` Right (AST.Call ">" [AST.Value 3,AST.Value 3],"",(0,5)) + it "Check parseExpr with Operator '<' Success" $ do + runParser parseExpr (0, 0) "3 < 3" `shouldBe` Right (AST.Call "<" [AST.Value 3,AST.Value 3],"",(0,5)) + it "Check parseExpr with Operator '!=' Success" $ do + runParser parseExpr (0, 0) "3 != 3" `shouldBe` Right (AST.Call "!=" [AST.Value 3,AST.Value 3],"",(0,6)) + it "Check parseExpr with Operator '!!' Success" $ do + runParser parseExpr (0, 0) "3 !! 3" `shouldBe` Right (AST.Call "!!" [AST.Value 3,AST.Value 3],"",(0,6)) + it "Check parseExpr with Operator '++' Success" $ do + runParser parseExpr (0, 0) "3 ++ 3" `shouldBe` Right (AST.Call "++" [AST.Value 3,AST.Value 3],"",(0,6)) + it "Check parseExpr with Operator '--' Success" $ do + runParser parseExpr (0, 0) "3 -- 3" `shouldBe` Right (AST.Call "--" [AST.Value 3,AST.Value 3],"",(0,6)) + it "Check parseExpr with Operator '&&' Success" $ do + runParser parseExpr (0, 0) "3 && 3" `shouldBe` Right (AST.Call "&&" [AST.Value 3,AST.Value 3],"",(0,6)) + it "Check parseExpr with Operator '||' Success" $ do + runParser parseExpr (0, 0) "3 || 3" `shouldBe` Right (AST.Call "||" [AST.Value 3,AST.Value 3],"",(0,6)) + it "Check parseExpr with Operator '^^' Success" $ do + runParser parseExpr (0, 0) "3 ^^ 3" `shouldBe` Right (AST.Call "^^" [AST.Value 3,AST.Value 3],"",(0,6)) + it "Check parseExpr with Operator '$' Success" $ do + runParser parseExpr (0, 0) "3 $ 3" `shouldBe` Right (AST.Call "$" [AST.Value 3,AST.Value 3],"",(0,5)) + it "Check parseExpr Big Expression Success n°1" $ do + runParser parseExpr (0, 0) "(|3 + (| 4 * 23 |) |) == (|3 + 5 + (|54 - 2|)|) && (| 4 * 43 |)" `shouldBe` Right (AST.Call "&&" [AST.Call "==" [AST.Call "+" [AST.Value 3,AST.Call "*" [AST.Value 4,AST.Value 23]],AST.Call "+" [AST.Value 3,AST.Call "+" [AST.Value 5,AST.Call "-" [AST.Value 54,AST.Value 2]]]],AST.Call "*" [AST.Value 4,AST.Value 43]],"",(0,63)) + it "Check parseExpr Big Expression Success n°2" $ do + runParser parseExpr (0, 0) "(|3 + (| 4 * 23 |) |) == (|3 + 5 + (|54 - 2|)|) && (| 4 * 43 |) $ (|3 + 3 * (| 65 - 4 |) |)" `shouldBe` Right (AST.Call "$" [AST.Call "&&" [AST.Call "==" [AST.Call "+" [AST.Value 3,AST.Call "*" [AST.Value 4,AST.Value 23]],AST.Call "+" [AST.Value 3,AST.Call "+" [AST.Value 5,AST.Call "-" [AST.Value 54,AST.Value 2]]]],AST.Call "*" [AST.Value 4,AST.Value 43]],AST.Call "+" [AST.Value 3,AST.Call "*" [AST.Value 3,AST.Call "-" [AST.Value 65,AST.Value 4]]]],"",(0,91)) + it "Check parseExpr Define Value Success" $ do + runParser parseDefineValue (0,0) "a = 3" `shouldBe` Right (AST.Define "a" (AST.Value 3),"",(0,5)) + it "Check parseExpr Define Expression Success" $ do + runParser parseDefineValue (0,0) "a = (| 3 + 5 |)" `shouldBe` Right (AST.Define "a" (AST.Call "+" [AST.Value 3,AST.Value 5]),"",(0,15)) + it "Check parseExpr Define Value Boolean Success" $ do + runParser parseDefineValue (0, 0) "a=true" `shouldBe` Right (AST.Define "a" (AST.Boolean True),"",(0,6)) + it "Check parseExpr Define Failure (incorrect value name)" $ do + runParser parseDefineValue (0, 0) "23=true" `shouldBe` Left (errorParsing (0,0)) + it "Check parseExpr Define Failure (missing operator '=')" $ do + runParser parseDefineValue (0, 0) "a " `shouldBe` Left (errorParsing (0,2)) + it "Check parseExpr Define Failure (missing AST Value)" $ do + runParser parseDefineValue (0, 0) "a =" `shouldBe` Left (errorParsing (0,3)) + it "Check parseExpr String Value Success" $ do + runParser parseAstString (0, 0) "\"a\"" `shouldBe` Right (AST.String "a" ,"",(0,3)) + it "Check parseExpr WhiteSpace Value Success" $ do + runParser parseWhiteSpace (0, 0) "\t\t\n" `shouldBe` Right ("\t\t\n" ,"",(1,0)) + it "Check parseBool Failure" $ do + runParser parseBool (0, 0) "fla" `shouldBe` Left (errorParsing (0,1)) + it "Check parseTrue Failure" $ do + runParser parseTrue (0, 0) "fla" `shouldBe` Left (errorParsing (0,0)) + it "Check parseLobster Success" $ do + runParser parseLobster (0,0) "a = 3 \"a\"" `shouldBe` Right ([AST.Define "a" (AST.Value 3),AST.String "a"],"",(0,9)) + it "Check parseString Success" $ do + runParser parseString (0,0) "_Lob3ster*" `shouldBe` Right ("_Lob3ster","*",(0,9)) + it "Check parseMany Success" $ do + runParser (parseMany (parseChar ' ')) (0,0) " p" `shouldBe` Right (" ","p",(0,1)) + it "Check parseUnaryOperation Success" $ do + runParser parseUnaryOperation (0,0) "! true" `shouldBe` Right (AST.Call "!" [AST.Boolean True],"",(0,6)) + it "Check parseUnaryOperation Failure (incorrect AST)" $ do + runParser parseUnaryOperation (0,0) "! *" `shouldBe` Left (errorParsing (0,2)) + it "Check parseUnaryOperation Failure (missing operator)" $ do + runParser parseUnaryOperation (0,0) "error" `shouldBe` Left (errorParsing (0,0)) diff --git a/Makefile b/Makefile index 262a524..ef08070 100644 --- a/Makefile +++ b/Makefile @@ -29,7 +29,7 @@ fclean: clean re: fclean all tests_run: - cd $(PKG_NAME) && stack test --coverage + cd $(PKG_NAME) && stack test cov: cd $(PKG_NAME) && stack test --coverage 2> >(tail -n 1 > $(COV_PATH_FILE)) From c4d03e7afb79afec60c0c2146cf1649d576a750b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Timoth=C3=A9?= Date: Thu, 11 Jan 2024 20:06:11 +0100 Subject: [PATCH 11/11] feature(boolean): parseBoolean as a AST Value in expression --- LobsterLang/src/Parse.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/LobsterLang/src/Parse.hs b/LobsterLang/src/Parse.hs index e0b2ed8..8f7f7cc 100644 --- a/LobsterLang/src/Parse.hs +++ b/LobsterLang/src/Parse.hs @@ -285,6 +285,7 @@ parseValue :: Parser AST.Ast parseValue = parseWhiteSpace *> ( parseWhiteSpace *> parseAnyString "(|" *> parseExpr <* parseAnyString "|)" <* parseWhiteSpace <|> AST.Value <$> parseElem parseInt + <|> parseBool ) -- | Parse a list of element @@ -377,8 +378,8 @@ parseAst = parseWhiteSpace *> ( parseDefineValue <|> parseExpr - <|> parseUnaryOperation <|> parseBool + <|> parseUnaryOperation <|> parseAstString <|> parseValue <|> parseAstString