Store source names for declMaps in mod files

CHANGELOG.md

@@ -1,3 +1,6 @@
+### 0.16.3
+  * Store source names for local declarations in .fsmod files.
+
 ### 0.16.2 (Sep 13, 2024)
   * Small change to allow a path to be added when building mod-file naming map
   * Improvements to the power of constant propagation and constant expression evaluation.

app/Main.hs

@@ -51,7 +51,7 @@ programName :: String
 programName = "fortran-src"
 
 showVersion :: String
-showVersion = "0.16.2"
+showVersion = "0.16.3"
 
 main :: IO ()
 main = do

fortran-src.cabal

@@ -5,7 +5,7 @@ cabal-version: 1.12
 -- see: https://github.com/sol/hpack
 
 name:           fortran-src
-version:        0.16.2
+version:        0.16.3
 synopsis:       Parsers and analyses for Fortran standards 66, 77, 90, 95 and 2003 (partial).
 description:    Provides lexing, parsing, and basic analyses of Fortran code covering standards: FORTRAN 66, FORTRAN 77, Fortran 90, Fortran 95, Fortran 2003 (partial) and some legacy extensions. Includes data flow and basic block analysis, a renamer, and type analysis. For example usage, see the @<https://hackage.haskell.org/package/camfort CamFort>@ project, which uses fortran-src as its front end.
 category:       Language

package.yaml

@@ -1,5 +1,5 @@
 name: fortran-src
-version: '0.16.2'
+version: '0.16.3'
 synopsis: Parsers and analyses for Fortran standards 66, 77, 90, 95 and 2003 (partial).
 description: >-
   Provides lexing, parsing, and basic analyses of Fortran code covering

src/Language/Fortran/Repr/Eval/Value.hs

@@ -12,11 +12,11 @@
 
 import Language.Fortran.Repr.Value
 import Language.Fortran.Repr.Value.Scalar
 import Language.Fortran.Repr.Value.Scalar.Common
 import Language.Fortran.Repr.Value.Scalar.Int.Machine
 import Language.Fortran.Repr.Value.Scalar.Real
 import Language.Fortran.Repr.Value.Scalar.Logical.Machine
 import Language.Fortran.Repr.Value.Scalar.String
 
 import Language.Fortran.Repr.Type ( FType )
 import Language.Fortran.Repr.Type.Scalar.Common ( FKindLit )
@@ -35,7 +35,7 @@
 
 import Control.Monad.Except
 
 import Data.Word ( Word8 )
 
 -- pure implementation
 import Control.Monad.Reader
@@ -108,7 +108,7 @@
 evalExpr = \case
   e@(F.ExpValue _ _ astVal) ->
     case astVal of
       F.ValVariable name -> evalVar (FA.varName e)
       -- TODO: Do same with ValIntrinsic??? idk...
       _ -> MkFScalarValue <$> evalLit astVal
   F.ExpUnary  _ _ uop e   -> do
@@ -269,9 +269,16 @@
 
       -- TODO basic - ints only. probably should support floats too.
       F.Exponentiation ->
         case (l', r') of
           (FSVInt li, FSVInt ri) ->
             pure $ MkFScalarValue $ FSVInt $ fIntBOpInplace (^) li ri
+          (FSVReal lr, FSVReal ri) ->
+            pure $ MkFScalarValue $ FSVReal $ fRealBOpInplace' (**) (**) lr ri
+          (FSVReal lr, FSVInt ri) ->
+            -- Handle case of a real raised to an integer power.
+            pure $ MkFScalarValue $ FSVReal $ fRealBOpInplace' (**) (**) lr (FReal8 $ withFInt ri)
+
+--          _ -> err $ ELazy "exponentiation: unsupported types"
 
       F.Concatenation  ->
         case (l', r') of
@@ -310,7 +317,7 @@
 
       "kind"  -> do
         args' <- forceArgs 1 args
         let [v] = args'
         v' <- forceScalar v
         let t = fScalarValueType v'
         case fScalarTypeKind t of
