{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE PatternGuards #-}

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.TransformMonad


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

disambiguateFunctionStatements :: Data a => Transform a ()
disambiguateFunctionStatements :: Transform a ()
disambiguateFunctionStatements = (ProgramFile (Analysis a) -> ProgramFile (Analysis a))
-> Transform a ()
forall a.
(ProgramFile (Analysis a) -> ProgramFile (Analysis a))
-> Transform a ()
modifyProgramFile (TransFunc Statement ProgramFile a
trans Statement (Analysis a) -> Statement (Analysis a)
forall a. Statement (Analysis a) -> Statement (Analysis a)
statement)
  where
    trans :: TransFunc Statement ProgramFile a
trans = forall a.
Data a =>
(Statement (Analysis a) -> Statement (Analysis a))
-> ProgramFile (Analysis a) -> ProgramFile (Analysis a)
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 BaseType
_ (Just ConstructType
CTFunction)) <- Analysis a -> Maybe IDType
forall a. Analysis a -> Maybe IDType
idType Analysis a
a
      , AList Index (Analysis a) -> Bool
forall a. AList Index a -> Bool
indiciesRangeFree AList Index (Analysis a)
indicies = Analysis a
-> SrcSpan
-> Expression (Analysis a)
-> AList Expression (Analysis a)
-> Expression (Analysis a)
-> Statement (Analysis a)
forall a.
a
-> SrcSpan
-> Expression a
-> AList Expression a
-> Expression a
-> Statement a
StFunction Analysis a
a1 SrcSpan
s Expression (Analysis a)
v ((Index (Analysis a) -> Expression (Analysis a))
-> AList Index (Analysis a) -> AList Expression (Analysis a)
forall (t :: * -> *) a (r :: * -> *).
(t a -> r a) -> AList t a -> AList r a
aMap Index (Analysis a) -> Expression (Analysis a)
forall (a :: * -> *) b. Indexed a => Index b -> a b
fromIndex AList Index (Analysis a)
indicies) Expression (Analysis a)
e2
    -- nullary statement function
    statement (StExpressionAssign Analysis a
a1 SrcSpan
s1 (ExpFunctionCall Analysis a
_ SrcSpan
_ v :: Expression (Analysis a)
v@(ExpValue Analysis a
a SrcSpan
s (ValVariable Name
_)) Maybe (AList Argument (Analysis a))
Nothing) Expression (Analysis a)
e2)
      = Analysis a
-> SrcSpan
-> Expression (Analysis a)
-> AList Expression (Analysis a)
-> Expression (Analysis a)
-> Statement (Analysis a)
forall a.
a
-> SrcSpan
-> Expression a
-> AList Expression a
-> Expression a
-> Statement a
StFunction Analysis a
a1 SrcSpan
s1 Expression (Analysis a)
v (Analysis a
-> SrcSpan
-> [Expression (Analysis a)]
-> AList Expression (Analysis a)
forall (t :: * -> *) a. a -> SrcSpan -> [t a] -> AList t a
AList Analysis a
a SrcSpan
s []) Expression (Analysis a)
e2
    statement Statement (Analysis a)
st                                      = Statement (Analysis a)
st

disambiguateFunctionCalls :: Data a => Transform a ()
disambiguateFunctionCalls :: Transform a ()
disambiguateFunctionCalls = (ProgramFile (Analysis a) -> ProgramFile (Analysis a))
-> Transform a ()
forall a.
(ProgramFile (Analysis a) -> ProgramFile (Analysis a))
-> Transform a ()
modifyProgramFile (TransFunc Expression ProgramFile a
trans Expression (Analysis a) -> Expression (Analysis a)
forall a. Expression (Analysis a) -> Expression (Analysis a)
expression)
  where
    trans :: TransFunc Expression ProgramFile a
trans = forall a.
Data a =>
(Expression (Analysis a) -> Expression (Analysis a))
-> ProgramFile (Analysis a) -> ProgramFile (Analysis a)
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 BaseType
_ (Just ConstructType
CTFunction)) <- Analysis a -> Maybe IDType
forall a. Analysis a -> Maybe IDType
idType Analysis a
a
      , AList Index (Analysis a) -> Bool
