diff --git a/LobsterLang/app/Main.hs b/LobsterLang/app/Main.hs index 917a7d3..8fbadab 100644 --- a/LobsterLang/app/Main.hs +++ b/LobsterLang/app/Main.hs @@ -13,14 +13,20 @@ import System.IO (isEOF) import System.Exit (exitWith, ExitCode (ExitFailure)) import System.Environment (getArgs) import qualified AstEval +import qualified AstOptimizer +import qualified Compiler import Control.Exception import qualified AST --- import Compiler +import AstOptimizer (optimizeAst) + + +lobsterNotHappy :: String -> String -> String -> String +lobsterNotHappy color state str = "\ESC[" ++ color ++ "m\ESC[1mThe lobster is " ++ state ++ ": " ++ str ++ "\ESC[0m" -- | 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 +interpretateLobster :: AST.Ast -> [Scope.ScopeMb] -> Either String (Maybe AST.Ast, [Scope.ScopeMb]) +interpretateLobster value stack = case AstEval.evalAst stack value of (Left err, _) -> Left err (Right res', stack') -> Right (res', stack') @@ -29,40 +35,43 @@ 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 + Left err -> putStrLn (lobsterNotHappy "34" "angry" err) >> inputLoop stack Right (res, [], _) -> interpretateInfo res stack - Right (_, _, pos) -> putStrLn ("\ESC[34m\ESC[1mThe lobster is angry: " ++ errorParsing pos ++ "\ESC[0m") >> inputLoop stack + Right (_, _, pos) -> putStrLn (lobsterNotHappy "31" "angry" (errorParsing pos)) >> inputLoop stack 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 +interpretateInfo (x:xs) stack = case interpretateLobster x stack of + Left err -> putStrLn (lobsterNotHappy "31" "angry" err) >> inputLoop stack Right (res, stack') -> case res of Nothing -> interpretateInfo xs stack' Just value -> print value >> interpretateInfo xs stack' -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) - Right (res, stack') -> case res of - Nothing -> compileInfo xs stack' - Just value -> print value >> compileInfo xs stack' +checkCompileInfo :: [Either AstOptimizer.AstError AstOptimizer.AstOptimised] -> [Either AstOptimizer.AstError AstOptimizer.AstOptimised] -> IO [Either AstOptimizer.AstError AstOptimizer.AstOptimised] +checkCompileInfo [] list = return list +checkCompileInfo (x:xs) list = case x of + Left (AstOptimizer.Error err ast) -> putStrLn (lobsterNotHappy "31" "angry" (err ++ " caused by: " ++ show ast)) >> checkCompileInfo xs (list ++ [x]) + Right (AstOptimizer.Result _) -> checkCompileInfo xs (list ++ [x]) + Right (AstOptimizer.Warning warning ast) -> putStrLn (lobsterNotHappy "33" "worried" (warning ++ " optimize to" ++ show ast)) >> checkCompileInfo xs (list ++ [x]) -compileFile :: String -> IO () -compileFile s = case runParser parseLobster (0, 0) s of - Left err -> print err >> exitWith (ExitFailure 84) - 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) +compileInfo :: String -> [AST.Ast] -> [Scope.ScopeMb] -> IO () +compileInfo _ [] _ = putStr "" +compileInfo filename list stack = checkCompileInfo (optimizeAst stack list False) [] >>= \res -> case sequence res of + Left _ -> exitWith (ExitFailure 84) + Right value -> Compiler.compile (map AstOptimizer.fromOptimised value) (filename ++ ".o") True +compileFile :: String -> String -> IO () +compileFile file s = case runParser parseLobster (0, 0) s of + Left err -> print err >> exitWith (ExitFailure 84) + Right (res, [], _) -> compileInfo file res [] + Right (_, _, pos) -> putStrLn (lobsterNotHappy "34" "angry" (errorParsing pos)) checkArgs :: [String] -> IO () checkArgs [] = print "Launch Interpreter" >> inputLoop [] checkArgs (file:_) = either (\_ -> print "File doesn't exist" >> exitWith (ExitFailure 84)) - compileFile - =<< (try (readFile file) :: IO (Either SomeException String)) + (compileFile file) + =<< (try (readFile file) :: IO (Either SomeException String)) -- | Main main :: IO () diff --git a/LobsterLang/src/AstOptimizer.hs b/LobsterLang/src/AstOptimizer.hs index 3550c1d..72f5d93 100644 --- a/LobsterLang/src/AstOptimizer.hs +++ b/LobsterLang/src/AstOptimizer.hs @@ -7,6 +7,7 @@ module AstOptimizer ( optimizeAst, + fromOptimised, AstError (..), AstOptimised (..), ) @@ -55,7 +56,14 @@ optimizeAst stack ((Define n ast) : xs) inFunc = case optimizeAst stack [ast] in | inFunc -> Right (Result (Define n opAst)) : optimizeAst stack xs inFunc | otherwise -> Left (Error ('S' : 'y' : 'm' : 'b' : 'o' : 'l' : ' ' : '\'' : xs') (Define n opAst)) : optimizeAst stack xs inFunc (Left err, _) -> Left (Error err (Define n opAst)) : optimizeAst stack xs inFunc - [Right (Warning mes opAst)] -> Right (Warning mes (Define n opAst)) : optimizeAst stack xs inFunc + [Right (Warning mes opAst)] -> case evalAst stack (Define n opAst) of + (Right _, stack') -> Right (Warning mes (Define n opAst)) : optimizeAst stack' xs inFunc + (Left ('R' : 'e' : 'c' : 'u' : 'r' : 's' : 'i' : 'o' : 'n' : _), stack') -> + Right (Warning "Possible infinite recursion" (Define n opAst)) : optimizeAst stack' xs inFunc + (Left ('S' : 'y' : 'm' : 'b' : 'o' : 'l' : ' ' : '\'' : xs'), _) + | inFunc -> Right (Result (Define n opAst)) : optimizeAst stack xs inFunc + | otherwise -> Left (Error ('S' : 'y' : 'm' : 'b' : 'o' : 'l' : ' ' : '\'' : xs') (Define n opAst)) : optimizeAst stack xs inFunc + (Left err, _) -> Left (Error err (Define n opAst)) : optimizeAst stack xs inFunc _ -> shouldntHappen stack (Define n ast : xs) inFunc optimizeAst stack ((Symbol s Nothing) : xs) inFunc | inFunc = Right (Result (Symbol s Nothing)) : optimizeAst stack xs inFunc diff --git a/LobsterLang/test/AstOptimizerSpec.hs b/LobsterLang/test/AstOptimizerSpec.hs index b3bbf9b..3724ed6 100644 --- a/LobsterLang/test/AstOptimizerSpec.hs +++ b/LobsterLang/test/AstOptimizerSpec.hs @@ -162,4 +162,4 @@ spec = do it "Infinite recursion" $ do optimizeAst [Variable "eh" (FunctionValue ["x"] (Symbol "eh" (Just [Symbol "x" Nothing])) Nothing) 0] [Symbol "eh" (Just [AST.Value 1])] False `shouldBe` [Right (Warning "Possible infinite recursion" (Symbol "eh" (Just [AST.Value 1])))] it "Infinite recursion in define" $ do - optimizeAst [Variable "eh" (FunctionValue ["x"] (Symbol "eh" (Just [Symbol "x" Nothing])) Nothing) 0] [Define "a" (Symbol "eh" (Just [AST.Value 1]))] False `shouldBe` [Right (Warning "Possible infinite recursion" (Define "a" (Symbol "eh" (Just [AST.Value 1]))))] + optimizeAst [Variable "eh" (FunctionValue ["x"] (Symbol "eh" (Just [Symbol "x" Nothing])) Nothing) 0] [Define "a" (Symbol "eh" (Just [AST.Value 1]))] False `shouldBe` [Right (Warning "Possible infinite recursion" (Define "a" (Symbol "eh" (Just [Value 1]))))] diff --git a/ParseSpec.hs b/ParseSpec.hs deleted file mode 100644 index b7a8c7a..0000000 --- a/ParseSpec.hs +++ /dev/null @@ -1,127 +0,0 @@ -{- --- EPITECH PROJECT, 2023 --- GLaDOS --- File description: --- ParseSpec --} - -module ParseSpec where - -import Test.Hspec -import Parse -import qualified SExpr -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", []) - - - -- "(define vie 42)" - -- "(define (fact x))" - -- "(+ (* 2 3) (div 10 2))" - -- it "returns the first element of a list" $ do - -- head [23 ..] `shouldBe` (23 :: Int) - - -- it "returns the first element of an *arbitrary* list" $ - -- property $ \x xs -> head (x:xs) == (x :: Int) - - -- it "throws an exception if used with an empty list" $ do - -- evaluate (head []) `shouldThrow` anyException diff --git a/exemple/Factorial.lob b/exemple/Factorial.lob index 7fa41fd..63d5ee3 100644 --- a/exemple/Factorial.lob +++ b/exemple/Factorial.lob @@ -1,7 +1,7 @@ -fn factorial(| x |) { - if x == 0 { +fn factorial(| x |) {| + if x == 0 {| 1 - } else { + |} else {| x * factorial(| x - 1 |) - } -} + |} +|} diff --git a/exemple/Fibonacci.lob b/exemple/Fibonacci.lob index d9b0bc5..c76026a 100644 --- a/exemple/Fibonacci.lob +++ b/exemple/Fibonacci.lob @@ -1,9 +1,9 @@ -fn fibonacci(| x |) { - if x == 0 { +fn fibonacci(| x |) {| + if true {| 0 - } else if x == 1 { + |} else if x == 1 {| 1 - } else { + |} else {| fibonacci(| x - 1 |) + fibonacci(| x - 2 |) - } -} + |} +|} diff --git a/exemple/Lambda.lob b/exemple/Lambda.lob index dbba1f6..e0b5b84 100644 --- a/exemple/Lambda.lob +++ b/exemple/Lambda.lob @@ -1,17 +1,17 @@ -sqrt = λ (| x |) { x * x } +sqrt = λ (| x |) {| x * x |} -add = λ (| a, b |) { a + b } +add = λ (| a, b |) {| a + b |} sqrt(| 5 |) add(| 2, 9 |) -abs = λ (| x |) { - if x < 0 { +abs = λ (| x |) {| + if x < 0 {| x * -1 - } else { + |} else {| x - } -} + |} +|} abs(| -543 |) diff --git a/exemple/Neg.lob b/exemple/Neg.lob index b747f37..cfdce51 100644 --- a/exemple/Neg.lob +++ b/exemple/Neg.lob @@ -1,3 +1,3 @@ -fn neg(| x |) { +fn neg(| x |) {| 0 - x -} +|} diff --git a/exemple/Power.lob b/exemple/Power.lob index 945b588..c9890f7 100644 --- a/exemple/Power.lob +++ b/exemple/Power.lob @@ -1,9 +1,9 @@ -fn power(| a, pow |) { - if pow == 0 { +fn power(| a, pow |) {| + if pow == 0 {| 1 - } else { + |} else {| a * power(| a, pow - 1 |) - } -} + |} +|} power(| 5, 5 |) diff --git a/exemple/RangeToStr.lob b/exemple/RangeToStr.lob index a6c5099..941573f 100644 --- a/exemple/RangeToStr.lob +++ b/exemple/RangeToStr.lob @@ -1,7 +1,7 @@ -fn rangeToStr(| a, b |) { - if a >= b { +fn rangeToStr(| a, b |) {| + if a >= b {| @ b - } else { + |} else {| @ a + rangeToStr(| a + 1, b |) - } -} + |} +|}