-- |
-- Module      : Jikka.RestrictedPython.Convert.RemoveUnbalancedIf
-- Description : converts and removes if-statements whose either branch has return-statements and the other branch doesn't have return-statements. / その一方の分岐は return 文を持ちもう一方の分岐は return 文を持たないような if 文を変形し削除します。
-- Copyright   : (c) Kimiyuki Onaka, 2021
-- License     : Apache License 2.0
-- Maintainer  : kimiyuki95@gmail.com
-- Stability   : experimental
-- Portability : portable
module Jikka.RestrictedPython.Convert.RemoveUnbalancedIf
  ( run,
  )
where

import Jikka.RestrictedPython.Language.Expr
import Jikka.RestrictedPython.Language.Util

runStatements :: [Statement] -> [Statement]
runStatements :: [Statement] -> [Statement]
runStatements [] = []
runStatements (Statement
stmt : [Statement]
stmts) = case Statement
stmt of
  If Expr'
e [Statement]
body1 [Statement]
body2 -> case ((Statement -> Bool) -> [Statement] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Statement -> Bool
doesAlwaysReturn [Statement]
body1, (Statement -> Bool) -> [Statement] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Statement -> Bool
doesAlwaysReturn [Statement]
body2) of
    (Bool
True, Bool
False) -> [Expr' -> [Statement] -> [Statement] -> Statement
If Expr'
e [Statement]
body1 ([Statement]
body2 [Statement] -> [Statement] -> [Statement]
forall a. [a] -> [a] -> [a]
++ [Statement] -> [Statement]
runStatements [Statement]
stmts)]
    (Bool
False, Bool
True) -> [Expr' -> [Statement] -> [Statement] -> Statement
If Expr'
e ([Statement]
body1 [Statement] -> [Statement] -> [Statement]
forall a. [a] -> [a] -> [a]
++ [Statement] -> [Statement]
runStatements [Statement]
stmts) [Statement]
body2]
    (Bool, Bool)
_ -> Statement
stmt Statement -> [Statement] -> [Statement]
forall a. a -> [a] -> [a]
: [Statement] -> [Statement]
runStatements [Statement]
stmts
  Statement
_ -> Statement
stmt Statement -> [Statement] -> [Statement]
forall a. a -> [a] -> [a]
: [Statement] -> [Statement]
runStatements [Statement]
stmts

-- | `run` removes if-statements that one branch always returns and the other branch doesn't.
--
-- For example, the following
--
-- > if True:
-- >     return 0
-- > else:
-- >     a = 0
-- > b = 1
-- > return 2
--
-- is converted to
--
-- > if True:
-- >     return 0
-- > else:
-- >     a = 0
-- >     b = 1
-- >     return 2
run :: Program -> Program
run :: Program -> Program
run = ([Statement] -> [Statement]) -> Program -> Program
mapStatements [Statement] -> [Statement]
runStatements