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
                                                )
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 Maybe (AList Argument (Analysis a))
_) <- b (Analysis a) -> [Expression (Analysis a)]
forall from to. Biplate from to => from -> [to]
universeBi b (Analysis a)
x
  , [Char] -> [Char] -> Bool
caseInsensitiveEqual (Expression (Analysis a) -> [Char]
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 Maybe (AList Argument (Analysis a))
_) <- b (Analysis a) -> [Statement (Analysis a)]
forall from to. Biplate from to => from -> [to]
universeBi b (Analysis a)
x, Expression (Analysis a) -> [Char]
forall a. Expression (Analysis a) -> [Char]
srcName Expression (Analysis a)
v [Char] -> [Char] -> Bool
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
_ Maybe (AList Argument a)
args) = case Maybe (AList Argument a)
args of
  Just AList Argument a
args' -> (Argument a -> Expression a) -> [Argument a] -> [Expression a]
forall a b. (a -> b) -> [a] -> [b]
map (\(Argument a
_ SrcSpan
_ Maybe [Char]
_ Expression a
e) -> Expression a
e) (AList Argument a -> [Argument a]
forall (t :: * -> *) a. AList t a -> [t a]
aStrip AList Argument a
args')
  Maybe (AList Argument a)
Nothing    -> []
functionArguments Expression a
e =
  [Char] -> [Expression a]
forall a. HasCallStack => [Char] -> a
error ([Char] -> [Expression a]) -> [Char] -> [Expression a]
forall a b. (a -> b) -> a -> b
$ [Char]
"Expression at " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ SrcSpan -> [Char]
forall a. Show a => a -> [Char]
show (Expression a -> SrcSpan
forall a. Spanned a => a -> SrcSpan
getSpan Expression a
e) [Char] -> [Char] -> [Char]
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
_ Maybe (AList Argument a)
args) = case Maybe (AList Argument a)
args of
  Just AList Argument a
args' -> (Argument a -> Expression a) -> [Argument a] -> [Expression a]
forall a b. (a -> b) -> [a] -> [b]
map (\(Argument a
_ SrcSpan
_ Maybe [Char]
_ Expression a
e) -> Expression a
e) (AList Argument a -> [Argument a]
forall (t :: * -> *) a. AList t a -> [t a]
aStrip AList Argument a
args')
  Maybe (AList Argument a)
Nothing    -> []
subroutineArguments Statement a
s =
  [Char] -> [Expression a]
forall a. HasCallStack => [Char] -> a
error ([Char] -> [Expression a]) -> [Char] -> [Expression a]
forall a b. (a -> b) -> a -> b
$ [Char]
"Statement at " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ SrcSpan -> [Char]
forall a. Show a => a -> [Char]
show (Statement a -> SrcSpan
forall a. Spanned a => a -> SrcSpan
getSpan Statement a
s) [Char] -> [Char] -> [Char]
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 = (Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper [Char]
s1 [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== (Char -> Char) -> [Char] -> [Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper [Char]
s2