{-
-- EPITECH PROJECT, 2024
-- GLaDOS
-- File description:
-- AstOptimizer
-}

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

import AST
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 (AstError -> AstError -> Bool
(AstError -> AstError -> Bool)
-> (AstError -> AstError -> Bool) -> Eq AstError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AstError -> AstError -> Bool
== :: AstError -> AstError -> Bool
$c/= :: AstError -> AstError -> Bool
/= :: AstError -> AstError -> Bool
Eq, Int -> AstError -> ShowS
[AstError] -> ShowS
AstError -> String
(Int -> AstError -> ShowS)
-> (AstError -> String) -> ([AstError] -> ShowS) -> Show AstError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AstError -> ShowS
showsPrec :: Int -> AstError -> ShowS
$cshow :: AstError -> String
show :: AstError -> String
$cshowList :: [AstError] -> ShowS
showList :: [AstError] -> ShowS
Show)

-- Represent an AST after optimization
data AstOptimised
  = -- | 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 (AstOptimised -> AstOptimised -> Bool
(AstOptimised -> AstOptimised -> Bool)
-> (AstOptimised -> AstOptimised -> Bool) -> Eq AstOptimised
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AstOptimised -> AstOptimised -> Bool
== :: AstOptimised -> AstOptimised -> Bool
$c/= :: AstOptimised -> AstOptimised -> Bool
/= :: AstOptimised -> AstOptimised -> Bool
Eq, Int -> AstOptimised -> ShowS
[AstOptimised] -> ShowS
AstOptimised -> String
(Int -> AstOptimised -> ShowS)
-> (AstOptimised -> String)
-> ([AstOptimised] -> ShowS)
-> Show AstOptimised
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AstOptimised -> ShowS
showsPrec :: Int -> AstOptimised -> ShowS
$cshow :: AstOptimised -> String
show :: AstOptimised -> String
$cshowList :: [AstOptimised] -> ShowS
showList :: [AstOptimised] -> ShowS
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 :: [ScopeMb] -> [Ast] -> Bool -> [Either AstError AstOptimised]
optimizeAst [ScopeMb]
stack ((Value Int
v) : [Ast]
xs) Bool
inF =
  AstOptimised -> Either AstError AstOptimised
forall a b. b -> Either a b
Right (Ast -> AstOptimised
Result (Int -> Ast
Value Int
v)) Either AstError AstOptimised
-> [Either AstError AstOptimised] -> [Either AstError AstOptimised]
forall a. a -> [a] -> [a]
: [ScopeMb] -> [Ast] -> Bool -> [Either AstError AstOptimised]
optimizeAst [ScopeMb]
stack [Ast]
xs Bool
inF
optimizeAst [ScopeMb]
stack ((Boolean Bool
b) : [Ast]
xs) Bool
inF =
  AstOptimised -> Either AstError AstOptimised
forall a b. b -> Either a b
Right (Ast -> AstOptimised
Result (Bool -> Ast
Boolean Bool
b)) Either AstError AstOptimised
-> [Either AstError AstOptimised] -> [Either AstError AstOptimised]
forall a. a -> [a] -> [a]
: [ScopeMb] -> [Ast] -> Bool -> [Either AstError AstOptimised]
optimizeAst [ScopeMb]
stack [Ast]
xs Bool
inF
optimizeAst [ScopeMb]
stack ((String String
str) : [Ast]
xs) Bool
inF =
  AstOptimised -> Either AstError AstOptimised
forall a b. b -> Either a b
Right (Ast -> AstOptimised
Result (String -> Ast
String String
str)) Either AstError AstOptimised
-> [Either AstError AstOptimised] -> [Either AstError AstOptimised]
forall a. a -> [a] -> [a]
: [ScopeMb] -> [Ast] -> Bool -> [Either AstError AstOptimised]
optimizeAst [ScopeMb]
stack [Ast]
xs Bool
inF
optimizeAst [ScopeMb]
stack ((List [Ast]
asts) : [Ast]
xs) Bool
inF =
  case [Either AstError AstOptimised] -> Either AstError [AstOptimised]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([ScopeMb] -> [Ast] -> Bool -> [Either AstError AstOptimised]
optimizeAst [ScopeMb]
stack [Ast]
asts Bool
inF) of
    Left AstError
err -> AstError -> Either AstError AstOptimised
forall a b. a -> Either a b
Left AstError
err Either AstError AstOptimised
-> [Either AstError AstOptimised] -> [Either AstError AstOptimised]
forall a. a -> [a] -> [a]
: [ScopeMb] -> [Ast] -> Bool -> [Either AstError AstOptimised]
optimizeAst [ScopeMb]
stack [Ast]
xs Bool
inF
    Right [AstOptimised]
opAst ->
      AstOptimised -> Either AstError AstOptimised
forall a b. b -> Either a b
Right (Ast -> AstOptimised
Result ([Ast] -> Ast
List ((AstOptimised -> Ast) -> [AstOptimised] -> [Ast]
forall a b. (a -> b) -> [a] -> [b]
map AstOptimised -> Ast
fromOpti [AstOptimised]
opAst)))
        Either AstError AstOptimised
-> [Either AstError AstOptimised] -> [Either AstError AstOptimised]
forall a. a -> [a] -> [a]
: [ScopeMb] -> [Ast] -> Bool -> [Either AstError AstOptimised]
optimizeAst [ScopeMb]
stack [Ast]
xs Bool
inF
optimizeAst [ScopeMb]
stack ((Define String
n Ast
ast) : [Ast]
xs) Bool
inF =
  [ScopeMb]
-> [Either AstError AstOptimised]
-> String
-> Ast
-> [Ast]
-> Bool
-> [Either AstError AstOptimised]
checkOptiAfterDef [ScopeMb]
stack ([ScopeMb] -> [Ast] -> Bool -> [Either AstError AstOptimised]
optimizeAst [ScopeMb]
stack [Ast
ast] Bool
inF) String
n Ast
ast [Ast]
xs Bool
inF
optimizeAst [ScopeMb]
stack ((Symbol String
s Maybe [Ast]
Nothing) : [Ast]
xs) Bool
inF
  | Bool
inF = AstOptimised -> Either AstError AstOptimised
forall a b. b -> Either a b
Right (Ast -> AstOptimised
Result (String -> Maybe [Ast] -> Ast
Symbol String
s Maybe [Ast]
forall a. Maybe a
Nothing)) Either AstError AstOptimised
-> [Either AstError AstOptimised] -> [Either AstError AstOptimised]
forall a. a -> [a] -> [a]
: [ScopeMb] -> [Ast] -> Bool -> [Either AstError AstOptimised]
optimizeAst [ScopeMb]
stack [Ast]
xs Bool
inF
  | Bool
otherwise = case [ScopeMb] -> String -> Maybe Ast
getVarInScope [ScopeMb]
stack String
s of
      Maybe Ast
Nothing -> AstError -> Either AstError AstOptimised
forall a b. a -> Either a b
Left (String -> Ast -> AstError
Error (String
"Symbol '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++
        String
"' doesn't exist in the current or global scope") (String -> Maybe [Ast] -> Ast
Symbol String
s Maybe [Ast]
forall a. Maybe a
Nothing))
          Either AstError AstOptimised
-> [Either AstError AstOptimised] -> [Either AstError AstOptimised]
forall a. a -> [a] -> [a]
: [ScopeMb] -> [Ast] -> Bool -> [Either AstError AstOptimised]
optimizeAst [ScopeMb]
stack [Ast]
xs Bool
inF
      Just Ast
_ -> AstOptimised -> Either AstError AstOptimised
forall a b. b -> Either a b
Right (Ast -> AstOptimised
Result (String -> Maybe [Ast] -> Ast
Symbol String
s Maybe [Ast]
forall a. Maybe a
Nothing)) Either AstError AstOptimised
-> [Either AstError AstOptimised] -> [Either AstError AstOptimised]
forall a. a -> [a] -> [a]
: [ScopeMb] -> [Ast] -> Bool -> [Either AstError AstOptimised]
optimizeAst [ScopeMb]
stack [Ast]
xs Bool
inF
optimizeAst [ScopeMb]
stack ((Symbol String
s (Just [Ast]
asts)) : [Ast]
xs) Bool
inF
  | (Ast -> Bool -> Bool) -> Bool -> [Ast] -> Bool
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Bool -> Bool -> Bool
(&&) (Bool -> Bool -> Bool) -> (Ast -> Bool) -> Ast -> Bool -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ast -> Bool
isUnoptimizable) Bool
True [Ast]
asts =
      [ScopeMb]