forall a. AList Index a -> Bool
indiciesRangeFree AList Index (Analysis a)
indicies = Analysis a
-> SrcSpan
-> Expression (Analysis a)
-> Maybe (AList Argument (Analysis a))
-> Expression (Analysis a)
forall a.
a
-> SrcSpan
-> Expression a
-> Maybe (AList Argument a)
-> Expression a
ExpFunctionCall Analysis a
a1 SrcSpan
s Expression (Analysis a)
v (AList Argument (Analysis a) -> Maybe (AList Argument (Analysis a))
forall a. a -> Maybe a
Just (AList Argument (Analysis a)
 -> Maybe (AList Argument (Analysis a)))
-> AList Argument (Analysis a)
-> Maybe (AList Argument (Analysis a))
forall a b. (a -> b) -> a -> b
$ (Index (Analysis a) -> Argument (Analysis a))
-> AList Index (Analysis a) -> AList Argument (Analysis a)
forall (t :: * -> *) a (r :: * -> *).
(t a -> r a) -> AList t a -> AList r a
aMap Index (Analysis a) -> Argument (Analysis a)
forall (a :: * -> *) b. Indexed a => Index b -> a b
fromIndex AList Index (Analysis a)
indicies)
      | Just (IDType Maybe BaseType
_ (Just ConstructType
CTExternal)) <- Analysis a -> Maybe IDType
forall a. Analysis a -> Maybe IDType
idType Analysis a
a
      , AList Index (Analysis a) -> Bool
forall a. AList Index a -> Bool
indiciesRangeFree AList Index (Analysis a)
indicies = Analysis a
-> SrcSpan
-> Expression (Analysis a)
-> Maybe (AList Argument (Analysis a))
-> Expression (Analysis a)
forall a.
a
-> SrcSpan
-> Expression a
-> Maybe (AList Argument a)
-> Expression a
ExpFunctionCall Analysis a
a1 SrcSpan
s Expression (Analysis a)
v (AList Argument (Analysis a) -> Maybe (AList Argument (Analysis a))
forall a. a -> Maybe a
Just (AList Argument (Analysis a)
 -> Maybe (AList Argument (Analysis a)))
-> AList Argument (Analysis a)
-> Maybe (AList Argument (Analysis a))
forall a b. (a -> b) -> a -> b
$ (Index (Analysis a) -> Argument (Analysis a))
-> AList Index (Analysis a) -> AList Argument (Analysis a)
forall (t :: * -> *) a (r :: * -> *).
(t a -> r a) -> AList t a -> AList r a
aMap Index (Analysis a) -> Argument (Analysis a)
forall (a :: * -> *) b. Indexed a => Index b -> a b
fromIndex AList Index (Analysis a)
indicies)
      | Just (IDType Maybe BaseType
_ (Just ConstructType
CTVariable)) <- Analysis a -> Maybe IDType
forall a. Analysis a -> Maybe IDType
idType Analysis a
a
      , AList Index (Analysis a) -> Bool
forall a. AList Index a -> Bool
indiciesRangeFree AList Index (Analysis a)
indicies = Analysis a
-> SrcSpan
-> Expression (Analysis a)
-> Maybe (AList Argument (Analysis a))
-> Expression (Analysis a)
forall a.
a
-> SrcSpan
-> Expression a
-> Maybe (AList Argument a)
-> Expression a
ExpFunctionCall Analysis a
a1 SrcSpan
s Expression (Analysis a)
v (AList Argument (Analysis a) -> Maybe (AList Argument (Analysis a))
forall a. a -> Maybe a
Just (AList Argument (Analysis a)
 -> Maybe (AList Argument (Analysis a)))
-> AList Argument (Analysis a)
-> Maybe (AList Argument (Analysis a))
forall a b. (a -> b) -> a -> b
$ (Index (Analysis a) -> Argument (Analysis a))
-> AList Index (Analysis a) -> AList Argument (Analysis a)
forall (t :: * -> *) a (r :: * -> *).
(t a -> r a) -> AList t a -> AList r a
aMap Index (Analysis a) -> Argument (Analysis a)
forall (a :: * -> *) b. Indexed a => Index b -> a b
fromIndex AList Index (Analysis a)
indicies)
      | Maybe IDType
