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