diff --git a/CHANGELOG.md b/CHANGELOG.md index 0f1b8d4d..de3d3a71 100644 --- a/CHANGELOG.md +++ b/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. diff --git a/app/Main.hs b/app/Main.hs index 69af8a6e..78913118 100644 --- a/app/Main.hs +++ b/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 diff --git a/fortran-src.cabal b/fortran-src.cabal index 60a118cb..1f1e2753 100644 --- a/fortran-src.cabal +++ b/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 @@ project, which uses fortran-src as its front end. category: Language diff --git a/package.yaml b/package.yaml index 5f5f04b6..9310f77f 100644 --- a/package.yaml +++ b/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 diff --git a/src/Language/Fortran/Repr/Eval/Value.hs b/src/Language/Fortran/Repr/Eval/Value.hs index 4620ed9d..a3407a75 100644 --- a/src/Language/Fortran/Repr/Eval/Value.hs +++ b/src/Language/Fortran/Repr/Eval/Value.hs @@ -272,6 +272,13 @@ evalBOp bop l r = do 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 diff --git a/src/Language/Fortran/Util/ModFile.hs b/src/Language/Fortran/Util/ModFile.hs index 67297422..d11c262f 100644 --- a/src/Language/Fortran/Util/ModFile.hs +++ b/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 diff --git a/test/Language/Fortran/Analysis/ModFileSpec.hs b/test/Language/Fortran/Analysis/ModFileSpec.hs index 7f621b69..9ea4a245 100644 --- a/test/Language/Fortran/Analysis/ModFileSpec.hs +++ b/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")