module Language.Fortran.Transformation.Disambiguation.Function (disambiguateFunction) where

import Prelude hiding (lookup)
import Data.Generics.Uniplate.Data
import Data.Data

import Language.Fortran.Analysis
import Language.Fortran.AST
import Language.Fortran.Transformation.Monad


disambiguateFunction :: Data a => Transform a ()
disambiguateFunction :: forall a. Data a => Transform a ()
disambiguateFunction = do
  forall a. Data a => Transform a ()
disambiguateFunctionStatements
  forall a. Data a => Transform a ()
disambiguateFunctionCalls

disambiguateFunctionStatements :: Data a => Transform a ()
disambiguateFunctionStatements :: forall a. Data a => Transform a ()
disambiguateFunctionStatements = forall a.
(ProgramFile (Analysis a) -> ProgramFile (Analysis a))
-> Transform a ()
modifyProgramFile (TransFunc Statement ProgramFile a
trans forall {a}. Statement (Analysis a) -> Statement (Analysis a)
statement)
  where
    trans :: TransFunc Statement ProgramFile a
trans = forall from to. Biplate from to => (to -> to) -> from -> from
transformBi :: Data a => TransFunc Statement ProgramFile a
    statement :: Statement (Analysis a) -> Statement (Analysis a)
statement (StExpressionAssign Analysis a
a1 SrcSpan
s (ExpSubscript Analysis a
_ SrcSpan
_ v :: Expression (Analysis a)
v@(ExpValue Analysis a
a SrcSpan
_ (ValVariable Name
_)) AList Index (Analysis a)
indicies) Expression (Analysis a)
e2)
      | Just (IDType Maybe SemType
_ (Just ConstructType
CTFunction)) <- forall a. Analysis a -> Maybe IDType
idType Analysis a
a
      , forall a. AList Index a -> Bool
indiciesRangeFree AList Index (Analysis a)
indicies = forall a.
a
-> SrcSpan
-> Expression a
-> AList Expression a
-> Expression a
-> Statement a
StFunction Analysis a
a1 SrcSpan
s Expression (Analysis a)
v (forall (t :: * -> *) a (r :: * -> *).
(t a -> r a) -> AList t a -> AList r a
aMap forall (a :: * -> *) b. Indexed a => Index b -> a b
fromIndex AList Index (Analysis a)
indicies) Expression (Analysis a)
e2
    -- nullary statement function
    statement st :: Statement (Analysis a)
st@(StExpressionAssign Analysis a
a1 SrcSpan
s1 (ExpFunctionCall Analysis a
_ SrcSpan
_ v :: Expression (Analysis a)
v@(ExpValue Analysis a
a SrcSpan
s (ValVariable Name
_)) AList Argument (Analysis a)
args) Expression (Analysis a)
e2) =
        case forall (t :: * -> *) a. AList t a -> [t a]
alistList AList Argument (Analysis a)
args of
          []  -> forall a.
a
-> SrcSpan
-> Expression a
-> AList Expression a
-> Expression a
-> Statement a
StFunction Analysis a
a1 SrcSpan
s1 Expression (Analysis a)
v (forall (t :: * -> *) a. a -> SrcSpan -> [t a] -> AList t a
AList Analysis a
a SrcSpan
s []) Expression (Analysis a)
e2
          Argument (Analysis a)
_:[Argument (Analysis a)]
_ -> Statement (Analysis a)
st
    statement Statement (Analysis a)
st                                      = Statement (Analysis a)
st

disambiguateFunctionCalls :: Data a => Transform a ()
disambiguateFunctionCalls :: forall a. Data a => Transform a ()
disambiguateFunctionCalls = forall a.
(ProgramFile (Analysis a) -> ProgramFile (Analysis a))
-> Transform a ()
modifyProgramFile (TransFunc Expression ProgramFile a
trans forall {a}. Expression (Analysis a) -> Expression (Analysis a)
expression)
  where
    trans :: TransFunc Expression ProgramFile a
trans = forall from to. Biplate from to => (to -> to) -> from -> from
transformBi :: Data a => TransFunc Expression ProgramFile a
    expression :: Expression (Analysis a) -> Expression (Analysis a)
expression (ExpSubscript Analysis a
a1 SrcSpan
s v :: Expression (Analysis a)
v@(ExpValue Analysis a
a SrcSpan
_ (ValVariable Name
_)) AList Index (Analysis a)
indicies)
      | Just (IDType Maybe SemType
_ (Just ConstructType
CTFunction)) <- forall a. Analysis a -> Maybe IDType
idType Analysis a
a
      , forall a. AList Index a -> Bool
indiciesRangeFree AList Index (Analysis a)
indicies = forall a.
a -> SrcSpan -> Expression a -> AList Argument a -> Expression a
ExpFunctionCall Analysis a
a1 SrcSpan
s Expression (Analysis a)
v (forall (t :: * -> *) a (r :: * -> *).
(t a -> r a) -> AList t a -> AList r a
aMap forall (a :: * -> *) b. Indexed a => Index b -> a b
fromIndex AList Index (Analysis a)
indicies)
      | Just (IDType Maybe SemType
_ (Just ConstructType
CTExternal)) <- forall a. Analysis a -> Maybe IDType
idType Analysis a
a
      , forall a. AList Index a -> Bool