Nothing <- Analysis a -> Maybe IDType
forall a. Analysis a -> Maybe IDType
idType Analysis a
a
      , AList Index (Analysis a) -> Bool
forall a. AList Index a -> Bool
indiciesRangeFree AList Index (Analysis a)
indicies = Analysis a
-> SrcSpan
-> Expression (Analysis a)
-> Maybe (AList Argument (Analysis a))
-> Expression (Analysis a)
forall a.
a
-> SrcSpan
-> Expression a
-> Maybe (AList Argument a)
-> Expression a
ExpFunctionCall Analysis a
a1 SrcSpan
s Expression (Analysis a)
v (AList Argument (Analysis a) -> Maybe (AList Argument (Analysis a))
forall a. a -> Maybe a
Just (AList Argument (Analysis a)
 -> Maybe (AList Argument (Analysis a)))
-> AList Argument (Analysis a)
-> Maybe (AList Argument (Analysis a))
forall a b. (a -> b) -> a -> b
$ (Index (Analysis a) -> Argument (Analysis a))
-> AList Index (Analysis a) -> AList Argument (Analysis a)
forall (t :: * -> *) a (r :: * -> *).
(t a -> r a) -> AList t a -> AList r a
aMap Index (Analysis a) -> Argument (Analysis a)
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 BaseType
_ (Just ConstructType
CTIntrinsic)) <- Analysis a -> Maybe IDType
forall a. Analysis a -> Maybe IDType
idType Analysis a
a
      , AList Index (Analysis a) -> Bool
forall a. AList Index a -> Bool
indiciesRangeFree AList Index (Analysis a)
indicies = Analysis a
-> SrcSpan
-> Expression (Analysis a)
-> Maybe (AList Argument (Analysis a))
-> Expression (Analysis a)
forall a.
a
-> SrcSpan
-> Expression a
-> Maybe (AList Argument a)
-> Expression a
ExpFunctionCall Analysis a
a1 SrcSpan
s Expression (Analysis a)
v (AList Argument (Analysis a) -> Maybe (AList Argument (Analysis a))
forall a. a -> Maybe a
Just (AList Argument (Analysis a)
 -> Maybe (AList Argument (Analysis a)))
-> AList Argument (Analysis a)
-> Maybe (AList Argument (Analysis a))
forall a b. (a -> b) -> a -> b
$ (Index (Analysis a) -> Argument (Analysis a))
-> AList Index (Analysis a) -> AList Argument (Analysis a)
forall (t :: * -> *) a (r :: * -> *).
(t a -> r a) -> AList t a -> AList r a
aMap Index (Analysis a) -> Argument (Analysis a)
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 :: AList Index a -> Bool
indiciesRangeFree AList Index a
aIndicies = [Index a] -> Bool
forall a. [Index a] -> Bool
cRange ([Index a] -> Bool) -> [Index a] -> Bool
forall a b. (a -> b) -> a -> b
$ AList Index a -> [Index a]
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 :: Index b -> Argument b
fromIndex (IxSingle b
a SrcSpan
s Maybe Name
mKey Expression b
e) = b -> SrcSpan -> Maybe Name -> Expression b -> Argument b
forall a. a -> SrcSpan -> Maybe Name -> Expression a -> Argument a
Argument b
a SrcSpan
s Maybe Name
mKey Expression b
e
  fromIndex IxRange{} =
    Name -> Argument b
forall a. HasCallStack => Name -> a
error Name
"Deduced a function but argument is not an expression."

instance Indexed Expression where
  fromIndex :: Index b -> Expression b
fromIndex (IxSingle b
_ SrcSpan
_ Maybe Name
_ Expression b
e) = Expression b
e
  fromIndex IxRange{} =
    Name -> Expression b
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: