From 3c37dfb2a0075242b4f411d8b710e3db35271686 Mon Sep 17 00:00:00 2001 From: Axel Humeau Date: Thu, 11 Jan 2024 18:50:26 +0100 Subject: [PATCH 1/5] feat: add detection of infinite recursion --- LobsterLang/src/AstEval.hs | 7 +++++++ LobsterLang/test/AstEvalSpec.hs | 2 ++ 2 files changed, 9 insertions(+) diff --git a/LobsterLang/src/AstEval.hs b/LobsterLang/src/AstEval.hs index 6ca026f..1da26b4 100644 --- a/LobsterLang/src/AstEval.hs +++ b/LobsterLang/src/AstEval.hs @@ -45,6 +45,9 @@ tooMuchParams s = "Too much parameters for " ++ s notEnoughParams :: String -> String notEnoughParams s = "Not enough parameters for " ++ s +recursionLimit :: Int +recursionLimit = 2000 + -- | Evaluate a 'Ast'. -- Takes a stack representing variables and the Ast to evaluate. -- Returns a tuple containing either the resulting Ast @@ -52,6 +55,10 @@ notEnoughParams s = "Not enough parameters for " ++ s -- or a 'String' containing the error message in case of error -- and the stack after evaluation. evalAst :: [ScopeMb] -> Ast -> (Either String (Maybe Ast), [ScopeMb]) +evalAst (ScopeBegin depth:xs) _ + | depth > recursionLimit = (Left "Recursion limit reached", ScopeBegin depth:xs) +evalAst (Variable s ast depth:xs) _ + | depth > recursionLimit = (Left "Recursion limit reached", Variable s ast depth:xs) evalAst stack (Define s v) = case defineVar defineFunc stack s v of Left err -> (Left err, stack) Right stack' -> (Right Nothing, stack') diff --git a/LobsterLang/test/AstEvalSpec.hs b/LobsterLang/test/AstEvalSpec.hs index a28be89..8946885 100644 --- a/LobsterLang/test/AstEvalSpec.hs +++ b/LobsterLang/test/AstEvalSpec.hs @@ -216,3 +216,5 @@ spec = do evalAst [] (Define "fact" (FunctionValue ["x"] (Cond (Call "==" [AST.Value 0, AST.Symbol "x" Nothing]) (AST.Value 1) (Just (Call "*" [AST.Symbol "x" Nothing, Symbol "fact" (Just [Call "-" [AST.Symbol "x" Nothing, AST.Value 1]])]))) Nothing)) `shouldBe` (Right Nothing, [Variable "fact" (FunctionValue ["x"] (Cond (Call "==" [AST.Value 0, AST.Symbol "x" Nothing]) (AST.Value 1) (Just (Call "*" [AST.Symbol "x" Nothing, AST.Symbol "fact" (Just [Call "-" [AST.Symbol "x" Nothing, AST.Value 1]])]))) Nothing) 0]) it "Check factorial usage" $ do evalAst [Variable "fact" (FunctionValue ["x"] (Cond (Call "==" [AST.Value 0, AST.Symbol "x" Nothing]) (AST.Value 1) (Just (Call "*" [AST.Symbol "x" Nothing, Symbol "fact" (Just [Call "-" [AST.Symbol "x" Nothing, AST.Value 1]])]))) Nothing) 0] (Symbol "fact" (Just [AST.Value 6])) `shouldBe` (Right (Just (AST.Value 720)), [Variable "fact" (FunctionValue ["x"] (Cond (Call "==" [AST.Value 0, AST.Symbol "x" Nothing]) (AST.Value 1) (Just (Call "*" [AST.Symbol "x" Nothing, AST.Symbol "fact" (Just [Call "-" [AST.Symbol "x" Nothing, AST.Value 1]])]))) Nothing) 0]) + it "Infinite recursion" $ do + evalAst [Variable "eh" (FunctionValue ["x"] (Symbol "eh" (Just [Symbol "x" Nothing])) Nothing) 0] (Symbol "eh" (Just [AST.Value 1])) `shouldBe` (Left "Recursion limit reached", [Variable "eh" (FunctionValue ["x"] (Symbol "eh" (Just [Symbol "x" Nothing])) Nothing) 0]) From c726ad99c4a9caac0103bcc6c24a02bc6326c3d2 Mon Sep 17 00:00:00 2001 From: Axel Humeau Date: Thu, 11 Jan 2024 19:50:00 +0100 Subject: [PATCH 2/5] feat: check infinite recursion in optimizer --- LobsterLang/src/AstOptimizer.hs | 94 +++++++++++++++------------- LobsterLang/test/AstOptimizerSpec.hs | 4 ++ 2 files changed, 54 insertions(+), 44 deletions(-) diff --git a/LobsterLang/src/AstOptimizer.hs b/LobsterLang/src/AstOptimizer.hs index db69279..b8814a9 100644 --- a/LobsterLang/src/AstOptimizer.hs +++ b/LobsterLang/src/AstOptimizer.hs @@ -7,8 +7,8 @@ module AstOptimizer ( optimizeAst, - AstError(..), - AstOptimised(..), + AstError (..), + AstOptimised (..), ) where @@ -35,44 +35,27 @@ optimizeAst stack ((Define n ast) : xs) inFunc = case optimizeAst stack [ast] in [Left err] -> Left err : optimizeAst stack xs inFunc [Right (Result opAst)] -> case evalAst stack (Define n opAst) of (Right _, stack') -> Right (Result (Define n opAst)) : optimizeAst stack' xs inFunc - (Left ('S':'y':'m':'b':'o':'l':' ':'\'':xs'), _) + (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 + | 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 "This situation shouldn't happen" (Define n ast)) : 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 | otherwise = case getVarInScope stack s of - Nothing -> Left (Error ("Symbol '" ++ s ++ "' doesn't exist in the current or global scope") (Symbol s Nothing)) : optimizeAst stack xs inFunc - Just _ -> Right (Result (Symbol s Nothing)) : optimizeAst stack xs inFunc + Nothing -> Left (Error ("Symbol '" ++ s ++ "' doesn't exist in the current or global scope") (Symbol s Nothing)) : optimizeAst stack xs inFunc + Just _ -> Right (Result (Symbol s Nothing)) : optimizeAst stack xs inFunc optimizeAst stack ((Symbol s (Just asts)) : xs) inFunc - | foldr ((&&) . isUnoptimizable) True asts = case evalAst stack (Symbol s (Just asts)) of - (Left ('S':'y':'m':'b':'o':'l':' ':'\'':xs'), _) - | inFunc -> Right (Result (Symbol s (Just asts))) : optimizeAst stack xs inFunc - | otherwise -> Left (Error ('S':'y':'m':'b':'o':'l':' ':'\'':xs') (Symbol s (Just asts))) : optimizeAst stack xs inFunc - (Left err, _) -> Left (Error err (Symbol s (Just asts))) : optimizeAst stack xs inFunc - (Right (Just _), stack') -> Right (Result (Symbol s (Just asts))) : optimizeAst stack' xs inFunc - _ -> Right (Warning "This situation shouldn't happen" (Symbol s (Just asts))) : optimizeAst stack xs inFunc + | foldr ((&&) . isUnoptimizable) True asts = checkEvalReturnSame stack (Symbol s (Just asts) : xs) inFunc | otherwise = case sequence (optimizeAst stack asts inFunc) of Left err -> Left err : optimizeAst stack xs inFunc - Right opAst -> optimizeAst stack (Symbol s (Just (map fromOptimised opAst)):xs) inFunc + Right opAst -> optimizeAst stack (Symbol s (Just (map fromOptimised opAst)) : xs) inFunc optimizeAst stack ((Call op asts) : xs) inFunc | foldr ((&&) . isUnoptimizable) True asts - && foldr ((&&) . isValue) True asts = case evalAst stack (Call op asts) of - (Left ('S':'y':'m':'b':'o':'l':' ':'\'':xs'), _) - | inFunc -> Right (Result (Call op asts)) : optimizeAst stack xs inFunc - | otherwise -> Left (Error ('S':'y':'m':'b':'o':'l':' ':'\'':xs') (Call op asts)) : optimizeAst stack xs inFunc - (Left err, _) -> Left (Error err (Call op asts)) : optimizeAst stack xs inFunc - (Right (Just ast), stack') -> Right (Result ast) : optimizeAst stack' xs inFunc - _ -> Right (Warning "This situation shouldn't happen" (Call op asts)) : optimizeAst stack xs inFunc - | foldr ((&&) . isUnoptimizable) True asts = case evalAst stack (Call op asts) of - (Left ('S':'y':'m':'b':'o':'l':' ':'\'':xs'), _) - | inFunc -> Right (Result (Call op asts)) : optimizeAst stack xs inFunc - | otherwise -> Left (Error ('S':'y':'m':'b':'o':'l':' ':'\'':xs') (Call op asts)) : optimizeAst stack xs inFunc - (Left err, _) -> Left (Error err (Call op asts)) : optimizeAst stack xs inFunc - (Right (Just _), stack') -> Right (Result (Call op asts)) : optimizeAst stack' xs inFunc - _ -> Right (Warning "This situation shouldn't happen" (Call op asts)) : optimizeAst stack xs inFunc + && foldr ((&&) . isValue) True asts = + checkEval stack (Call op asts : xs) inFunc + | foldr ((&&) . isUnoptimizable) True asts = checkEvalReturnSame stack (Call op asts : xs) inFunc | otherwise = case sequence (optimizeAst stack asts inFunc) of Left err -> Left err : optimizeAst stack xs inFunc Right asts' -> optimizeAst stack (Call op (map fromOptimised asts') : xs) inFunc @@ -81,17 +64,17 @@ optimizeAst stack ((Cond condAst trueAst mFalseAst) : xs) inFunc [Left err] -> Left err : optimizeAst stack xs inFunc [Right (Result condAst')] -> optimizeAst stack (Cond condAst' trueAst mFalseAst : xs) inFunc [Right (Warning _ condAst')] -> optimizeAst stack (Cond condAst' trueAst mFalseAst : xs) inFunc - _ -> Right (Warning "This situation shouldn't happen" (Cond condAst trueAst mFalseAst)) : optimizeAst stack xs inFunc + _ -> shouldntHappen stack (Cond condAst trueAst mFalseAst : xs) inFunc | not (isUnoptimizable trueAst) = case optimizeAst stack [trueAst] inFunc of [Left err] -> Left err : optimizeAst stack xs inFunc [Right (Result trueAst')] -> optimizeAst stack (Cond condAst trueAst' mFalseAst : xs) inFunc [Right (Warning _ trueAst')] -> optimizeAst stack (Cond condAst trueAst' mFalseAst : xs) inFunc - _ -> Right (Warning "This situation shouldn't happen" (Cond condAst trueAst mFalseAst)) : optimizeAst stack xs inFunc + _ -> shouldntHappen stack (Cond condAst trueAst mFalseAst : xs) inFunc | isJust mFalseAst && not (isUnoptimizable (fromJust mFalseAst)) = case optimizeAst stack [fromJust mFalseAst] inFunc of [Left err] -> Left err : optimizeAst stack xs inFunc [Right (Result falseAst')] -> optimizeAst stack (Cond condAst trueAst (Just falseAst') : xs) inFunc [Right (Warning _ falseAst')] -> optimizeAst stack (Cond condAst trueAst (Just falseAst') : xs) inFunc - _ -> Right (Warning "This situation shouldn't happen" (Cond condAst trueAst mFalseAst)) : optimizeAst stack xs inFunc + _ -> shouldntHappen stack (Cond condAst trueAst mFalseAst : xs) inFunc | otherwise = case condAst of Boolean True -> Right (Warning "Condition is always true" trueAst) : optimizeAst stack xs inFunc Boolean False -> @@ -102,31 +85,25 @@ optimizeAst stack ((Cond condAst trueAst mFalseAst) : xs) inFunc ) : optimizeAst stack xs inFunc _ -> Right (Result (Cond condAst trueAst mFalseAst)) : optimizeAst stack xs inFunc -optimizeAst stack ((FunctionValue params ast Nothing) : xs) inFunc = case optimizeAst stack [ast] True of +optimizeAst stack (FunctionValue params ast Nothing : xs) inFunc = case optimizeAst stack [ast] True of [Left err] -> Left err : optimizeAst stack xs inFunc [Right (Result ast')] -> Right (Result (FunctionValue params ast' Nothing)) : optimizeAst stack xs inFunc [Right (Warning mes ast')] -> Right (Warning mes (FunctionValue params ast' Nothing)) : optimizeAst stack xs inFunc - _ -> Right (Warning "This situation shouldn't happen" (FunctionValue params ast Nothing)) : optimizeAst stack xs inFunc -optimizeAst stack ((FunctionValue params ast (Just asts)) : xs) inFunc + _ -> shouldntHappen stack (FunctionValue params ast Nothing : xs) inFunc +optimizeAst stack (FunctionValue params ast (Just asts) : xs) inFunc | not (isUnoptimizable ast) = case optimizeAst stack [ast] True of [Left err] -> Left err : optimizeAst stack xs inFunc [Right (Result ast')] -> optimizeAst stack (FunctionValue params ast' (Just asts) : xs) inFunc [Right (Warning _ ast')] -> optimizeAst stack (FunctionValue params ast' (Just asts) : xs) inFunc - _ -> Right (Warning "This situation shouldn't happen" (FunctionValue params ast (Just asts))) : optimizeAst stack xs inFunc + _ -> shouldntHappen stack (FunctionValue params ast (Just asts) : xs) inFunc | not (foldr ((&&) . isUnoptimizable) True asts) = case sequence (optimizeAst stack asts inFunc) of Left err -> Left err : optimizeAst stack xs inFunc Right asts' -> optimizeAst stack (FunctionValue params ast (Just (map fromOptimised asts')) : xs) inFunc | length params > length asts = case evalAst stack (FunctionValue params ast (Just asts)) of (Left err, _) -> Left (Error err (FunctionValue params ast (Just asts))) : optimizeAst stack xs inFunc (Right (Just ast'), stack') -> Right (Result ast') : optimizeAst stack' xs inFunc - (Right Nothing, _) -> Right (Warning "This situation shouldn't happen" (FunctionValue params ast (Just asts))) : optimizeAst stack xs inFunc - | otherwise = case evalAst stack (FunctionValue params ast (Just asts)) of - (Left ('S':'y':'m':'b':'o':'l':' ':'\'':xs'), _) - | inFunc -> Right (Result (FunctionValue params ast (Just asts))) : optimizeAst stack xs inFunc - | otherwise -> Left (Error ('S':'y':'m':'b':'o':'l':' ':'\'':xs') (FunctionValue params ast (Just asts))) : optimizeAst stack xs inFunc - (Left err, _) -> Left (Error err (FunctionValue params ast (Just asts))) : optimizeAst stack xs inFunc - (Right (Just _), stack') -> Right (Result (FunctionValue params ast (Just asts))) : optimizeAst stack' xs inFunc - _ -> Right (Warning "This situation shouldn't happen" (FunctionValue params ast (Just asts))) : optimizeAst stack xs inFunc + (Right Nothing, _) -> shouldntHappen stack (FunctionValue params ast (Just asts) : xs) inFunc + | otherwise = checkEvalReturnSame stack (FunctionValue params ast (Just asts) : xs) inFunc optimizeAst _ [] _ = [] isUnoptimizable :: Ast -> Bool @@ -162,3 +139,32 @@ isValue _ = False fromOptimised :: AstOptimised -> Ast fromOptimised (Warning _ ast) = ast fromOptimised (Result ast) = ast + +checkEval :: [ScopeMb] -> [Ast] -> Bool -> [Either AstError AstOptimised] +checkEval stack (ast : xs) inFunc = case evalAst stack ast of + (Left ('R' : 'e' : 'c' : 'u' : 'r' : 's' : 'i' : 'o' : 'n' : _), _) -> + Right (Warning "Possible infinite recursion" ast) : optimizeAst stack xs inFunc + (Left ('S' : 'y' : 'm' : 'b' : 'o' : 'l' : ' ' : '\'' : xs'), _) + | inFunc -> Right (Result ast) : optimizeAst stack xs inFunc + | otherwise -> Left (Error ('S' : 'y' : 'm' : 'b' : 'o' : 'l' : ' ' : '\'' : xs') ast) : optimizeAst stack xs inFunc + (Left err, _) -> Left (Error err ast) : optimizeAst stack xs inFunc + (Right (Just ast'), stack') -> Right (Result ast') : optimizeAst stack' xs inFunc + _ -> shouldntHappen stack (ast : xs) inFunc +checkEval _ _ _ = [Right (Warning "This situation really shouldn't happen" (String "bruh"))] + +checkEvalReturnSame :: [ScopeMb] -> [Ast] -> Bool -> [Either AstError AstOptimised] +checkEvalReturnSame stack (ast : xs) inFunc = case evalAst stack ast of + (Left ('R' : 'e' : 'c' : 'u' : 'r' : 's' : 'i' : 'o' : 'n' : _), _) -> + Right (Warning "Possible infinite recursion" ast) : optimizeAst stack xs inFunc + (Left ('S' : 'y' : 'm' : 'b' : 'o' : 'l' : ' ' : '\'' : xs'), _) + | inFunc -> Right (Result ast) : optimizeAst stack xs inFunc + | otherwise -> Left (Error ('S' : 'y' : 'm' : 'b' : 'o' : 'l' : ' ' : '\'' : xs') ast) : optimizeAst stack xs inFunc + (Left err, _) -> Left (Error err ast) : optimizeAst stack xs inFunc + (Right (Just _), stack') -> Right (Result ast) : optimizeAst stack' xs inFunc + _ -> shouldntHappen stack (ast : xs) inFunc +checkEvalReturnSame _ _ _ = [Right (Warning "This situation really shouldn't happen" (String "bruh"))] + +shouldntHappen :: [ScopeMb] -> [Ast] -> Bool -> [Either AstError AstOptimised] +shouldntHappen stack (ast : xs) inFunc = + Right (Warning "This situation shouldn't happen" ast) : optimizeAst stack xs inFunc +shouldntHappen _ _ _ = [Right (Warning "This situation really shouldn't happen" (String "bruh"))] diff --git a/LobsterLang/test/AstOptimizerSpec.hs b/LobsterLang/test/AstOptimizerSpec.hs index 2557ee2..b3bbf9b 100644 --- a/LobsterLang/test/AstOptimizerSpec.hs +++ b/LobsterLang/test/AstOptimizerSpec.hs @@ -159,3 +159,7 @@ spec = do optimizeAst [Variable "a" (Value 5) 0] [Call "-" [Value 5, Value 8], Call "+" [Symbol "a" Nothing, Value 8]] False `shouldBe` [Right (Result (Value (-3))), Right (Result (Call "+" [Symbol "a" Nothing, Value 8]))] it "Define then call" $ do optimizeAst [] [Define "a" (Value 5), Call "-" [Symbol "a" Nothing, Value 8]] False `shouldBe` [Right (Result (Define "a" (Value 5))), Right (Result (Call "-" [Symbol "a" Nothing, Value 8]))] + 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]))))] From d05c55453a2e43d5cdfd0dfdee4acedec1145e04 Mon Sep 17 00:00:00 2001 From: Axel Humeau Date: Fri, 12 Jan 2024 13:07:23 +0100 Subject: [PATCH 3/5] feat: improve string operation (!!, concat and @) --- LobsterLang/src/AstEval.hs | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/LobsterLang/src/AstEval.hs b/LobsterLang/src/AstEval.hs index 1da26b4..f337933 100644 --- a/LobsterLang/src/AstEval.hs +++ b/LobsterLang/src/AstEval.hs @@ -79,6 +79,8 @@ evalAst stack (AST.List l) = case evalSubParams stack l of (Right Nothing) -> (Left "Cannot have Nothing in a list", stack) evalAst stack (AST.String str) = (Right (Just (AST.String str)), stack) evalAst stack (Boolean b) = (Right (Just (Boolean b)), stack) +evalAst stack (Call "+" [AST.String s1, AST.String s2]) = + (Right (Just (AST.String (s1 ++ s2))), stack) evalAst stack (Call "+" astList) = evalBiValOp (+) stack (Call "+" astList) evalAst stack (Call "-" astList) = evalBiValOp (-) stack (Call "-" astList) evalAst stack (Call "*" astList) = evalBiValOp (*) stack (Call "*" astList) @@ -292,8 +294,6 @@ getElemInAstList _ (Call "!!" [AST.Boolean _, _]) = Left (invalidParamsBiOp "!!") getElemInAstList _ (Call "!!" [_, AST.Boolean _]) = Left (invalidParamsBiOp "!!") -getElemInAstList _ (Call "!!" [AST.String _, _]) = - Left (invalidParamsBiOp "!!") getElemInAstList _ (Call "!!" [_, AST.String _]) = Left (invalidParamsBiOp "!!") getElemInAstList _ (Call "!!" [_, AST.List _]) = @@ -308,6 +308,10 @@ getElemInAstList _ (Call "!!" [AST.List a, AST.Value b]) | b < 0 = Left "Index out of range" | length a > b = Right (a !! b) | otherwise = Left "Index out of range" +getElemInAstList _ (Call "!!" [AST.String a, AST.Value b]) + | b < 0 = Left "Index out of range" + | length a > b = Right (AST.String [a !! b]) + | otherwise = Left "Index out of range" getElemInAstList stack (Call "!!" [ast1, ast2]) = case evalSubParams stack [ast1, ast2] of Left err -> Left err @@ -381,6 +385,8 @@ astToString _ (AST.Value val) = Right (AST.String (show val)) astToString _ (AST.Boolean bool) = Right (AST.String (show bool)) astToString _ (AST.FunctionValue _ _ Nothing) = Left "Cannot convert lambda to string" +astToString _ (AST.List _) = + Left "Cannot convert list to string" astToString stack ast = case evalAst stack ast of (Left err, _) -> Left err (Right ast', _) -> From 697511810446907de7aa29ce9380b6840d28bb90 Mon Sep 17 00:00:00 2001 From: Axel Humeau Date: Fri, 12 Jan 2024 15:35:34 +0100 Subject: [PATCH 4/5] test: improve string and list tests --- LobsterLang/test/AstEvalSpec.hs | 29 +++++++++++++++++++++++++++++ 1 file changed, 29 insertions(+) diff --git a/LobsterLang/test/AstEvalSpec.hs b/LobsterLang/test/AstEvalSpec.hs index 8946885..3f4d553 100644 --- a/LobsterLang/test/AstEvalSpec.hs +++ b/LobsterLang/test/AstEvalSpec.hs @@ -196,6 +196,18 @@ spec = do evalAst [] (AST.Call "!!" [AST.List [AST.Value 5, AST.String "blegh"], AST.Value 3]) `shouldBe` (Left "Index out of range", []) it "Check bad index list 2" $ do evalAst [] (AST.Call "!!" [AST.List [AST.Value 5, AST.String "blegh"], AST.Value (-1)]) `shouldBe` (Left "Index out of range", []) + it "Index wrong type" $ do + evalAst [] (Call "!!" [AST.List [AST.Value (-1)], AST.String "abc"]) `shouldBe` (Left "One or more parameters of binary operator '!!' is invalid", []) + it "Index wrong type 2" $ do + evalAst [] (Call "!!" [AST.List [AST.Value (-1)], AST.Boolean True]) `shouldBe` (Left "One or more parameters of binary operator '!!' is invalid", []) + it "Index wrong type 3" $ do + evalAst [] (Call "!!" [AST.List [AST.Value (-1)], AST.FunctionValue [] (AST.Value 1) Nothing]) `shouldBe` (Left "One or more parameters of binary operator '!!' is invalid", []) + it "Index on not a list" $ do + evalAst [] (Call "!!" [AST.FunctionValue [] (AST.Value 1) Nothing, AST.Value 0]) `shouldBe` (Left "One or more parameters of binary operator '!!' is invalid", []) + it "Index on not a list 2" $ do + evalAst [] (Call "!!" [AST.Boolean True, AST.Value 0]) `shouldBe` (Left "One or more parameters of binary operator '!!' is invalid", []) + it "Index on not a list 3" $ do + evalAst [] (Call "!!" [AST.Value 0, AST.Value 0]) `shouldBe` (Left "One or more parameters of binary operator '!!' is invalid", []) it "Check length empty list" $ do evalAst [] (Call "len" [AST.List []]) `shouldBe` (Right (Just (AST.Value 0)), []) it "Check non empty list" $ do @@ -210,6 +222,23 @@ spec = do evalAst [] (Call "--" [AST.List [], AST.Value 5]) `shouldBe` (Right (Just (AST.List [])), []) it "Check remove occurence 3" $ do evalAst [] (Call "--" [AST.List [AST.Value 5, AST.Value 5, AST.Value 5, AST.Value 5], AST.Value 5]) `shouldBe` (Right (Just (AST.List [])), []) + describe "String operations tests" $ do + it "Concatenation" $ do + evalAst [] (Call "+" [AST.String "Hello ", AST.String "World"]) `shouldBe` (Right (Just (AST.String "Hello World")), []) + it "Concatenation 2" $ do + evalAst [] (Call "+" [AST.String "", AST.String "World"]) `shouldBe` (Right (Just (AST.String "World")), []) + it "Concatenation 3" $ do + evalAst [] (Call "+" [AST.String "World", AST.String ""]) `shouldBe` (Right (Just (AST.String "World")), []) + it "Concatenation 4" $ do + evalAst [] (Call "+" [AST.String "", AST.String ""]) `shouldBe` (Right (Just (AST.String "")), []) + it "Index" $ do + evalAst [] (Call "!!" [AST.String "abc", AST.Value 1]) `shouldBe` (Right (Just (AST.String "b")), []) + it "Index out of range" $ do + evalAst [] (Call "!!" [AST.String "abc", AST.Value 3]) `shouldBe` (Left "Index out of range", []) + it "Index out of range 2" $ do + evalAst [] (Call "!!" [AST.String "abc", AST.Value (-1)]) `shouldBe` (Left "Index out of range", []) + it "Index wrong type" $ do + evalAst [] (Call "!!" [AST.String "abc", AST.List [AST.Value (-1)]]) `shouldBe` (Left "One or more parameters of binary operator '!!' is invalid", []) describe "Advanced Ast evaluation tests" $ do -- Advanced tests it "Check factorial definition" $ do From 1e7b3e4a651e2b88e60ebccc2844cf16ddecc3c9 Mon Sep 17 00:00:00 2001 From: Axel Humeau Date: Fri, 12 Jan 2024 16:06:26 +0100 Subject: [PATCH 5/5] docs: document optimization --- LobsterLang/src/AstOptimizer.hs | 26 +++++++++++++++++++++++++- 1 file changed, 25 insertions(+), 1 deletion(-) diff --git a/LobsterLang/src/AstOptimizer.hs b/LobsterLang/src/AstOptimizer.hs index b8814a9..3550c1d 100644 --- a/LobsterLang/src/AstOptimizer.hs +++ b/LobsterLang/src/AstOptimizer.hs @@ -17,13 +17,29 @@ import AstEval import Data.Maybe import Scope (ScopeMb, getVarInScope) +-- Represent an error containing the error message +-- and the `Ast` that caused it data AstError = Error String Ast deriving (Eq, Show) +-- Represent an AST after optimization data AstOptimised - = Result Ast + = + -- | The `Ast` after optimization + Result Ast + -- | When the optimization throw a warning + -- contains the warining message and the `Ast` + -- post optimization that caused it | Warning String Ast deriving (Eq, Show) +-- | Optimize a list of `Ast` and check for invalid operation: +-- optimization is taking place when operation have the same result no matter what +-- for exemple `3 + 3`, when a forbidden operation is taking place, the +-- optimization results in an `AstError`, when the optimization was a success +-- it results in an `AstOptimised`. +-- Takes the stack (`[ScopeMb]`), a list of `Ast`, a boolean to indicate whether +-- the optimization take place insinde a function and returns the list of `Either` +-- `AstError` or `AstOptimised` optimizeAst :: [ScopeMb] -> [Ast] -> Bool -> [Either AstError AstOptimised] optimizeAst stack ((Value v) : xs) inFunc = Right (Result (Value v)) : optimizeAst stack xs inFunc optimizeAst stack ((Boolean b) : xs) inFunc = Right (Result (Boolean b)) : optimizeAst stack xs inFunc @@ -106,6 +122,7 @@ optimizeAst stack (FunctionValue params ast (Just asts) : xs) inFunc | otherwise = checkEvalReturnSame stack (FunctionValue params ast (Just asts) : xs) inFunc optimizeAst _ [] _ = [] +-- | Check whether an `Ast` is optimizable isUnoptimizable :: Ast -> Bool isUnoptimizable (Define _ ast) = isUnoptimizable ast isUnoptimizable (Value _) = True @@ -128,6 +145,7 @@ isUnoptimizable (Cond condAst bodyAst Nothing) = isUnoptimizable (Cond condAst bodyAst (Just elseAst)) = isUnoptimizable condAst && isUnoptimizable bodyAst && isUnoptimizable elseAst +-- | Check whether the `Ast` is a constant value isValue :: Ast -> Bool isValue (Value _) = True isValue (Boolean _) = True @@ -136,10 +154,14 @@ isValue (List _) = True isValue (FunctionValue _ _ Nothing) = True isValue _ = False +-- | Get the `Ast` contained in a `AstOptimised` fromOptimised :: AstOptimised -> Ast fromOptimised (Warning _ ast) = ast fromOptimised (Result ast) = ast +-- | Handle cases where the optimization depends on +-- the result of a evaluation of the `Ast` and it have to return evaluated +-- result checkEval :: [ScopeMb] -> [Ast] -> Bool -> [Either AstError AstOptimised] checkEval stack (ast : xs) inFunc = case evalAst stack ast of (Left ('R' : 'e' : 'c' : 'u' : 'r' : 's' : 'i' : 'o' : 'n' : _), _) -> @@ -152,6 +174,8 @@ checkEval stack (ast : xs) inFunc = case evalAst stack ast of _ -> shouldntHappen stack (ast : xs) inFunc checkEval _ _ _ = [Right (Warning "This situation really shouldn't happen" (String "bruh"))] +-- | Handle cases where the optimization depends on +-- the result of a evaluation of the `Ast` and it have to return the original `Ast` checkEvalReturnSame :: [ScopeMb] -> [Ast] -> Bool -> [Either AstError AstOptimised] checkEvalReturnSame stack (ast : xs) inFunc = case evalAst stack ast of (Left ('R' : 'e' : 'c' : 'u' : 'r' : 's' : 'i' : 'o' : 'n' : _), _) ->