indiciesRangeFree AList Index (Analysis a)
indicies = forall a.
a -> SrcSpan -> Expression a -> AList Argument a -> Expression a
ExpFunctionCall Analysis a
a1 SrcSpan
s Expression (Analysis a)
v (forall (t :: * -> *) a (r :: * -> *).
(t a -> r a) -> AList t a -> AList r a
aMap forall (a :: * -> *) b. Indexed a => Index b -> a b
fromIndex AList Index (Analysis a)
indicies)
      | Just (IDType Maybe SemType
_ (Just ConstructType
CTVariable)) <- forall a. Analysis a -> Maybe IDType
idType Analysis a
a
      , forall a. AList Index a -> Bool
indiciesRangeFree AList Index (Analysis a)
indicies = forall a.
a -> SrcSpan -> Expression a -> AList Argument a -> Expression a
ExpFunctionCall Analysis a
a1 SrcSpan
s Expression (Analysis a)
v (forall (t :: * -> *) a (r :: * -> *).
(t a -> r a) -> AList t a -> AList r a
aMap forall (a :: * -> *) b. Indexed a => Index b -> a b
fromIndex AList Index (Analysis a)
indicies)
      | Maybe IDType
Nothing <- forall a. Analysis a -> Maybe IDType
idType Analysis a
a
      , forall a. AList Index a -> Bool
indiciesRangeFree AList Index (Analysis a)
indicies = forall a.
a -> SrcSpan -> Expression a -> AList Argument a -> Expression a
ExpFunctionCall Analysis a
a1 SrcSpan
s Expression (Analysis a)
v (forall (t :: * -> *) a (r :: * -> *).
(t a -> r a) -> AList t a -> AList r a
aMap forall (a :: * -> *) b. Indexed a => Index b -> a b
fromIndex AList Index (Analysis a)
indicies)
    expression (ExpSubscript Analysis a
a1 SrcSpan
s v :: Expression (Analysis a)
v@(ExpValue Analysis a
a SrcSpan
_ (ValIntrinsic Name
_)) AList Index (Analysis a)
indicies)
      | Just (IDType Maybe SemType
_ (Just ConstructType
CTIntrinsic)) <- forall a. Analysis a -> Maybe IDType
idType Analysis a
a
      , forall a. AList Index a -> Bool
indiciesRangeFree AList Index (Analysis a)
indicies = forall a.
a -> SrcSpan -> Expression a -> AList Argument a -> Expression a
ExpFunctionCall Analysis a
a1 SrcSpan
s Expression (Analysis a)
v (forall (t :: * -> *) a (r :: * -> *).
(t a -> r a) -> AList t a -> AList r a
aMap forall (a :: * -> *) b. Indexed a => Index b -> a b
fromIndex AList Index (Analysis a)
indicies)
    expression Expression (Analysis a)
e                                      = Expression (Analysis a)
e

-- BEGIN: TODO STRICTLY TO BE REMOVED LATER TODO
indiciesRangeFree :: AList Index a -> Bool
indiciesRangeFree :: forall a. AList Index a -> Bool
indiciesRangeFree AList Index a
aIndicies = forall {a}. [Index a] -> Bool
cRange forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. AList t a -> [t a]
aStrip AList Index a
aIndicies
  where
    cRange :: [Index a] -> Bool
cRange [] = Bool
True
    cRange (IxSingle{}:[Index a]
xs) = [Index a] -> Bool
cRange [Index a]
xs
    cRange (IxRange{}:[Index a]
_) = Bool
False
-- END: TODO STRICTLY TO BE REMOVED LATER TODO

class Indexed a where
  fromIndex :: Index b -> a b

instance Indexed Argument where
  fromIndex :: forall b. Index b -> Argument b
fromIndex (IxSingle b
a SrcSpan
s Maybe Name
mKey Expression b
e) = forall a.
a -> SrcSpan -> Maybe Name -> ArgumentExpression a -> Argument a
Argument b
a SrcSpan
s Maybe Name
mKey (forall a. Expression a -> ArgumentExpression a
ArgExpr Expression b
e)
  fromIndex IxRange{} =
    forall a. HasCallStack => Name -> a
error Name
"Deduced a function but argument is not an expression."

instance Indexed Expression where
  fromIndex :: forall b. Index b -> Expression b
fromIndex (IxSingle b
_ SrcSpan
_ Maybe Name
_ Expression b
e) = Expression b
e
  fromIndex IxRange{} =
    forall a. HasCallStack => Name -> a
error Name
"Deduced a function but argument is not an expression."

--------------------------------------------------

-- Local variables:
-- mode: haskell
-- haskell-program-name: "cabal repl"
-- End: