module Language.Fortran.Vars.PureExpression
  ( isPureExpression
  )
where
import           Data.Maybe                     ( catMaybes )

import           Language.Fortran.AST           ( Expression(..)
                                                , Index(..)
                                                , Value(..)
                                                , aStrip
                                                )
import           Language.Fortran.Vars.Call
                                                ( functionArguments )

-- | Given an 'Expression', determine whether it is a pure expression. 
-- A pure expression does not have side effect.
-- return true if the expression is guaranteed to be pure,
-- return false if the expression can not be guaranteed to be pure. 
isPureExpression :: Expression a -> Bool
isPureExpression :: forall a. Expression a -> Bool
isPureExpression (ExpValue a
_ SrcSpan
_ Value a
v) = Value a -> Bool
forall a. Value a -> Bool
isPureValue Value a
v
isPureExpression (ExpBinary a
_ SrcSpan
_ BinaryOp
_ Expression a
e1 Expression a
e2) =
  Expression a -> Bool
forall a. Expression a -> Bool
isPureExpression Expression a
e1 Bool -> Bool -> Bool
&& Expression a -> Bool
forall a. Expression a -> Bool
isPureExpression Expression a
e2
isPureExpression (ExpUnary a
_ SrcSpan
_ UnaryOp
_ Expression a
e) = Expression a -> Bool
forall a. Expression a -> Bool
isPureExpression Expression a
e
isPureExpression (ExpSubscript a
_ SrcSpan
_ Expression a
_ AList Index a
indices) =
  (Index a -> Bool) -> [Index a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Index a -> Bool
forall a. Index a -> Bool
isPureIndex (AList Index a -> [Index a]
forall (t :: * -> *) a. AList t a -> [t a]
aStrip AList Index a
indices)
isPureExpression e :: Expression a
e@ExpFunctionCall{} =
  Expression a -> Bool
forall a. Expression a -> Bool
isIntrinsicFunctionCall Expression a
e Bool -> Bool -> Bool
&& (Expression a -> Bool) -> [Expression a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Expression a -> Bool
forall a. Expression a -> Bool
isPureExpression (Expression a -> [Expression a]
forall a. Expression a -> [Expression a]
functionArguments Expression a
e)
isPureExpression (ExpInitialisation a
_ SrcSpan
_ AList Expression a
exprs) =
  (Expression a -> Bool) -> [Expression a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Expression a -> Bool
forall a. Expression a -> Bool
isPureExpression (AList Expression a -> [Expression a]
forall (t :: * -> *) a. AList t a -> [t a]
aStrip AList Expression a
exprs)
isPureExpression ExpReturnSpec{} = Bool
False
isPureExpression ExpImpliedDo{}  = Bool
False
isPureExpression ExpDataRef{}    = Bool
False


-- | Given a 'Value', determine whether it is pure
isPureValue :: Value a -> Bool
isPureValue :: forall a. Value a -> Bool
isPureValue ValInteger{}       = Bool
True
isPureValue ValReal{}          = Bool
True
isPureValue (ValComplex Expression a
e1 Expression a
e2) = Expression a -> Bool
forall a. Expression a -> Bool
isPureExpression Expression a
e1 Bool -> Bool -> Bool
&& Expression a -> Bool
forall a. Expression a -> Bool
isPureExpression Expression a
e2
isPureValue ValString{}        = Bool
True
isPureValue ValHollerith{}     = Bool
True
isPureValue ValVariable{}      = Bool
True
isPureValue ValIntrinsic{}     = Bool
True
isPureValue ValLogical{}       = Bool
True
isPureValue Value a
ValStar            = Bool
True
isPureValue Value a
_                  = Bool
False

-- | Given an 'Index', determine whether it is pure
isPureIndex :: Index a -> Bool
isPureIndex :: forall a. Index a -> Bool
isPureIndex (IxSingle a
_ SrcSpan
_ Maybe String
_ Expression a
e) = Expression a -> Bool
forall a. Expression a -> Bool
isPureExpression Expression a
e
isPureIndex (IxRange a
_ SrcSpan
_ Maybe (Expression a)
me1 Maybe (Expression a)
me2 Maybe (Expression a)
me3) =
  (Expression a -> Bool) -> [Expression a] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Expression a -> Bool
forall a. Expression a -> Bool
isPureExpression ([Expression a] -> Bool) -> [Expression a] -> Bool
forall a b. (a -> b) -> a -> b
$ [Maybe (Expression a)] -> [Expression a]
forall a. [Maybe a] -> [a]
catMaybes [Maybe (Expression a)
me1, Maybe (Expression a)
me2, Maybe (Expression a)
me3]

-- | Given an expression determine whether it is intrinsic function call
isIntrinsicFunctionCall :: Expression a -> Bool
isIntrinsicFunctionCall :: forall a. Expression a -> Bool
isIntrinsicFunctionCall (ExpFunctionCall a
_ SrcSpan
_ (ExpValue a
_ SrcSpan
_ (ValIntrinsic String
_)) Maybe (AList Argument a)
_)
  = Bool
True
isIntrinsicFunctionCall Expression a
_ = Bool
False