@@ -319,7 +326,7 @@
 
       "ior"  -> do
         args' <- forceArgs 2 args
         let [l, r] = args'
         l' <- forceScalar l
         r' <- forceScalar r
         evalIntrinsicIor l' r'
@@ -328,7 +335,7 @@
 
       "char" -> do
         args' <- forceArgs 1 args
         let [v] = args'
         v' <- forceScalar v
         case v' of
           FSVInt i -> do
@@ -341,7 +348,7 @@
 
       "not"  -> do
         args' <- forceArgs 1 args
         let [v] = args'
         v' <- forceScalar v
         case v' of
           FSVInt i -> do
@@ -368,7 +375,7 @@
       -- TODO all lies
       "int2" -> do
         args' <- forceArgs 1 args
         let [v] = args'
         v' <- forceScalar v
         case v' of
           FSVInt{} ->

src/Language/Fortran/Util/ModFile.hs

@@ -103,8 +103,9 @@ data DeclContext = DCMain | DCBlockData | DCModule F.ProgramUnitName
 instance Binary DeclContext
 
 -- | Map of unique variable name to the unique name of the program
--- unit where it was defined, and the corresponding SrcSpan.
-type DeclMap = M.Map F.Name (DeclContext, P.SrcSpan)
+-- unit where it was defined, its source name,
+-- and the corresponding SrcSpan.
+type DeclMap = M.Map F.Name (DeclContext, F.Name, P.SrcSpan)
 
 -- | A map of aliases => strings, in order to save space and share
 -- structure for repeated strings.
@@ -120,7 +121,8 @@ data ModFile = ModFile { mfFilename    :: String
                        , mfDeclMap     :: DeclMap
                        , mfTypeEnv     :: FAT.TypeEnv
                        , mfParamVarMap :: ParamVarMap
-                       , mfOtherData   :: M.Map String LB.ByteString }
+                       , mfOtherData   :: M.Map String LB.ByteString
+                      }
   deriving (Eq, Show, Data, Typeable, Generic)
 
 instance Binary ModFile
@@ -250,18 +252,23 @@ moduleFilename = mfFilename
 
 -- | Create a map that links all unique variable/function names in the
 -- ModFiles to their corresponding *originating* filename (i.e., where they are declared)
-genUniqNameToFilenameMap :: FilePath -> ModFiles -> M.Map F.Name String
-genUniqNameToFilenameMap localPath = M.unions . map perMF
+-- paired with their source name (maybe)
+genUniqNameToFilenameMap :: FilePath -> ModFiles -> M.Map F.Name (String, Maybe F.Name)
+genUniqNameToFilenameMap localPath m = M.unions . map perMF $ m
   where
     perMF mf = M.fromList
-                [ (n, normalise $ localPath </> fname)
-                   | modEnv <- M.elems localModuleMap
-                   , (n, _) <- M.elems modEnv ]
+                $ [ (n, (fname, Nothing))
+                     | (_p, modEnv) <- M.toList localModuleMap
+                     , (n, _) <- M.elems modEnv ]
+              -- decl map information
+               <>  [(n, (fname, Just srcName)) | (n, (_dc, srcName, _)) <- M.toList declMap ]
+
       where
         -- Make sure that we remove imported declarations so we can
         -- properly localise declarations to the originator file.
         localModuleMap = localisedModuleMap $ mfModuleMap mf
-        fname = mfFilename mf
+        declMap        = mfDeclMap mf
+        fname = normalise $ localPath </> mfFilename mf
 
 --------------------------------------------------
 
@@ -288,28 +295,28 @@ extractDeclMap pf = M.fromList . concatMap (blockDecls . nameAndBlocks) $ univer
   where
     -- Extract variable names, source spans from declarations (and
     -- from function return variable if present)