-> [Ast]
-> (Either String (Maybe Ast), [ScopeMb])
-> Bool
-> [Either AstError AstOptimised]
checkEvalReturnSame [ScopeMb]
stack (String -> Maybe [Ast] -> Ast
Symbol String
s ([Ast] -> Maybe [Ast]
forall a. a -> Maybe a
Just [Ast]
asts) Ast -> [Ast] -> [Ast]
forall a. a -> [a] -> [a]
: [Ast]
xs)
      ([ScopeMb] -> Ast -> (Either String (Maybe Ast), [ScopeMb])
evalAst [ScopeMb]
stack (String -> Maybe [Ast] -> Ast
Symbol String
s ([Ast] -> Maybe [Ast]
forall a. a -> Maybe a
Just [Ast]
asts))) Bool
inF
  | Bool
otherwise = case [Either AstError AstOptimised] -> Either AstError [AstOptimised]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([ScopeMb] -> [Ast] -> Bool -> [Either AstError AstOptimised]
optimizeAst [ScopeMb]
stack [Ast]
asts Bool
inF) of
      Left AstError
err -> AstError -> Either AstError AstOptimised
forall a b. a -> Either a b
Left AstError
err Either AstError AstOptimised
-> [Either AstError AstOptimised] -> [Either AstError AstOptimised]
forall a. a -> [a] -> [a]
: [ScopeMb] -> [Ast] -> Bool -> [Either AstError AstOptimised]
optimizeAst [ScopeMb]
stack [Ast]
xs Bool
inF
      Right [AstOptimised]
opAst -> [ScopeMb] -> [Ast] -> Bool -> [Either AstError AstOptimised]
optimizeAst [ScopeMb]
stack
          (String -> Maybe [Ast] -> Ast
Symbol String
s ([Ast] -> Maybe [Ast]
forall a. a -> Maybe a
Just ((AstOptimised -> Ast) -> [AstOptimised] -> [Ast]
forall a b. (a -> b) -> [a] -> [b]
map AstOptimised -> Ast
fromOpti [AstOptimised]
opAst)) Ast -> [Ast] -> [Ast]
forall a. a -> [a] -> [a]
: [Ast]
xs) Bool
inF
optimizeAst [ScopeMb]
stack ((Call String
op [Ast]
asts) : [Ast]
xs) Bool
inF
  | (Ast -> Bool -> Bool) -> Bool -> [Ast] -> Bool
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Bool -> Bool -> Bool
(&&) (Bool -> Bool -> Bool) -> (Ast -> Bool) -> Ast -> Bool -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ast -> Bool
isUnoptimizable) Bool
True [Ast]
asts
      Bool -> Bool -> Bool
&& (Ast -> Bool -> Bool) -> Bool -> [Ast] -> Bool
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Bool -> Bool -> Bool
(&&) (Bool -> Bool -> Bool) -> (Ast -> Bool) -> Ast -> Bool -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ast -> Bool
isValue) Bool
True [Ast]
asts =
      [ScopeMb]
-> [Ast]
-> (Either String (Maybe Ast), [ScopeMb])
-> Bool
-> [Either AstError AstOptimised]
checkEval [ScopeMb]
stack (String -> [Ast] -> Ast
Call String
op [Ast]
asts Ast -> [Ast] -> [Ast]
forall a. a -> [a] -> [a]
: [Ast]
xs) ([ScopeMb] -> Ast -> (Either String (Maybe Ast), [ScopeMb])
evalAst [ScopeMb]
stack (String -> [Ast] -> Ast
Call String
op [Ast]
asts)) Bool
inF
  | (Ast -> Bool -> Bool) -> Bool -> [Ast] -> Bool
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Bool -> Bool -> Bool
(&&) (Bool -> Bool -> Bool) -> (Ast -> Bool) -> Ast -> Bool -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ast -> Bool
isUnoptimizable) Bool
True [Ast]
asts =
      [ScopeMb]
-> [Ast]
-> (Either String (Maybe Ast), [ScopeMb])
-> Bool
-> [Either AstError AstOptimised]
checkEvalReturnSame [ScopeMb]
stack (String -> [Ast] -> Ast
Call String
op [Ast]
asts Ast -> [Ast] -> [Ast]
forall a. a -> [a] -> [a]
: [Ast]
xs)
      ([ScopeMb] -> Ast -> (Either String (Maybe Ast), [ScopeMb])
evalAst [ScopeMb]
stack (String -> [Ast] -> Ast
Call String
op [Ast]
asts)) Bool
inF
  | Bool
otherwise = case [Either AstError AstOptimised] -> Either AstError [AstOptimised]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([ScopeMb] -> [Ast] -> Bool -> [Either AstError AstOptimised]
optimizeAst [ScopeMb]
stack [Ast]
asts Bool
inF) of
      Left AstError
err -> AstError -> Either AstError AstOptimised
forall a b. a -> Either a b
Left AstError
err Either AstError AstOptimised
-> [Either AstError AstOptimised] -> [Either AstError AstOptimised]
forall a. a -> [a] -> [a]
: [ScopeMb] -> [Ast] -> Bool -> [Either AstError AstOptimised]
optimizeAst [ScopeMb]
stack [Ast]
xs Bool
inF
      Right [AstOptimised]
