Merge pull request #45 from AxelHumeau/feature/infinite-recursion-han…

…dling

Recursion infinie

LobsterLang/src/AstEval.hs

@@ -30,13 +30,20 @@ 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
 -- (can be 'Nothing' for no evaluation is possible)
 -- 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')
@@ -57,6 +64,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)
@@ -270,8 +279,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 _]) =
@@ -286,6 +293,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
@@ -359,6 +370,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', _) ->

LobsterLang/src/AstOptimizer.hs

@@ -7,8 +7,8 @@
 
 module AstOptimizer
   ( optimizeAst,
-    AstError(..),
-    AstOptimised(..),
+    AstError (..),
+    AstOptimised (..),
   )
 where
 
@@ -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
@@ -35,44 +51,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 +80,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,33 +101,28 @@ 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 _ [] _ = []
 
+-- | Check whether an `Ast` is optimizable
 isUnoptimizable :: Ast -> Bool
 isUnoptimizable (Define _ ast) = isUnoptimizable ast
 isUnoptimizable (Value _) = True
@@ -151,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
@@ -159,6 +154,41 @@ 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' : _), _) ->
+    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"))]
+
+-- | 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' : _), _) ->
+    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"))]