-    blockDecls :: (DeclContext, Maybe (F.Name, P.SrcSpan), [F.Block (FA.Analysis a)]) -> [(F.Name, (DeclContext, P.SrcSpan))]
+    blockDecls :: (DeclContext, Maybe (F.Name, F.Name, P.SrcSpan), [F.Block (FA.Analysis a)]) -> [(F.Name, (DeclContext, F.Name, P.SrcSpan))]
     blockDecls (dc, mret, bs)
       | Nothing        <- mret = map decls (universeBi bs)
-      | Just (ret, ss) <- mret = (ret, (dc, ss)):map decls (universeBi bs)
+      | Just (ret, srcName, ss) <- mret = (ret, (dc, srcName, ss)):map decls (universeBi bs)
       where
-        decls d = let (v, ss) = declVarName d in (v, (dc, ss))
+        decls d = let (v, srcName, ss) = declVarName d in (v, (dc, srcName, ss))
 
     -- Extract variable name and source span from declaration
-    declVarName :: F.Declarator (FA.Analysis a) -> (F.Name, P.SrcSpan)
-    declVarName (F.Declarator _ _ e _ _ _)  = (FA.varName e, P.getSpan e)
+    declVarName :: F.Declarator (FA.Analysis a) -> (F.Name, F.Name, P.SrcSpan)
+    declVarName (F.Declarator _ _ e _ _ _)  = (FA.varName e, FA.srcName e, P.getSpan e)
 
     -- Extract context identifier, a function return value (+ source
     -- span) if present, and a list of contained blocks
-    nameAndBlocks :: F.ProgramUnit (FA.Analysis a) -> (DeclContext, Maybe (F.Name, P.SrcSpan), [F.Block (FA.Analysis a)])
+    nameAndBlocks :: F.ProgramUnit (FA.Analysis a) -> (DeclContext, Maybe (F.Name, F.Name, P.SrcSpan), [F.Block (FA.Analysis a)])
     nameAndBlocks pu = case pu of
       F.PUMain       _ _ _ b _            -> (DCMain, Nothing, b)
       F.PUModule     _ _ _ b _            -> (DCModule $ FA.puName pu, Nothing, b)
       F.PUSubroutine _ _ _ _ _ b _        -> (DCSubroutine (FA.puName pu, FA.puSrcName pu), Nothing, b)
       F.PUFunction   _ _ _ _ _ _ mret b _
         | Nothing   <- mret
-        , F.Named n <- FA.puName pu       -> (DCFunction (FA.puName pu, FA.puSrcName pu), Just (n, P.getSpan pu), b)
-        | Just ret <- mret                -> (DCFunction (FA.puName pu, FA.puSrcName pu), Just (FA.varName ret, P.getSpan ret), b)
+        , F.Named n <- FA.puName pu       -> (DCFunction (FA.puName pu, FA.puSrcName pu), Just (n, n, P.getSpan pu), b)
+        | Just ret <- mret                -> (DCFunction (FA.puName pu, FA.puSrcName pu), Just (FA.varName ret, FA.srcName ret, P.getSpan ret), b)
         | otherwise                       -> error $ "nameAndBlocks: un-named function with no return value! " ++ show (FA.puName pu) ++ " at source-span " ++ show (P.getSpan pu)
       F.PUBlockData  _ _ _ b              -> (DCBlockData, Nothing, b)
       F.PUComment    {}                   -> (DCBlockData, Nothing, []) -- no decls inside of comments, so ignore it

test/Language/Fortran/Analysis/ModFileSpec.hs

@@ -42,6 +42,6 @@ testModuleMaps = do
     -- get unique name to filemap
     let mmap = genUniqNameToFilenameMap "" modFiles
     -- check that `constant` is declared in leaf.f90
-    let Just leaf = M.lookup "leaf_constant_1" mmap
+    let Just (leaf, _) = M.lookup "leaf_constant_1" mmap
     leaf `shouldBe` ("test-data" </> "module" </> "leaf.f90")