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 = do
disambiguateFunctionStatements
disambiguateFunctionCalls
disambiguateFunctionStatements :: Data a => Transform a ()
disambiguateFunctionStatements = modifyProgramFile (trans statement)
where
trans = (transformBi :: Data a => TransFunc Statement ProgramFile a)
statement st@(StExpressionAssign a1 s (ExpSubscript _ _ v@(ExpValue a _ (ValVariable _)) indicies) e2)
| Just (IDType _ (Just CTFunction)) <- idType a
, indiciesRangeFree indicies = StFunction a1 s v (aMap fromIndex indicies) e2
statement st = st
disambiguateFunctionCalls :: Data a => Transform a ()
disambiguateFunctionCalls = modifyProgramFile (trans expression)
where
trans = (transformBi :: Data a => TransFunc Expression ProgramFile a)
expression e@(ExpSubscript a1 s v@(ExpValue a _ (ValVariable _)) indicies)
| Just (IDType _ (Just CTFunction)) <- idType a
, indiciesRangeFree indicies = ExpFunctionCall a1 s v (Just $ aMap fromIndex indicies)
expression e@(ExpSubscript a1 s v@(ExpValue a _ (ValIntrinsic _)) indicies)
| Just (IDType _ (Just CTIntrinsic)) <- idType a
, indiciesRangeFree indicies = ExpFunctionCall a1 s v (Just $ aMap fromIndex indicies)
expression e = e
indiciesRangeFree aIndicies = cRange $ aStrip aIndicies
where
cRange [] = True
cRange (IxSingle{}:xs) = cRange xs
cRange (IxRange{}:_) = False
class Indexed a where
fromIndex :: Index b -> a b
instance Indexed Argument where
fromIndex (IxSingle a s mKey e) = Argument a s mKey e
fromIndex IxRange{} =
error "Deduced a function but argument is not an expression."
instance Indexed Expression where
fromIndex (IxSingle _ _ _ e) = e
fromIndex IxRange{} =
error "Deduced a function but argument is not an expression."