Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Recursion infinie #45

Merged
merged 6 commits into from
Jan 12, 2024
+125 −47
Merged

Recursion infinie #45

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
6 commits
Select commit Hold shift + click to select a range
3c37dfb
feat: add detection of infinite recursion
AxelHumeau Jan 11, 2024
c726ad9
feat: check infinite recursion in optimizer
AxelHumeau Jan 11, 2024
d05c554
feat: improve string operation (!!, concat and @)
AxelHumeau Jan 12, 2024
6975118
test: improve string and list tests
AxelHumeau Jan 12, 2024
1e7b3e4
docs: document optimization
AxelHumeau Jan 12, 2024
ae29f21
Merge remote-tracking branch 'origin/main' into feature/infinite-recu…
AxelHumeau Jan 12, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
17 changes: 15 additions & 2 deletions LobsterLang/src/AstEval.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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')
Expand All @@ -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)
Expand Down Expand Up @@ -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 _]) =
Expand All @@ -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
Expand Down Expand Up @@ -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', _) ->
Expand Down
120 changes: 75 additions & 45 deletions LobsterLang/src/AstOptimizer.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -7,8 +7,8 @@

module AstOptimizer
( optimizeAst,
AstError(..),
AstOptimised(..),
AstError (..),
AstOptimised (..),
)
where

Expand All @@ -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
Expand All @@ -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
Expand All @@ -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 ->
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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"))]
Loading
Loading