Generalise function/subroutine call matching / handling to deal with intrinsics as well as ordinary func/sub names.

Author: mrd

src/Language/Fortran/Analysis/BBlocks.hs

@@ -364,13 +364,13 @@ perBlock b@(BlStatement _ _ _ (StReturn {})) =
   processLabel b >> addToBBlock b >> closeBBlock_
 perBlock b@(BlStatement _ _ _ (StGotoUnconditional {})) =
   processLabel b >> addToBBlock b >> closeBBlock_
-perBlock b@(BlStatement a s l (StCall a' s' cn@(ExpValue _ _ (ValVariable {})) Nothing)) = do
+perBlock b@(BlStatement a s l (StCall a' s' cn@(ExpValue _ _ _) Nothing)) = do
   (prevN, callN) <- closeBBlock
   -- put StCall in a bblock by itself
   addToBBlock b
   (_, nextN) <- closeBBlock
   createEdges [ (prevN, callN, ()), (callN, nextN, ()) ]
-perBlock b@(BlStatement a s l (StCall a' s' cn@(ExpValue _ _ (ValVariable {})) (Just aargs))) = do
+perBlock b@(BlStatement a s l (StCall a' s' cn@(ExpValue _ _ _) (Just aargs))) = do
   let exps = map extractExp . aStrip $ aargs
   (prevN, formalN) <- closeBBlock
 
@@ -495,7 +495,7 @@ processFunctionCalls = transformBiM processFunctionCall -- work bottom-up
 -- Flatten out a single function call.
 processFunctionCall :: Data a => Expression (Analysis a) -> BBlocker (Analysis a) (Expression (Analysis a))
 -- precondition: there are no more nested function calls within the actual arguments
-processFunctionCall (ExpFunctionCall a s fn@(ExpValue a' s' (ValVariable _)) aargs) = do
+processFunctionCall (ExpFunctionCall a s fn@(ExpValue a' s' _) aargs) = do
   let a0 = head . initAnalysis $ [prevAnnotation a]
   (prevN, formalN) <- closeBBlock
 