asts' -> [ScopeMb] -> [Ast] -> Bool -> [Either AstError AstOptimised]
optimizeAst [ScopeMb]
stack (String -> [Ast] -> Ast
Call String
op ((AstOptimised -> Ast) -> [AstOptimised] -> [Ast]
forall a b. (a -> b) -> [a] -> [b]
map AstOptimised -> Ast
fromOpti [AstOptimised]
asts') Ast -> [Ast] -> [Ast]
forall a. a -> [a] -> [a]
: [Ast]
xs) Bool
inF
optimizeAst [ScopeMb]
stack ((Cond Ast
condAst Ast
trueAst Maybe Ast
mFalseAst) : [Ast]
xs) Bool
inF
  | Bool -> Bool
not (Ast -> Bool
isUnoptimizable Ast
condAst) =
    [ScopeMb]
-> Ast
-> Ast
-> Maybe Ast
-> [Ast]
-> Bool
-> [Either AstError AstOptimised]
optimiseCondCondAst [ScopeMb]
stack Ast
condAst Ast
trueAst Maybe Ast
mFalseAst [Ast]
xs Bool
inF
  | Bool -> Bool
not (Ast -> Bool
isUnoptimizable Ast
trueAst) =
    [ScopeMb]
-> Ast
-> Ast
-> Maybe Ast
-> [Ast]
-> Bool
-> [Either AstError AstOptimised]
optimiseCondTrueBody [ScopeMb]
stack Ast
condAst Ast
trueAst Maybe Ast
mFalseAst [Ast]
xs Bool
inF
  | Maybe Ast -> Bool
forall a. Maybe a -> Bool
isJust Maybe Ast
mFalseAst Bool -> Bool -> Bool
&& Bool -> Bool
not (Ast -> Bool
isUnoptimizable (Maybe Ast -> Ast
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Ast
mFalseAst)) =
    [ScopeMb]
-> Ast
-> Ast
-> Maybe Ast
-> [Ast]
-> Bool
-> [Either AstError AstOptimised]
optimiseCondFalseBody [ScopeMb]
stack Ast
condAst Ast
trueAst Maybe Ast
mFalseAst [Ast]
xs Bool
inF
  | Bool
otherwise = [ScopeMb]
-> Ast
-> Ast
-> Maybe Ast
-> [Ast]
-> Bool
-> [Either AstError AstOptimised]
optimiseCond [ScopeMb]
stack Ast
condAst Ast
trueAst Maybe Ast
mFalseAst [Ast]
xs Bool
inF
optimizeAst [ScopeMb]
stack (FunctionValue [String]
params Ast
ast Maybe [Ast]
Nothing : [Ast]
xs) Bool
inF =
  case [ScopeMb] -> [Ast] -> Bool -> [Either AstError AstOptimised]
optimizeAst [ScopeMb]
stack [Ast
ast] Bool
True of
    [Left AstError
err] -> AstError -> Either AstError AstOptimised
forall a b. a -> Either a b
Left AstError
err Either AstError AstOptimised
-> [Either AstError AstOptimised] -> [Either AstError AstOptimised]
forall a. a -> [a] -> [a]
: [ScopeMb] -> [Ast] -> Bool -> [Either AstError AstOptimised]
optimizeAst [ScopeMb]
stack [Ast]
xs Bool
inF
    [Right (Result Ast
ast')] ->
      AstOptimised -> Either AstError AstOptimised
forall a b. b -> Either a b
Right (Ast -> AstOptimised
Result ([String] -> Ast -> Maybe [Ast] -> Ast
FunctionValue [String]
params Ast
ast' Maybe [Ast]
forall a. Maybe a
Nothing))
        Either AstError AstOptimised
-> [Either AstError AstOptimised] -> [Either AstError AstOptimised]
forall a. a -> [a] -> [a]
: [ScopeMb] -> [Ast] -> Bool -> [Either AstError AstOptimised]
optimizeAst [ScopeMb]
stack [Ast]
xs Bool
inF
    [Right (Warning String
mes Ast
ast')] ->
      AstOptimised -> Either AstError AstOptimised
forall a b. b -> Either a b
Right (String -> Ast -> AstOptimised
Warning String
mes ([String] -> Ast -> Maybe [Ast] -> Ast
FunctionValue [String]
params Ast
ast' Maybe [Ast]
forall a. Maybe a
Nothing))
        Either AstError AstOptimised
-> [Either AstError AstOptimised] -> [Either AstError AstOptimised]
forall a. a -> [a] -> [a]
: [ScopeMb] -> [Ast] -> Bool -> [Either AstError AstOptimised]
optimizeAst [ScopeMb]
stack [Ast]
xs Bool
inF
    [Either AstError AstOptimised]
_ -> [ScopeMb] -> [Ast] -> Bool -> [Either AstError AstOptimised]
shouldntHappen [ScopeMb]
stack ([String] -> Ast -> Maybe [Ast] -> Ast
FunctionValue [String]
params Ast
ast Maybe [Ast]
forall a. Maybe a
Nothing Ast -> [Ast] -> [Ast]
forall a. a -> [a] -> [a]
: [Ast]
xs) Bool
inF
optimizeAst [ScopeMb]
stack (FunctionValue [String]
params Ast
ast (Just [Ast]
asts) : [Ast]
xs) Bool
inF
  | Bool -> Bool
not (Ast -> Bool
isUnoptimizable Ast
ast) = [ScopeMb]
-> Ast
-> [Ast]
-> [Ast]
-> Bool
-> [String]
-> [Either AstError AstOptimised]
optimizeFuncBody [ScopeMb]
stack Ast
ast [Ast]
asts [Ast]
xs Bool
inF [String]
params
  | Bool -> Bool
not ((Ast -> Bool -> Bool) -> Bool -> [Ast] -> Bool
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Bool -> Bool -> Bool
(&&) (Bool -> Bool -> Bool) -> (Ast -> Bool) -> Ast -> Bool -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ast -> Bool
isUnoptimizable) Bool
True [Ast]
asts) =
      [ScopeMb]
-> Ast
-> [Ast]
-> [Ast]
-> Bool
-> [String]
-> [Either AstError AstOptimised]
optimizeFuncParams [ScopeMb]
stack Ast
ast [Ast]
asts [Ast]
xs Bool
inF [String]
params
  | [String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
params Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> [Ast] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Ast]
asts =
      [ScopeMb]
-> Ast
-> [Ast]
-> [Ast]
-> Bool
-> [String]
-> [Either AstError AstOptimised]
optimizeCurring [ScopeMb]
stack Ast
ast [Ast]
asts [Ast]
xs Bool
inF [String]
params
  | Bool
otherwise =
      [ScopeMb]
-> [Ast]
-> (Either String (Maybe Ast), [ScopeMb])
-> Bool
-> [Either AstError AstOptimised]
checkEvalReturnSame [ScopeMb]
stack
        ([String] -> Ast -> Maybe [Ast] -> Ast
FunctionValue [String]
params Ast
ast ([Ast] -> Maybe [Ast]
forall a. a -> Maybe a
Just [Ast]
asts) Ast -> [Ast] -> [Ast]
forall a. a -> [a] -> [a]
: [Ast]
xs)
        ([ScopeMb] -> Ast -> (Either String (Maybe Ast), [ScopeMb])
evalAst [ScopeMb]
stack ([String] -> Ast -> Maybe [Ast] -> Ast
FunctionValue [String]
params Ast
ast ([Ast] -> Maybe [Ast]
forall a. a -> Maybe a
Just [Ast]
asts))) Bool
inF
optimizeAst [ScopeMb]
_ [] Bool
_ = []

optimizeFuncBody :: [ScopeMb] -> Ast -> [Ast] ->
  [Ast] -> Bool -> [String] -> [Either AstError AstOptimised]
optimizeFuncBody :: [ScopeMb]
-> Ast
-> [Ast]
-> [Ast]
-> Bool
-> [String]
-> [Either AstError AstOptimised]
optimizeFuncBody [ScopeMb]
stack Ast
ast [Ast]
asts [Ast]
xs Bool
inF [String]
params =
  case [ScopeMb] -> [Ast] -> Bool -> [Either AstError AstOptimised]
optimizeAst [ScopeMb]
stack [Ast
ast] Bool
True of
    [Left AstError
err] -> AstError -> Either AstError AstOptimised
forall a b. a -> Either a b
Left AstError
err Either AstError AstOptimised
-> [Either AstError AstOptimised] -> [Either AstError AstOptimised]
forall a. a -> [a] -> [a]
: [ScopeMb] -> [Ast] -> Bool -> [Either AstError AstOptimised]
optimizeAst [ScopeMb]
stack [Ast]
xs Bool
inF
    [Right (Result Ast
ast')] ->
      [ScopeMb] -> [Ast] -> Bool -> [Either AstError AstOptimised]
optimizeAst [ScopeMb]
stack ([String] -> Ast -> Maybe [Ast] -> Ast
FunctionValue [String]
params Ast
ast' ([Ast] -> Maybe [Ast]
forall a. a -> Maybe a
Just [Ast]
asts) Ast -> [Ast] -> [Ast]
forall a. a -> [a] -> [a]
: [Ast]
xs) Bool
inF
    [Right (Warning String
_ Ast
ast')] ->
      [ScopeMb] -> [Ast] -> Bool -> [Either AstError AstOptimised]
optimizeAst [ScopeMb]
stack ([String] -> Ast -> Maybe [Ast] -> Ast
FunctionValue [String]
params Ast
ast' ([Ast] -> Maybe [Ast]
forall a. a -> Maybe a
Just [Ast]
asts) Ast -> [Ast] -> [Ast]
forall a. a -> [a] -> [a]
: [Ast]
xs) Bool
inF
    [Either AstError AstOptimised]
_ -> [ScopeMb] -> [Ast] -> Bool -> [Either AstError AstOptimised]
shouldntHappen [ScopeMb]
stack ([String] -> Ast -> Maybe [Ast] -> Ast
FunctionValue [String]
params Ast
ast ([Ast] -> Maybe [Ast]
forall a. a -> Maybe a
Just [Ast]
asts) Ast -> [Ast] -> [Ast]
forall a. a -> [a] -> [a]
: [Ast]
xs) Bool
inF

optimizeFuncParams :: [ScopeMb] -> Ast -> [Ast] ->
  [Ast] -> Bool -> [String] -> [Either AstError AstOptimised]
optimizeFuncParams :: [ScopeMb]
-> Ast
-> [Ast]
-> [Ast]
-> Bool
-> [String]
-> [Either AstError AstOptimised]
optimizeFuncParams [ScopeMb]
stack Ast
ast [Ast]
asts [Ast]
xs Bool
inF [String]
params =
  case [Either AstError AstOptimised] -> Either AstError [AstOptimised]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([ScopeMb] -> [Ast] -> Bool -> [Either AstError AstOptimised]
optimizeAst [ScopeMb]
stack [Ast]
asts Bool
inF) of
        Left AstError
err -> AstError -> Either AstError AstOptimised
forall a b. a -> Either a b
Left AstError
err Either AstError AstOptimised
-> [Either AstError AstOptimised] -> [Either AstError AstOptimised]
forall a. a -> [a] -> [a]
: [ScopeMb] -> [Ast] -> Bool -> [Either AstError AstOptimised]
optimizeAst [ScopeMb]
stack [Ast]
xs Bool
inF
        Right [AstOptimised]
asts' -> [ScopeMb] -> [Ast] -> Bool -> [Either AstError AstOptimised]
optimizeAst [ScopeMb]
stack
          ([String] -> Ast -> Maybe [Ast] -> Ast
FunctionValue [String]
params Ast
ast ([Ast] -> Maybe [Ast]
forall a. a -> Maybe a
Just ((AstOptimised -> Ast) -> [AstOptimised] -> [Ast]
forall a b. (a -> b) -> [a] -> [b]
map AstOptimised -> Ast
fromOpti [AstOptimised]
asts')) Ast -> [Ast] -> [Ast]
forall a. a -> [a] -> [a]
: [Ast]
xs) Bool
inF

optimizeCurring :: [ScopeMb] -> Ast -> [Ast] ->
  [Ast] -> Bool -> [String] -> [Either AstError AstOptimised]
optimizeCurring :: [ScopeMb]
-> Ast
-> [Ast]
-> [Ast]
-> Bool
-> [String]
-> [Either AstError AstOptimised]
optimizeCurring [ScopeMb]
stack Ast
ast [Ast]
asts [Ast]
xs Bool
inF [String]
params =
  case [ScopeMb] -> Ast -> (Either String (Maybe Ast), [ScopeMb])
evalAst [ScopeMb]
stack ([String] -> Ast -> Maybe [Ast] -> Ast
FunctionValue [String]
params Ast
ast ([Ast] -> Maybe [Ast]
forall a. a -> Maybe a
Just [Ast]
asts)) of
    (Left String
err, [ScopeMb]
_) ->
      AstError -> Either AstError AstOptimised
forall a b. a -> Either a b
Left (String -> Ast -> AstError
Error String
err ([String] -> Ast -> Maybe [Ast] -> Ast
FunctionValue [String]
params Ast
ast ([Ast] -> Maybe [Ast]
forall a. a -> Maybe a
Just [Ast]
asts)))
        Either AstError AstOptimised
-> [Either AstError AstOptimised] -> [Either AstError AstOptimised]
forall a. a -> [a] -> [a]
: [ScopeMb] -> [Ast] -> Bool -> [Either AstError AstOptimised]
optimizeAst [ScopeMb]
stack [Ast]
xs Bool
inF
    (Right (Just Ast
ast'), [ScopeMb]
stack') ->
      AstOptimised -> Either AstError AstOptimised
forall a b. b -> Either a b
Right (Ast -> AstOptimised
Result Ast
ast') Either AstError AstOptimised
-> [Either AstError AstOptimised] -> [Either AstError AstOptimised]
forall a. a -> [a] -> [a]
: [ScopeMb] -> [Ast] -> Bool -> [Either AstError AstOptimised]
optimizeAst [ScopeMb]
stack' [Ast]
xs Bool
inF
    (Right Maybe Ast
Nothing, [ScopeMb]
_) ->
      [ScopeMb] -> [Ast] -> Bool -> [Either AstError AstOptimised]
shouldntHappen [ScopeMb]
stack
        ([String] -> Ast -> Maybe [Ast] -> Ast
FunctionValue [String]
params Ast
ast ([Ast] -> Maybe [Ast]
forall a. a -> Maybe a
Just [Ast]
asts) Ast -> [Ast] -> [Ast]
forall a. a -> [a] -> [a]
: [Ast]
xs) Bool
inF

optimiseCondCondAst :: [ScopeMb] -> Ast -> Ast -> Maybe Ast ->
  [Ast] -> Bool -> [Either AstError AstOptimised]
optimiseCondCondAst :: [ScopeMb]
-> Ast
-> Ast
-> Maybe Ast
-> [Ast]
-> Bool
-> [Either AstError AstOptimised]
optimiseCondCondAst [ScopeMb]
stack Ast
condAst Ast
trueAst Maybe Ast
mFalseAst [Ast]
xs Bool
inF =
  case [ScopeMb] -> [Ast] -> Bool -> [Either AstError AstOptimised]
optimizeAst [ScopeMb]
stack [Ast
condAst] Bool
inF of
    [Left AstError
err] -> AstError -> Either AstError AstOptimised
forall a b. a -> Either a b
Left AstError
err Either AstError AstOptimised
-> [Either AstError AstOptimised] -> [Either AstError AstOptimised]
forall a. a -> [a] -> [a]
: [ScopeMb] -> [Ast] -> Bool -> [Either AstError AstOptimised]
optimizeAst [ScopeMb]
stack [Ast]
xs Bool
inF
    [Right (Result Ast
condAst')] ->
      [ScopeMb] -> [Ast] -> Bool -> [Either AstError AstOptimised]
optimizeAst [ScopeMb]
stack (Ast -> Ast -> Maybe Ast -> Ast
Cond Ast
condAst' Ast
trueAst Maybe Ast
mFalseAst Ast -> [Ast] -> [Ast]
forall a. a -> [a] -> [a]
: [Ast]
xs) Bool
inF
    [Right (Warning String
_ Ast
condAst')] ->
      [ScopeMb] -> [Ast] -> Bool -> [Either AstError AstOptimised]
optimizeAst [ScopeMb]
stack (Ast -> Ast -> Maybe Ast -> Ast
Cond Ast
condAst' Ast
trueAst Maybe Ast
mFalseAst Ast -> [Ast] -> [Ast]
forall a. a -> [a] -> [a]
: [Ast]
xs) Bool
inF
    [Either AstError AstOptimised]
_ -> [ScopeMb] -> [Ast] -> Bool -> [Either AstError AstOptimised]
shouldntHappen [ScopeMb]
stack (Ast -> Ast -> Maybe Ast -> Ast
Cond Ast
condAst Ast
trueAst Maybe Ast
mFalseAst Ast -> [Ast] -> [Ast]
forall a. a -> [a] -> [a]
: [Ast]
xs) Bool
inF

optimiseCondTrueBody :: [ScopeMb] -> Ast -> Ast -> Maybe Ast ->
  [Ast] -> Bool -> [Either AstError AstOptimised]
optimiseCondTrueBody :: [ScopeMb]
-> Ast
-> Ast
-> Maybe Ast
-> [Ast]
-> Bool
-> [Either AstError AstOptimised]
optimiseCondTrueBody [ScopeMb]
stack Ast
condAst Ast
trueAst Maybe Ast
mFalseAst [Ast]
xs Bool
inF =
  case [ScopeMb] -> [Ast] -> Bool -> [Either AstError AstOptimised]
optimizeAst [ScopeMb]
stack [Ast
trueAst] Bool
inF of
    [Left AstError
err] -> AstError -> Either AstError AstOptimised
forall a b. a -> Either a b
Left AstError
err Either AstError AstOptimised
-> [Either AstError AstOptimised] -> [Either AstError AstOptimised]
forall a. a -> [a] -> [a]
: [ScopeMb] -> [Ast] -> Bool -> [Either AstError AstOptimised]
optimizeAst [ScopeMb]
stack [Ast]
xs Bool
inF
    [Right (Result Ast
trueAst')] ->
      [ScopeMb] -> [Ast] -> Bool -> [Either AstError AstOptimised]
optimizeAst [ScopeMb]
stack (Ast -> Ast -> Maybe Ast -> Ast
Cond Ast
condAst Ast
trueAst' Maybe Ast
mFalseAst Ast -> [Ast] -> [Ast]
forall a. a -> [a] -> [a]
: [Ast]
xs) Bool
inF
    [Right (Warning String
_ Ast
trueAst')] ->
      [ScopeMb] -> [Ast] -> Bool -> [Either AstError AstOptimised]
optimizeAst [ScopeMb]
stack (Ast -> Ast -> Maybe Ast -> Ast
Cond Ast
condAst Ast
trueAst' Maybe Ast
mFalseAst Ast -> [Ast] -> [Ast]
forall a. a -> [a] -> [a]
: [Ast]
xs) Bool
inF
    [Either AstError AstOptimised]
_ -> [ScopeMb] -> [Ast] -> Bool -> [Either AstError AstOptimised]
shouldntHappen [ScopeMb]
stack (Ast -> Ast -> Maybe Ast -> Ast
Cond Ast
condAst Ast
trueAst Maybe Ast
mFalseAst Ast -> [Ast] -> [Ast]
forall a. a -> [a] -> [a]
: [Ast]
xs) Bool
inF

optimiseCondFalseBody :: [ScopeMb] -> Ast -> Ast -> Maybe Ast ->
  [Ast] -> Bool -> [Either AstError AstOptimised]
optimiseCondFalseBody :: [ScopeMb]
-> Ast
-> Ast
-> Maybe Ast
-> [Ast]
-> Bool
-> [Either AstError AstOptimised]
optimiseCondFalseBody [ScopeMb]
stack Ast
condAst Ast
trueAst Maybe Ast
mFalseAst [Ast]
xs Bool
inF =
      case [ScopeMb] -> [Ast] -> Bool -> [Either AstError AstOptimised]
optimizeAst [ScopeMb]
stack [Maybe Ast -> Ast
forall a. HasCallStack => Maybe a -> a
fromJust Maybe Ast
mFalseAst] Bool
inF of
        [Left AstError
err] -> AstError -> Either AstError AstOptimised
forall a b. a -> Either a b
Left AstError
err Either AstError AstOptimised
-> [Either AstError AstOptimised] -> [Either AstError AstOptimised]
forall a. a -> [a] -> [a]
: [ScopeMb] -> [Ast] -> Bool -> [Either AstError AstOptimised]
optimizeAst [ScopeMb]
stack [Ast]
xs Bool
inF
        [Right (Result Ast
falseAst')] ->
          [ScopeMb] -> [Ast] -> Bool -> [Either AstError AstOptimised]
optimizeAst [ScopeMb]
stack (Ast -> Ast -> Maybe Ast -> Ast
Cond Ast
condAst Ast
trueAst (Ast -> Maybe Ast
forall a. a -> Maybe a
Just Ast
falseAst') Ast -> [Ast] -> [Ast]
forall a. a -> [a] -> [a]
: [Ast]
xs) Bool
inF
        [Right (Warning String
_ Ast
falseAst')] ->
          [ScopeMb] -> [Ast] -> Bool -> [Either AstError AstOptimised]
optimizeAst [ScopeMb]
stack (Ast -> Ast -> Maybe Ast -> Ast
Cond Ast
condAst Ast
trueAst (Ast -> Maybe Ast
forall a. a -> Maybe a
Just Ast
falseAst') Ast -> [Ast] -> [Ast]
forall a. a -> [a] -> [a]
: [Ast]
xs) Bool
inF
        [Either AstError AstOptimised]
_ -> [ScopeMb] -> [Ast] -> Bool -> [Either AstError AstOptimised]
shouldntHappen [ScopeMb]
stack (Ast -> Ast -> Maybe Ast -> Ast
Cond Ast
condAst Ast
trueAst Maybe Ast
mFalseAst Ast -> [Ast] -> [Ast]
forall a. a -> [a] -> [a]
: [Ast]
xs) Bool
inF

optimiseCond :: [ScopeMb] -> Ast -> Ast -> Maybe Ast ->
  [Ast] -> Bool -> [Either AstError AstOptimised]
optimiseCond :: [ScopeMb]
-> Ast
-> Ast
-> Maybe Ast
-> [Ast]
-> Bool
-> [Either AstError AstOptimised]
optimiseCond [ScopeMb]
stack Ast
condAst Ast
trueAst Maybe Ast
mFalseAst [Ast]
xs Bool
inF =
  case Ast
condAst of
    Boolean Bool
True -> AstOptimised -> Either AstError AstOptimised
forall a b. b -> Either a b
Right (String -> Ast -> AstOptimised
Warning String
"Condition is always true" Ast
trueAst)
        Either AstError AstOptimised
-> [Either AstError AstOptimised] -> [Either AstError AstOptimised]
forall a. a -> [a] -> [a]
: [ScopeMb] -> [Ast] -> Bool -> [Either AstError AstOptimised]
optimizeAst [ScopeMb]
stack [Ast]
xs Bool
inF
    Boolean Bool
False -> AstOptimised -> Either AstError AstOptimised
forall a b. b -> Either a b
Right (String -> Ast -> AstOptimised
Warning String
"Condition is always false"
        (Ast -> Maybe Ast -> Ast
forall a. a -> Maybe a -> a
fromMaybe (Ast -> Ast -> Maybe Ast -> Ast
Cond Ast
condAst Ast
trueAst Maybe Ast
mFalseAst) Maybe Ast
mFalseAst))
        Either AstError AstOptimised
-> [Either AstError AstOptimised] -> [Either AstError AstOptimised]
forall a. a -> [a] -> [a]
: [ScopeMb] -> [Ast] -> Bool -> [Either AstError AstOptimised]
optimizeAst [ScopeMb]
stack [Ast]
xs Bool
inF
    Ast
_ ->
      AstOptimised -> Either AstError AstOptimised
forall a b. b -> Either a b
Right (Ast -> AstOptimised
Result (Ast -> Ast -> Maybe Ast -> Ast
Cond Ast
condAst Ast
trueAst Maybe Ast
mFalseAst)) Either AstError AstOptimised
-> [Either AstError AstOptimised] -> [Either AstError AstOptimised]
forall a. a -> [a] -> [a]
:
      [ScopeMb] -> [Ast] -> Bool -> [Either AstError AstOptimised]
optimizeAst [ScopeMb]
stack [Ast]
xs Bool
inF

-- | Check whether an `Ast` is optimizable
isUnoptimizable :: Ast -> Bool
isUnoptimizable :: Ast -> Bool
isUnoptimizable (Define String
_ Ast
ast) = Ast -> Bool
isUnoptimizable Ast
ast
isUnoptimizable (Value Int
_) = Bool
True
isUnoptimizable (Boolean Bool
_) = Bool
True
isUnoptimizable (String String
_) = Bool
True
isUnoptimizable (List [Ast]
asts) = (Ast -> Bool -> Bool) -> Bool -> [Ast] -> Bool
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Bool -> Bool -> Bool
(&&) (Bool -> Bool -> Bool) -> (Ast -> Bool) -> Ast -> Bool -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ast -> Bool
isUnoptimizable) Bool
True [Ast]
asts
isUnoptimizable (Call String
_ [Ast]
asts) =
  (Ast -> Bool -> Bool) -> Bool -> [Ast] -> Bool
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Bool -> Bool -> Bool
(&&) (Bool -> Bool -> Bool) -> (Ast -> Bool) -> Ast -> Bool -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ast -> Bool
isUnoptimizable) Bool
True [Ast]
asts
    Bool -> Bool -> Bool
&& Bool -> Bool
not ((Ast -> Bool -> Bool) -> Bool -> [Ast] -> Bool
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Bool -> Bool -> Bool
(&&) (Bool -> Bool -> Bool) -> (Ast -> Bool) -> Ast -> Bool -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ast -> Bool
isValue) Bool
True [Ast]
asts)
isUnoptimizable (Symbol String
_ Maybe [Ast]
Nothing) = Bool
True
isUnoptimizable (Symbol String
_ (Just [Ast]
asts)) =
  (Ast -> Bool -> Bool) -> Bool -> [Ast] -> Bool
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Bool -> Bool -> Bool
(&&) (Bool -> Bool -> Bool) -> (Ast -> Bool) -> Ast -> Bool -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ast -> Bool
isUnoptimizable) Bool
True [Ast]
asts
isUnoptimizable (FunctionValue [String]
_ Ast
ast Maybe [Ast]
Nothing) = Ast -> Bool
isUnoptimizable Ast
ast
isUnoptimizable (FunctionValue [String]
params Ast
ast (Just [Ast]
asts)) =
  Ast -> Bool
isUnoptimizable Ast
ast
    Bool -> Bool -> Bool
&& (Ast -> Bool -> Bool) -> Bool -> [Ast] -> Bool
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Bool -> Bool -> Bool
(&&) (Bool -> Bool -> Bool) -> (Ast -> Bool) -> Ast -> Bool -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ast -> Bool
isUnoptimizable) Bool
True [Ast]
asts
    Bool -> Bool -> Bool
&& [String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
params Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> [Ast] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Ast]
asts
isUnoptimizable (Cond (Boolean Bool
_) Ast
_ Maybe Ast
_) = Bool
False
isUnoptimizable (Cond Ast
condAst Ast
bodyAst Maybe Ast
Nothing) =
  Ast -> Bool
isUnoptimizable Ast
condAst Bool -> Bool -> Bool
&& Ast -> Bool
isUnoptimizable Ast
bodyAst
isUnoptimizable (Cond Ast
condAst Ast
bodyAst (Just Ast
elseAst)) =
  Ast -> Bool
isUnoptimizable Ast
condAst
    Bool -> Bool -> Bool
&& Ast -> Bool
isUnoptimizable Ast
bodyAst
    Bool -> Bool -> Bool
&& Ast -> Bool
isUnoptimizable Ast
elseAst

-- | Check whether the `Ast` is a constant value
isValue :: Ast -> Bool
isValue :: Ast -> Bool
isValue (Value Int
_) = Bool
True
isValue (Boolean Bool
_) = Bool
True
isValue (String String
_) = Bool
True
isValue (List [Ast]
_) = Bool
True
isValue (FunctionValue [String]
_ Ast
_ Maybe [Ast]
Nothing) = Bool
True
isValue Ast
_ = Bool
False

-- | Get the `Ast` contained in a `AstOptimised`
fromOpti :: AstOptimised -> Ast
fromOpti :: AstOptimised -> Ast
fromOpti (Warning String
_ Ast
ast) = Ast
ast
fromOpti (Result Ast
ast) = 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] ->
  (Either String (Maybe Ast), [ScopeMb]) ->
  Bool ->
  [Either AstError AstOptimised]
checkEval :: [ScopeMb]
-> [Ast]
-> (Either String (Maybe Ast), [ScopeMb])
-> Bool
-> [Either AstError AstOptimised]
checkEval [ScopeMb]
stack (Ast
ast : [Ast]
xs)
  (Left (Char
'R' : Char
'e' : Char
'c' : Char
'u' : Char
'r' : Char
's' : Char
'i' : Char
'o' : Char
'n' : String
_), [ScopeMb]
_) Bool
inF =
    AstOptimised -> Either AstError AstOptimised
forall a b. b -> Either a b
Right (String -> Ast -> AstOptimised
Warning String
"Possible infinite recursion" Ast
ast) Either AstError AstOptimised
-> [Either AstError AstOptimised] -> [Either AstError AstOptimised]
forall a. a -> [a] -> [a]
:
    [ScopeMb] -> [Ast] -> Bool -> [Either AstError AstOptimised]
optimizeAst [ScopeMb]
stack [Ast]
xs Bool
inF
checkEval [ScopeMb]
stack (Ast
ast : [Ast]
xs)
  (Left (Char
'S' : Char
'y' : Char
'm' : Char
'b' : Char
'o' : Char
'l' : Char
' ' : Char
'\'' : String
xs'), [ScopeMb]
_) Bool
inF
    | Bool
inF = AstOptimised -> Either AstError AstOptimised
forall a b. b -> Either a b
Right (Ast -> AstOptimised
Result Ast
ast) Either AstError AstOptimised
-> [Either AstError AstOptimised] -> [Either AstError AstOptimised]
forall a. a -> [a] -> [a]
: [ScopeMb] -> [Ast] -> Bool -> [Either AstError AstOptimised]
optimizeAst [ScopeMb]
stack [Ast]
xs Bool
inF
    | Bool
otherwise = AstError -> Either AstError AstOptimised
forall a b. a -> Either a b
Left
      (String -> Ast -> AstError
Error (Char
'S' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
'y' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
'm' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
'b' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
'o' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
'l' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
' ' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
'\'' Char -> ShowS
forall a. a -> [a] -> [a]
: String
xs') Ast
ast)
      Either AstError AstOptimised
-> [Either AstError AstOptimised] -> [Either AstError AstOptimised]
forall a. a -> [a] -> [a]
: [ScopeMb] -> [Ast] -> Bool -> [Either AstError AstOptimised]
optimizeAst [ScopeMb]
stack [Ast]
xs Bool
inF
checkEval [ScopeMb]
stack (Ast
ast : [Ast]
xs) (Left String
err, [ScopeMb]
_) Bool
inF =
  AstError -> Either AstError AstOptimised
forall a b. a -> Either a b
Left (String -> Ast -> AstError
Error String
err Ast
ast) Either AstError AstOptimised
-> [Either AstError AstOptimised] -> [Either AstError AstOptimised]
forall a. a -> [a] -> [a]
: [ScopeMb] -> [Ast] -> Bool -> [Either AstError AstOptimised]
optimizeAst [ScopeMb]
stack [Ast]
xs Bool
inF
checkEval [ScopeMb]
_ (Ast
_ : [Ast]
xs) (Right (Just Ast
ast'), [ScopeMb]
stack') Bool
inF =
  AstOptimised -> Either AstError AstOptimised
forall a b. b -> Either a b
Right (Ast -> AstOptimised
Result Ast
ast') Either AstError AstOptimised
-> [Either AstError AstOptimised] -> [Either AstError AstOptimised]
forall a. a -> [a] -> [a]
: [ScopeMb] -> [Ast] -> Bool -> [Either AstError AstOptimised]
optimizeAst [ScopeMb]
stack' [Ast]
xs Bool
inF
checkEval [ScopeMb]
stack (Ast
ast : [Ast]
xs) (Either String (Maybe Ast), [ScopeMb])
_ Bool
inF =
  [ScopeMb] -> [Ast] -> Bool -> [Either AstError AstOptimised]
shouldntHappen [ScopeMb]
stack (Ast
ast Ast -> [Ast] -> [Ast]
forall a. a -> [a] -> [a]
: [Ast]
xs) Bool
inF
checkEval [ScopeMb]
_ [Ast]
_ (Either String (Maybe Ast), [ScopeMb])
_ Bool
_ =
  [ AstOptimised -> Either AstError AstOptimised
forall a b. b -> Either a b
Right
      ( String -> Ast -> AstOptimised
Warning
          String
"This situation really shouldn't happen"
          (String -> Ast
String 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] ->
  (Either String (Maybe Ast), [ScopeMb]) ->
  Bool ->
  [Either AstError AstOptimised]
checkEvalReturnSame :: [ScopeMb]
-> [Ast]
-> (Either String (Maybe Ast), [ScopeMb])
-> Bool
-> [Either AstError AstOptimised]
checkEvalReturnSame [ScopeMb]
stack (Ast
ast : [Ast]
xs)
  (Left (Char
'R' : Char
'e' : Char
'c' : Char
'u' : Char
'r' : Char
's' : Char
'i' : Char
'o' : Char
'n' : String
_), [ScopeMb]
_) Bool
inF =
  AstOptimised -> Either AstError AstOptimised
forall a b. b -> Either a b
Right (String -> Ast -> AstOptimised
Warning String
"Possible infinite recursion" Ast
ast)
    Either AstError AstOptimised
-> [Either AstError AstOptimised] -> [Either AstError AstOptimised]
forall a. a -> [a] -> [a]
: [ScopeMb] -> [Ast] -> Bool -> [Either AstError AstOptimised]
optimizeAst [ScopeMb]
stack [Ast]
xs Bool
inF
checkEvalReturnSame [ScopeMb]
stack (Ast
ast : [Ast]
xs)
  (Left (Char
'S' : Char
'y' : Char
'm' : Char
'b' : Char
'o' : Char
'l' : Char
' ' : Char
'\'' : String
xs'), [ScopeMb]
_) Bool
inF
    | Bool
inF = AstOptimised -> Either AstError AstOptimised
forall a b. b -> Either a b
Right (Ast -> AstOptimised
Result Ast
ast) Either AstError AstOptimised
-> [Either AstError AstOptimised] -> [Either AstError AstOptimised]
forall a. a -> [a] -> [a]
: [ScopeMb] -> [Ast] -> Bool -> [Either AstError AstOptimised]
optimizeAst [ScopeMb]
stack [Ast]
xs Bool
inF
    | Bool
otherwise = AstError -> Either AstError AstOptimised
forall a b. a -> Either a b
Left
      (String -> Ast -> AstError
Error (Char
'S' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
'y' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
'm' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
'b' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
'o' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
'l' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
' ' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
'\'' Char -> ShowS
forall a. a -> [a] -> [a]
: String
xs') Ast
ast)
      Either AstError AstOptimised
-> [Either AstError AstOptimised] -> [Either AstError AstOptimised]
forall a. a -> [a] -> [a]
: [ScopeMb] -> [Ast] -> Bool -> [Either AstError AstOptimised]
optimizeAst [ScopeMb]
stack [Ast]
xs Bool
inF
checkEvalReturnSame [ScopeMb]
stack (Ast
ast : [Ast]
xs) (Left String
err, [ScopeMb]
_) Bool
inF =
  AstError -> Either AstError AstOptimised
forall a b. a -> Either a b
Left (String -> Ast -> AstError
Error String
err Ast
ast) Either AstError AstOptimised
-> [Either AstError AstOptimised] -> [Either AstError AstOptimised]
forall a. a -> [a] -> [a]
: [ScopeMb] -> [Ast] -> Bool -> [Either AstError AstOptimised]
optimizeAst [ScopeMb]
stack [Ast]
xs Bool
inF
checkEvalReturnSame [ScopeMb]
_ (Ast
ast : [Ast]
xs) (Right (Just Ast
_), [ScopeMb]
stack') Bool
inF =
  AstOptimised -> Either AstError AstOptimised
forall a b. b -> Either a b
Right (Ast -> AstOptimised
Result Ast
ast) Either AstError AstOptimised
-> [Either AstError AstOptimised] -> [Either AstError AstOptimised]
forall a. a -> [a] -> [a]
: [ScopeMb] -> [Ast] -> Bool -> [Either AstError AstOptimised]
optimizeAst [ScopeMb]
stack' [Ast]
xs Bool
inF
checkEvalReturnSame [ScopeMb]
stack (Ast
ast : [Ast]
xs) (Either String (Maybe Ast), [ScopeMb])
_ Bool
inF =
  [ScopeMb] -> [Ast] -> Bool -> [Either AstError AstOptimised]
shouldntHappen [ScopeMb]
stack (Ast
ast Ast -> [Ast] -> [Ast]
forall a. a -> [a] -> [a]
: [Ast]
xs) Bool
inF
checkEvalReturnSame [ScopeMb]
_ [Ast]
_ (Either String (Maybe Ast), [ScopeMb])
_ Bool
_ =
  [AstOptimised -> Either AstError AstOptimised
forall a b. b -> Either a b
Right (String -> Ast -> AstOptimised
Warning String
"This situation really shouldn't happen" (String -> Ast
String String
"bruh"))]

shouldntHappen :: [ScopeMb] -> [Ast] -> Bool -> [Either AstError AstOptimised]
shouldntHappen :: [ScopeMb] -> [Ast] -> Bool -> [Either AstError AstOptimised]
shouldntHappen [ScopeMb]
stack (Ast
ast : [Ast]
xs) Bool
inF =
  AstOptimised -> Either AstError AstOptimised
forall a b. b -> Either a b
Right (String -> Ast -> AstOptimised
Warning String
"This situation shouldn't happen" Ast
ast)
    Either AstError AstOptimised
-> [Either AstError AstOptimised] -> [Either AstError AstOptimised]
forall a. a -> [a] -> [a]
: [ScopeMb] -> [Ast] -> Bool -> [Either AstError AstOptimised]
optimizeAst [ScopeMb]
stack [Ast]
xs Bool
inF
shouldntHappen [ScopeMb]
_ [Ast]
_ Bool
_ =
  [AstOptimised -> Either AstError AstOptimised
forall a b. b -> Either a b
Right (String -> Ast -> AstOptimised
Warning String
"This situation really shouldn't happen" (String -> Ast
String String
"bruh"))]

checkOptiAfterDef ::
  [ScopeMb] ->
  [Either AstError AstOptimised] ->
  String ->
  Ast ->
  [Ast] ->
  Bool ->
  [Either AstError AstOptimised]
checkOptiAfterDef :: [ScopeMb]
-> [Either AstError AstOptimised]
-> String
-> Ast
-> [Ast]
-> Bool
-> [Either AstError AstOptimised]
checkOptiAfterDef [ScopeMb]
stack [Left AstError
err] String
_ Ast
_ [Ast]
xs Bool
inF =
  AstError -> Either AstError AstOptimised
forall a b. a -> Either a b
Left AstError
err Either AstError AstOptimised
-> [Either AstError AstOptimised] -> [Either AstError AstOptimised]
forall a. a -> [a] -> [a]
: [ScopeMb] -> [Ast] -> Bool -> [Either AstError AstOptimised]
optimizeAst [ScopeMb]
stack [Ast]
xs Bool
inF
checkOptiAfterDef [ScopeMb]
stack [Right (Result Ast
opAst)] String
n Ast
_ [Ast]
xs Bool
inF =
  case [ScopeMb] -> Ast -> (Either String (Maybe Ast), [ScopeMb])
evalAst [ScopeMb]
stack (String -> Ast -> Ast
Define String
n Ast
opAst) of
    (Right Maybe Ast
_, [ScopeMb]
stack') -> AstOptimised -> Either AstError AstOptimised
forall a b. b -> Either a b
Right (Ast -> AstOptimised
Result (String -> Ast -> Ast
Define String
n Ast
opAst)) Either AstError AstOptimised
-> [Either AstError AstOptimised] -> [Either AstError AstOptimised]
forall a. a -> [a] -> [a]
:
      [ScopeMb] -> [Ast] -> Bool -> [Either AstError AstOptimised]
optimizeAst [ScopeMb]
stack' [Ast]
xs Bool
inF
    (Left (Char
'S' : Char
'y' : Char
'm' : Char
'b' : Char
'o' : Char
'l' : Char
' ' : Char
'\'' : String
xs'), [ScopeMb]
_)
      | Bool
inF -> AstOptimised -> Either AstError AstOptimised
forall a b. b -> Either a b
Right (Ast -> AstOptimised
Result (String -> Ast -> Ast
Define String
n Ast
opAst)) Either AstError AstOptimised
-> [Either AstError AstOptimised] -> [Either AstError AstOptimised]
forall a. a -> [a] -> [a]
: [ScopeMb] -> [Ast] -> Bool -> [Either AstError AstOptimised]
optimizeAst [ScopeMb]
stack [Ast]
xs Bool
inF
      | Bool
otherwise ->
        AstError -> Either AstError AstOptimised
forall a b. a -> Either a b
Left (String -> Ast -> AstError
Error (Char
'S' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
'y' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
'm' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
'b' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
'o' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
'l' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
' ' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
'\'' Char -> ShowS
forall a. a -> [a] -> [a]
: String
xs')
          (String -> Ast -> Ast
Define String
n Ast
opAst)) Either AstError AstOptimised
-> [Either AstError AstOptimised] -> [Either AstError AstOptimised]
forall a. a -> [a] -> [a]
: [ScopeMb] -> [Ast] -> Bool -> [Either AstError AstOptimised]
optimizeAst [ScopeMb]
stack [Ast]
xs Bool
inF
    (Left String
e, [ScopeMb]
_) -> AstError -> Either AstError AstOptimised
forall a b. a -> Either a b
Left (String -> Ast -> AstError
Error String
e (String -> Ast -> Ast
Define String
n Ast
opAst)) Either AstError AstOptimised
-> [Either AstError AstOptimised] -> [Either AstError AstOptimised]
forall a. a -> [a] -> [a]
: [ScopeMb] -> [Ast] -> Bool -> [Either AstError AstOptimised]
optimizeAst [ScopeMb]
stack [Ast]
xs Bool
inF
checkOptiAfterDef [ScopeMb]
stack [Right (Warning String
mes Ast
opAst)] String
n Ast
_ [Ast]
xs Bool
inF =
  [ScopeMb]
-> (Either String (Maybe Ast), [ScopeMb])
-> String
-> Ast
-> [Ast]
-> Bool
-> String
-> [Either AstError AstOptimised]
checkEvalAfterWarningDef [ScopeMb]
stack ([ScopeMb] -> Ast -> (Either String (Maybe Ast), [ScopeMb])
evalAst [ScopeMb]
stack (String -> Ast -> Ast
Define String
n Ast
opAst))
  String
n Ast
opAst [Ast]
xs Bool
inF String
mes
checkOptiAfterDef [ScopeMb]
stack [Either AstError AstOptimised]
_ String
n Ast
ast [Ast]
xs Bool
inF =
  [ScopeMb] -> [Ast] -> Bool -> [Either AstError AstOptimised]
shouldntHappen [ScopeMb]
stack (String -> Ast -> Ast
Define String
n Ast
ast Ast -> [Ast] -> [Ast]
forall a. a -> [a] -> [a]
: [Ast]
xs) Bool
inF

checkEvalAfterWarningDef ::
  [ScopeMb] ->
  (Either String (Maybe Ast), [ScopeMb]) ->
  String ->
  Ast ->
  [Ast] ->
  Bool ->
  String ->
  [Either AstError AstOptimised]
checkEvalAfterWarningDef :: [ScopeMb]
-> (Either String (Maybe Ast), [ScopeMb])
-> String
-> Ast
-> [Ast]
-> Bool
-> String
-> [Either AstError AstOptimised]
checkEvalAfterWarningDef [ScopeMb]
_ (Right Maybe Ast
_, [ScopeMb]
stack') String
n Ast
opAst [Ast]
xs Bool
inF String
mes =
  AstOptimised -> Either AstError AstOptimised
forall a b. b -> Either a b
Right (String -> Ast -> AstOptimised
Warning String
mes (String -> Ast -> Ast
Define String
n Ast
opAst)) Either AstError AstOptimised
-> [Either AstError AstOptimised] -> [Either AstError AstOptimised]
forall a. a -> [a] -> [a]
: [ScopeMb] -> [Ast] -> Bool -> [Either AstError AstOptimised]
optimizeAst [ScopeMb]
stack' [Ast]
xs Bool
inF
checkEvalAfterWarningDef [ScopeMb]
_
  (Left (Char
'R' : Char
'e' : Char
'c' : Char
'u' : Char
'r' : Char
's' : Char
'i' : Char
'o' : Char
'n' : String
_), [ScopeMb]
stack')
  String
n Ast
opAst [Ast]
xs Bool
inF String
_ =
    AstOptimised -> Either AstError AstOptimised
forall a b. b -> Either a b
Right (String -> Ast -> AstOptimised
Warning String
"Possible infinite recursion" (String -> Ast -> Ast
Define String
n Ast
opAst))
      Either AstError AstOptimised
-> [Either AstError AstOptimised] -> [Either AstError AstOptimised]
forall a. a -> [a] -> [a]
: [ScopeMb] -> [Ast] -> Bool -> [Either AstError AstOptimised]
optimizeAst [ScopeMb]
stack' [Ast]
xs Bool
inF
checkEvalAfterWarningDef [ScopeMb]
stack
  (Left (Char
'S' : Char
'y' : Char
'm' : Char
'b' : Char
'o' : Char
'l' : Char
' ' : Char
'\'' : String
xs'), [ScopeMb]
_)
  String
n Ast
opAst [Ast]
xs Bool
inF String
_
    | Bool
inF = AstOptimised -> Either AstError AstOptimised
forall a b. b -> Either a b
Right (Ast -> AstOptimised
Result (String -> Ast -> Ast
Define String
n Ast
opAst)) Either AstError AstOptimised
-> [Either AstError AstOptimised] -> [Either AstError AstOptimised]
forall a. a -> [a] -> [a]
: [ScopeMb] -> [Ast] -> Bool -> [Either AstError AstOptimised]
optimizeAst [ScopeMb]
stack [Ast]
xs Bool
inF
    | Bool
otherwise =
      AstError -> Either AstError AstOptimised
forall a b. a -> Either a b
Left (String -> Ast -> AstError
Error (Char
'S' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
'y' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
'm' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
'b' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
'o' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
'l' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
' ' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
'\'' Char -> ShowS
forall a. a -> [a] -> [a]
: String
xs')
        (String -> Ast -> Ast
Define String
n Ast
opAst)) Either AstError AstOptimised
-> [Either AstError AstOptimised] -> [Either AstError AstOptimised]
forall a. a -> [a] -> [a]
: [ScopeMb] -> [Ast] -> Bool -> [Either AstError AstOptimised]
optimizeAst [ScopeMb]
stack [Ast]
xs Bool
inF
checkEvalAfterWarningDef [ScopeMb]
stack (Left String
err, [ScopeMb]
_) String
n Ast
opAst [Ast]
xs Bool
inF String
_ =
  AstError -> Either AstError AstOptimised
forall a b. a -> Either a b
Left (String -> Ast -> AstError
Error String
err (String -> Ast -> Ast
Define String
n Ast
opAst)) Either AstError AstOptimised
-> [Either AstError AstOptimised] -> [Either AstError AstOptimised]
forall a. a -> [a] -> [a]
: [ScopeMb] -> [Ast] -> Bool -> [Either AstError AstOptimised]
optimizeAst [ScopeMb]
stack [Ast]
xs Bool
inF