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