@@ -588,7 +588,7 @@ genSuperBBGr bbm = SuperBBGr { graph = superGraph'', clusters = cmap, entries =
     -- Assumption: all StCalls appear by themselves in a bblock.
     stCalls      :: [(SuperNode, String)]
     stCalls      = [ (getSuperNode n, sub) | (n, [BlStatement _ _ _ (StCall _ _ e Nothing)]) <- namedNodes
-                                           , v@(ExpValue _ _ (ValVariable _))                <- [e]
+                                           , v@(ExpValue _ _ _)                              <- [e]
                                            , let sub = varName v
                                            , Named sub `M.member` entryMap && Named sub `M.member` exitMap ]
     stCallCtxts  :: [([SuperEdge], SuperNode, String, [SuperEdge])]
@@ -737,6 +737,7 @@ showLab Nothing = replicate 6 ' '
 showLab (Just (ExpValue _ _ (ValInteger l))) = ' ':l ++ replicate (5 - length l) ' '
 
 showValue (ValVariable v)       = v
+showValue (ValIntrinsic v)      = v
 showValue (ValInteger v)        = v
 showValue (ValReal v)           = v
 showValue (ValComplex e1 e2)    = "( " ++ showExpr e1 ++ " , " ++ showExpr e2 ++ " )"

src/Language/Fortran/Analysis/DataFlow.hs

@@ -588,8 +588,8 @@ genCallMap pf = flip execState M.empty $ do
     let uE :: Data a => ProgramUnit a -> [Expression a]
         uE = universeBi
     m <- get
-    let ns = [ varName v | StCall _ _ v@(ExpValue _ _ (ValVariable _ )) _         <- uS pu ] ++
-             [ varName v | ExpFunctionCall _ _ v@(ExpValue _ _ (ValVariable _)) _ <- uE pu ]
+    let ns = [ varName v | StCall _ _ v@(ExpValue _ _ _) _          <- uS pu ] ++
+             [ varName v | ExpFunctionCall _ _ v@(ExpValue _ _ _) _ <- uE pu ]
     put $ M.insert n (S.fromList ns) m
 
 --------------------------------------------------

src/Language/Fortran/Analysis/Renaming.hs

@@ -73,8 +73,9 @@ rename pf = trPU fPU (trE fE pf)
     trE :: Data a => (Expression a -> Expression a) -> ProgramFile a -> ProgramFile a
     trE = transformBi
     fE :: Data a => Expression (Analysis a) -> Expression (Analysis a)
-    fE (ExpValue a s (ValVariable v)) = ExpValue a s . ValVariable $ fromMaybe v (uniqueName a)
-    fE x                              = x
+    fE (ExpValue a s (ValVariable v))  = ExpValue a s . ValVariable $ fromMaybe v (uniqueName a)
+    fE (ExpValue a s (ValIntrinsic v)) = ExpValue a s . ValIntrinsic $ fromMaybe v (uniqueName a)
+    fE x                               = x
 
     trPU :: Data a => (ProgramUnit a -> ProgramUnit a) -> ProgramFile a -> ProgramFile a
     trPU = transformBi
@@ -92,8 +93,9 @@ unrename pf = trPU fPU . trE fE $ pf
     trE :: Data a => (Expression (Analysis a) -> Expression (Analysis a)) -> ProgramFile (Analysis a) -> ProgramFile (Analysis a)
     trE = transformBi
     fE :: Data a => Expression (Analysis a) -> Expression (Analysis a)
-    fE e@(ExpValue a s (ValVariable _)) = ExpValue a s (ValVariable (srcName e))
-    fE e                                = e
+    fE e@(ExpValue a s (ValVariable _))  = ExpValue a s (ValVariable (srcName e))
+    fE e@(ExpValue a s (ValIntrinsic _)) = ExpValue a s (ValIntrinsic (srcName e))
+    fE e                                 = e
 
     trPU :: Data a => (ProgramUnit (Analysis a) -> ProgramUnit (Analysis a)) -> ProgramFile (Analysis a) -> ProgramFile (Analysis a)
     trPU = transformBi
@@ -111,7 +113,7 @@ unrename pf = trPU fPU . trE fE $ pf
 extractNameMap :: Data a => ProgramFile (Analysis a) -> NameMap
 extractNameMap pf = eMap `union` puMap
   where
-    eMap  = fromList [ (un, n) | ExpValue (Analysis { uniqueName = Just un }) _ (ValVariable n) <- uniE pf ]
+    eMap  = fromList [ (un, srcName e) | e@(ExpValue (Analysis { uniqueName = Just un }) _ _) <- uniE pf ]
     puMap = fromList [ (un, n) | pu <- uniPU pf, Named un <- [puName pu], Named n <- [getName pu], n /= un ]
     uniE :: Data a => ProgramFile a -> [Expression a]
     uniE = universeBi
@@ -393,8 +395,10 @@ renameGenericDecls = trans renameExpDecl
 -- declaration that possibly requires the creation of a new unique
 -- mapping.
 renameExpDecl :: Data a => RenamerFunc (Expression (Analysis a))
-renameExpDecl e@(ExpValue _ _ (ValVariable v)) = flip setUniqueName (setSourceName v e) `fmap` maybeAddUnique v NTVariable
-renameExpDecl e                                = return e
+renameExpDecl e@(ExpValue _ _ (ValVariable v))  = flip setUniqueName (setSourceName v e) `fmap` maybeAddUnique v NTVariable
+-- Intrinsics get unique names for each use.
+renameExpDecl e@(ExpValue _ _ (ValIntrinsic v)) = flip setUniqueName (setSourceName v e) `fmap` addUnique v NTVariable
+renameExpDecl e                                 = return e
 
 -- Find all declarators within a value and then dive within those
 -- declarators to rename any ExpValue variables, assuming they might
@@ -429,6 +433,7 @@ renameEntryPointResultDecl b = return b
 -- reference to a previous declaration, possibly in an outer scope.
 renameExp :: Data a => RenamerFunc (Expression (Analysis a))
 renameExp e@(ExpValue _ _ (ValVariable v)) = maybe e (flip setUniqueName (setSourceName v e)) `fmap` getFromEnvs v
+-- FIXME: do Intrinsics need handling here?
 renameExp e                                = return e
 
 -- Rename all ExpValue variables found within the block, assuming that

src/Language/Fortran/Analysis/Types.hs

@@ -159,8 +159,9 @@ statement (StDimension _ _ declAList) = do
 statement _ = return ()
 
 annotateExpression :: Data a => Expression (Analysis a) -> Infer (Expression (Analysis a))
-annotateExpression e@(ExpValue _ _ (ValVariable _)) = maybe e (flip setIDType e) `fmap` getRecordedType (varName e)
-annotateExpression e                                = return e
+annotateExpression e@(ExpValue _ _ (ValVariable _))  = maybe e (flip setIDType e) `fmap` getRecordedType (varName e)
+annotateExpression e@(ExpValue _ _ (ValIntrinsic _)) = maybe e (flip setIDType e) `fmap` getRecordedType (varName e)
+annotateExpression e                                 = return e
 
 annotateProgramUnit :: Data a => ProgramUnit (Analysis a) -> Infer (ProgramUnit (Analysis a))
 annotateProgramUnit pu | Named n <- puName pu = maybe pu (flip setIDType pu) `fmap` getRecordedType n