module Language.Fortran.Vars.Call
  ( functionCalls
  , subroutineCalls
  , functionArguments
  , subroutineArguments
  )
where
import           Data.Generics.Uniplate.Data    ( universeBi )
import           Data.Data                      ( Data )
import           Data.Char                      ( toUpper )

import           Language.Fortran.AST           ( Statement(..)
                                                , Expression(..)
                                                , Argument(..)
                                                , aStrip
                                                , argExprNormalize
                                                )
import           Language.Fortran.Analysis      ( Analysis
                                                , srcName
                                                )
import           Language.Fortran.Util.Position ( getSpan )

-- | Utility to get all call expressions of the specified function
functionCalls
  :: (Data a, Data (b (Analysis a)))
  => b (Analysis a)
  -> String
  -> [Expression (Analysis a)]
functionCalls :: forall a (b :: * -> *).
(Data a, Data (b (Analysis a))) =>
b (Analysis a) -> [Char] -> [Expression (Analysis a)]
functionCalls b (Analysis a)
x [Char]
funcName =
  [ Expression (Analysis a)
e
  | e :: Expression (Analysis a)
e@(ExpFunctionCall Analysis a
_ SrcSpan
_ Expression (Analysis a)
v AList Argument (Analysis a)
_) <- forall from to. Biplate from to => from -> [to]
universeBi b (Analysis a)
x
  , [Char] -> [Char] -> Bool
caseInsensitiveEqual (forall a. Expression (Analysis a) -> [Char]
srcName Expression (Analysis a)
v) [Char]
funcName
  ]

-- | Utility to get all call statements of the specified subroutine
subroutineCalls
  :: (Data a, Data (b (Analysis a)))
  => b (Analysis a)
  -> String
  -> [Statement (Analysis a)]
subroutineCalls :: forall a (b :: * -> *).
(Data a, Data (b (Analysis a))) =>
b (Analysis a) -> [Char] -> [Statement (Analysis a)]
subroutineCalls b (Analysis a)
x [Char]
subName =
  [ Statement (Analysis a)
e | e :: Statement (Analysis a)
e@(StCall Analysis a
_ SrcSpan
_ Expression (Analysis a)
v AList Argument (Analysis a)
_) <- forall from to. Biplate from to => from -> [to]
universeBi b (Analysis a)
x, forall a. Expression (Analysis a) -> [Char]
srcName Expression (Analysis a)
v forall a. Eq a => a -> a -> Bool
== [Char]
subName ]

-- | Given a function call 'Expression', return the list of argument 'Expression'
functionArguments :: Expression a -> [Expression a]
functionArguments :: forall a. Expression a -> [Expression a]
functionArguments (ExpFunctionCall a
_ SrcSpan
_ Expression a
_ AList Argument a
args) =
  forall a b. (a -> b) -> [a] -> [b]
map (\(Argument a
_ SrcSpan
_ Maybe [Char]
_ ArgumentExpression a
e) -> forall a. ArgumentExpression a -> Expression a
argExprNormalize ArgumentExpression a
e) (forall (t :: * -> *) a. AList t a -> [t a]
aStrip AList Argument a
args)
functionArguments Expression a
e =
  forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Expression at " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (forall a. Spanned a => a -> SrcSpan
getSpan Expression a
e) forall a. [a] -> [a] -> [a]
++ [Char]
" is not a function call"


-- | Given a subroutine call 'Statement', return the list of argument 'Expression'
subroutineArguments :: Statement a -> [Expression a]
subroutineArguments :: forall a. Statement a -> [Expression a]
subroutineArguments (StCall a
_ SrcSpan
_ Expression a
_ AList Argument a
args) =
  forall a b. (a -> b) -> [a] -> [b]
map (\(Argument a
_ SrcSpan
_ Maybe [Char]
_ ArgumentExpression a
e) -> forall a. ArgumentExpression a -> Expression a
argExprNormalize ArgumentExpression a
e) (forall (t :: * -> *) a. AList t a -> [t a]
aStrip AList Argument a
args)
subroutineArguments Statement a
s =
  forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Statement at " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (forall a. Spanned a => a -> SrcSpan
getSpan Statement a
s) forall a. [a] -> [a] -> [a]
++ [Char]
" is not a subroutine call"

-- | case-insenstive string equality
caseInsensitiveEqual :: String -> String -> Bool
caseInsensitiveEqual :: [Char] -> [Char] -> Bool
caseInsensitiveEqual [Char]
s1 [Char]
s2 = forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper [Char]
s1 forall a. Eq a => a -> a -> Bool
== forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper [Char]
s2