diff --git a/CHANGELOG.md b/CHANGELOG.md index 20e431db..b7687408 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,8 @@ +### 0.16.0 (2024) + * Added `--show-make-list` option + * Some robustness improvements around mod files [#286](https://github.com/camfort/fortran-src/pull/286) + * Helpers to work with the partial evaluation representation [#285](https://github.com/camfort/fortran-src/pull/285) + ### 0.15.1 (Jun 22, 2023) * remove unused vector-sized dependency diff --git a/app/Main.hs b/app/Main.hs index 7d6bad42..6e39d369 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -50,11 +50,16 @@ import qualified Language.Fortran.Parser.Free.Lexer as Free programName :: String programName = "fortran-src" +showVersion :: String +showVersion = "0.16.0" + main :: IO () main = do args <- getArgs (opts, parsedArgs) <- compileArgs args case (parsedArgs, action opts) of + (paths, ShowMyVersion) -> do + putStrLn $ "fortran-src version: " ++ showVersion (paths, ShowMakeGraph) -> do paths' <- expandDirs paths mg <- genModGraph (fortranVersion opts) (includeDirs opts) (cppOptions opts) paths' @@ -217,8 +222,12 @@ compileFileToMod mvers mods path moutfile = do mmap = combinedModuleMap mods tenv = combinedTypeEnv mods runCompile = genModFile . fst . analyseTypesWithEnv tenv . analyseRenamesWithModuleMap mmap . initAnalysis - parsedPF = fromRight' $ (Parser.byVerWithMods mods version) path contents - mod = runCompile parsedPF + parsedPF <- + case (Parser.byVerWithMods mods version) path contents of + Right pf -> return pf + Left err -> do + fail $ "Error parsing " ++ path ++ ": " ++ show err + let mod = runCompile parsedPF fspath = path -<.> modFileSuffix `fromMaybe` moutfile LB.writeFile fspath $ encodeModFile [mod] return mod @@ -301,6 +310,7 @@ printTypeErrors = putStrLn . showTypeErrors data Action = Lex | Parse | Typecheck | Rename | BBlocks | SuperGraph | Reprint | DumpModFile | Compile | ShowFlows Bool Bool Int | ShowBlocks (Maybe Int) | ShowMakeGraph | ShowMakeList | Make + | ShowMyVersion deriving Eq instance Read Action where @@ -329,7 +339,11 @@ initOptions = Options Nothing Parse Default Nothing [] Nothing False options :: [OptDescr (Options -> Options)] options = - [ Option ['v','F'] + [ Option [] + ["version"] + (NoArg $ \ opts -> opts { action = ShowMyVersion }) + "show fortran-src version" + , Option ['v','F'] ["fortranVersion"] (ReqArg (\v opts -> opts { fortranVersion = selectFortranVersion v }) "VERSION") "Fortran version to use, format: Fortran[66/77/77Legacy/77Extended/90]" diff --git a/fortran-src.cabal b/fortran-src.cabal index 647e8d44..e8127366 100644 --- a/fortran-src.cabal +++ b/fortran-src.cabal @@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.35.2. +-- This file has been generated from package.yaml by hpack version 0.36.0. -- -- see: https://github.com/sol/hpack name: fortran-src -version: 0.15.1 +version: 0.16.0 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 @@ -280,6 +280,7 @@ test-suite spec other-modules: Language.Fortran.Analysis.BBlocksSpec Language.Fortran.Analysis.DataFlowSpec + Language.Fortran.Analysis.ModFileSpec Language.Fortran.Analysis.ModGraphSpec Language.Fortran.Analysis.RenamingSpec Language.Fortran.Analysis.SemanticTypesSpec diff --git a/package.yaml b/package.yaml index 1cdac3f0..20d22e16 100644 --- a/package.yaml +++ b/package.yaml @@ -1,5 +1,5 @@ name: fortran-src -version: '0.15.1' +version: '0.16.0' 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/Analysis.hs b/src/Language/Fortran/Analysis.hs index c339dd7d..34f10a76 100644 --- a/src/Language/Fortran/Analysis.hs +++ b/src/Language/Fortran/Analysis.hs @@ -6,7 +6,8 @@ module Language.Fortran.Analysis ( initAnalysis, stripAnalysis, Analysis(..) , varName, srcName, lvVarName, lvSrcName, isNamedExpression , genVar, puName, puSrcName, blockRhsExprs, rhsExprs - , ModEnv, NameType(..), IDType(..), ConstructType(..) + , ModEnv, NameType(..), Locality(..), markAsImported, isImported + , IDType(..), ConstructType(..) , lhsExprs, isLExpr, allVars, analyseAllLhsVars, analyseAllLhsVars1, allLhsVars , blockVarUses, blockVarDefs , BB, BBNode, BBGr(..), bbgrMap, bbgrMapM, bbgrEmpty @@ -77,10 +78,31 @@ type TransFunc f g a = (f (Analysis a) -> f (Analysis a)) -> g (Analysis a) -> g type TransFuncM m f g a = (f (Analysis a) -> m (f (Analysis a))) -> g (Analysis a) -> m (g (Analysis a)) -- Describe a Fortran name as either a program unit or a variable. -data NameType = NTSubprogram | NTVariable | NTIntrinsic deriving (Show, Eq, Ord, Data, Typeable, Generic) +data Locality = + Local -- locally declared + | Imported -- declared in an imported module + deriving (Show, Eq, Ord, Data, Typeable, Generic) + +data NameType = NTSubprogram Locality | NTVariable Locality | NTIntrinsic + deriving (Show, Eq, Ord, Data, Typeable, Generic) + instance Binary NameType instance Out NameType +instance Binary Locality +instance Out Locality + +-- Mark any variables as being imported +markAsImported :: NameType -> NameType +markAsImported (NTVariable _) = NTVariable Imported +markAsImported (NTSubprogram _) = NTSubprogram Imported +markAsImported x = x + +isImported :: NameType -> Bool +isImported (NTVariable Imported) = True +isImported (NTSubprogram Imported) = True +isImported _ = False + -- Module environments are associations between source name and -- (unique name, name type) in a specific module. type ModEnv = M.Map String (String, NameType) diff --git a/src/Language/Fortran/Analysis/ModGraph.hs b/src/Language/Fortran/Analysis/ModGraph.hs index 930e1538..adb32ac8 100644 --- a/src/Language/Fortran/Analysis/ModGraph.hs +++ b/src/Language/Fortran/Analysis/ModGraph.hs @@ -16,7 +16,6 @@ import Data.Data import Data.Generics.Uniplate.Data import Data.Graph.Inductive hiding (version) import Data.Maybe -import Data.Either.Combinators ( fromRight' ) import qualified Data.Map as M -------------------------------------------------- diff --git a/src/Language/Fortran/Analysis/Renaming.hs b/src/Language/Fortran/Analysis/Renaming.hs index 69fecfc0..79468deb 100644 --- a/src/Language/Fortran/Analysis/Renaming.hs +++ b/src/Language/Fortran/Analysis/Renaming.hs @@ -120,7 +120,7 @@ programUnit (PUFunction a s ty rec name args res blocks m_contains) = do blocks3 <- mapM renameDeclDecls blocks2 -- handle declarations m_contains' <- renameSubPUs m_contains -- handle contained program units blocks4 <- mapM renameBlock blocks3 -- process all uses of variables - let env = M.singleton name (name', NTSubprogram) + let env = M.singleton name (name', NTSubprogram Local) let a' = a { moduleEnv = Just env } -- also annotate it on the program unit popScope let pu' = PUFunction a' s ty rec name args' res' blocks4 m_contains' @@ -133,7 +133,7 @@ programUnit (PUSubroutine a s rec name args blocks m_contains) = do blocks2 <- mapM renameDeclDecls blocks1 -- handle declarations m_contains' <- renameSubPUs m_contains -- handle contained program units blocks3 <- mapM renameBlock blocks2 -- process all uses of variables - let env = M.singleton name (name', NTSubprogram) + let env = M.singleton name (name', NTSubprogram Local) let a' = a { moduleEnv = Just env } -- also annotate it on the program unit popScope let pu' = PUSubroutine a' s rec name args' blocks3 m_contains' @@ -230,10 +230,16 @@ initialEnv blocks = do mMap <- gets moduleMap modEnv <- fmap M.unions . forM uses $ \ use -> case use of (BlStatement _ _ _ (StUse _ _ (ExpValue _ _ (ValVariable m)) _ _ Nothing)) -> - return $ fromMaybe empty (Named m `lookup` mMap) + let + env = fromMaybe empty (Named m `lookup` mMap) + -- mark as imported all the local things from this module + in return $ M.map (\ (v, info) -> (v, markAsImported info)) env + (BlStatement _ _ _ (StUse _ _ (ExpValue _ _ (ValVariable m)) _ _ (Just onlyAList))) | only <- aStrip onlyAList -> do let env = fromMaybe empty (Named m `lookup` mMap) + -- mark as imported all the local things from this module + env <- return $ M.map (\ (v, info) -> (v, markAsImported info)) env -- list of (local name, original name) from USE declaration: let localNamePairs = flip mapMaybe only $ \ r -> case r of UseID _ _ v@(ExpValue _ _ ValVariable{}) -> Just (varName v, varName v) @@ -253,7 +259,7 @@ initialEnv blocks = do -- Include any mappings defined by COMMON blocks: use variable -- source name prefixed by name of COMMON block. - let common = M.fromList [ (v, (v', NTVariable)) + let common = M.fromList [ (v, (v', NTVariable Local)) | CommonGroup _ _ me1 alist <- universeBi blocks :: [CommonGroup (Analysis a)] , let prefix = case me1 of Just e1 -> srcName e1; _ -> "" , e@(ExpValue _ _ ValVariable{}) <- universeBi (aStrip alist) :: [Expression (Analysis a)] @@ -325,9 +331,9 @@ getFromEnvsIfSubprogram :: String -> Renamer (Maybe String) getFromEnvsIfSubprogram v = do mEntry <- getFromEnvsWithType v case mEntry of - Just (v', NTSubprogram) -> return $ Just v' - Just (_, NTVariable) -> getFromEnv v - _ -> return Nothing + Just (v', NTSubprogram _) -> return $ Just v' + Just (_, NTVariable _) -> getFromEnv v + _ -> return Nothing -- Add a renaming mapping to the environment. addToEnv :: String -> String -> NameType -> Renamer () @@ -372,10 +378,10 @@ renameSubPUs (Just pus) = skimProgramUnits pus >> Just <$> mapM programUnit pus -- to the environment. skimProgramUnits :: Data a => [ProgramUnit (Analysis a)] -> Renamer () skimProgramUnits pus = forM_ pus $ \ pu -> case pu of - PUModule _ _ name _ _ -> addToEnv name name NTSubprogram - PUFunction _ _ _ _ name _ _ _ _ -> addUnique_ name NTSubprogram - PUSubroutine _ _ _ name _ _ _ -> addUnique_ name NTSubprogram - PUMain _ _ (Just name) _ _ -> addToEnv name name NTSubprogram + PUModule _ _ name _ _ -> addToEnv name name (NTSubprogram Local) + PUFunction _ _ _ _ name _ _ _ _ -> addUnique_ name (NTSubprogram Local) + PUSubroutine _ _ _ name _ _ _ -> addUnique_ name (NTSubprogram Local) + PUMain _ _ (Just name) _ _ -> addToEnv name name (NTSubprogram Local) _ -> return () ---------- @@ -394,7 +400,8 @@ 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@(ExpValue _ _ (ValVariable v)) = + flip setUniqueName (setSourceName v e) `fmap` maybeAddUnique v (NTVariable Local) -- Intrinsics get unique names for each use. renameExpDecl e@(ExpValue _ _ (ValIntrinsic v)) = flip setUniqueName (setSourceName v e) `fmap` addUnique v NTIntrinsic renameExpDecl e = return e @@ -407,7 +414,7 @@ renameInterfaces = trans interface interface :: Data a => RenamerFunc (Block (Analysis a)) interface (BlInterface a s (Just e@(ExpValue _ _ (ValVariable v))) abst pus bs) = do - e' <- flip setUniqueName (setSourceName v e) `fmap` maybeAddUnique v NTSubprogram + e' <- flip setUniqueName (setSourceName v e) `fmap` maybeAddUnique v (NTSubprogram Local) pure $ BlInterface a s (Just e') abst pus bs interface b = pure b diff --git a/src/Language/Fortran/Repr/Value/Machine.hs b/src/Language/Fortran/Repr/Value/Machine.hs index f885c4cb..0829ce44 100644 --- a/src/Language/Fortran/Repr/Value/Machine.hs +++ b/src/Language/Fortran/Repr/Value/Machine.hs @@ -2,6 +2,8 @@ module Language.Fortran.Repr.Value.Machine where +import Language.Fortran.Repr.Value.Scalar.Real +import Language.Fortran.Repr.Value.Scalar.Int.Machine import Language.Fortran.Repr.Value.Scalar.Machine import Language.Fortran.Repr.Type @@ -18,3 +20,15 @@ data FValue = MkFScalarValue FScalarValue fValueType :: FValue -> FType fValueType = \case MkFScalarValue a -> MkFScalarType $ fScalarValueType a + +fromConstInt :: FValue -> Maybe Integer +fromConstInt (MkFScalarValue (FSVInt a)) = Just $ withFInt a +fromConstInt _ = Nothing + +fromConstReal :: FValue -> Maybe Double +fromConstReal (MkFScalarValue (FSVReal (FReal4 a))) = Just $ floatToDouble a + where + floatToDouble :: Float -> Double + floatToDouble = realToFrac +fromConstReal (MkFScalarValue (FSVReal (FReal8 a))) = Just $ a +fromConstReal _ = Nothing \ No newline at end of file diff --git a/src/Language/Fortran/Repr/Value/Scalar/Machine.hs b/src/Language/Fortran/Repr/Value/Scalar/Machine.hs index 2a0a0e4a..33f58cb5 100644 --- a/src/Language/Fortran/Repr/Value/Scalar/Machine.hs +++ b/src/Language/Fortran/Repr/Value/Scalar/Machine.hs @@ -55,4 +55,4 @@ fScalarValueType = \case FSVReal a -> FSTReal $ fKind a FSVComplex a -> FSTComplex $ fKind a FSVLogical a -> FSTLogical $ fKind a - FSVString a -> FSTString $ fromIntegral $ Text.length a + FSVString a -> FSTString $ fromIntegral $ Text.length a \ No newline at end of file diff --git a/src/Language/Fortran/Util/ModFile.hs b/src/Language/Fortran/Util/ModFile.hs index 5d353948..139a73f2 100644 --- a/src/Language/Fortran/Util/ModFile.hs +++ b/src/Language/Fortran/Util/ModFile.hs @@ -55,7 +55,7 @@ module Language.Fortran.Util.ModFile , moduleFilename , StringMap, extractStringMap, combinedStringMap , DeclContext(..), DeclMap, extractDeclMap, combinedDeclMap - , extractModuleMap, combinedModuleMap, combinedTypeEnv + , extractModuleMap, combinedModuleMap, localisedModuleMap, combinedTypeEnv , ParamVarMap, extractParamVarMap, combinedParamVarMap , genUniqNameToFilenameMap , TimestampStatus(..), checkTimestamps @@ -217,6 +217,11 @@ decodeModFiles' = fmap (map snd) . decodeModFiles combinedModuleMap :: ModFiles -> FAR.ModuleMap combinedModuleMap = M.unions . map mfModuleMap +-- | Inside the module map, remove all imported declarations so that +-- we can properly localise declarations to the originator file. +localisedModuleMap :: FAR.ModuleMap -> FAR.ModuleMap +localisedModuleMap = M.map (M.filter (not . FA.isImported . snd)) + -- | Extract the combined module map from a set of ModFiles. Useful -- for parsing a Fortran file in a large context of other modules. combinedTypeEnv :: ModFiles -> FAT.TypeEnv @@ -244,13 +249,16 @@ moduleFilename = mfFilename -------------------------------------------------- -- | Create a map that links all unique variable/function names in the --- ModFiles to their corresponding filename. +-- ModFiles to their corresponding *originating* filename (i.e., where they are declared) genUniqNameToFilenameMap :: ModFiles -> M.Map F.Name String genUniqNameToFilenameMap = M.unions . map perMF where - perMF mf = M.fromList [ (n, fname) | modEnv <- M.elems (mfModuleMap mf) + perMF mf = M.fromList [ (n, fname) | modEnv <- M.elems localModuleMap , (n, _) <- M.elems modEnv ] 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 -------------------------------------------------- diff --git a/test/Language/Fortran/Analysis/ModFileSpec.hs b/test/Language/Fortran/Analysis/ModFileSpec.hs new file mode 100644 index 00000000..aef0ba52 --- /dev/null +++ b/test/Language/Fortran/Analysis/ModFileSpec.hs @@ -0,0 +1,46 @@ +module Language.Fortran.Analysis.ModFileSpec (spec) where + +import Test.Hspec +import TestUtil + +import Language.Fortran.Util.ModFile +import Language.Fortran.Util.Files (expandDirs, flexReadFile) +import Language.Fortran.Version +import System.FilePath (()) +import qualified Data.Map as M +import qualified Language.Fortran.Parser as Parser +import qualified Data.ByteString.Char8 as B +import Language.Fortran.AST +import Language.Fortran.Analysis +import Language.Fortran.Analysis.Renaming +import Language.Fortran.Analysis.BBlocks +import Language.Fortran.Analysis.DataFlow + +spec :: Spec +spec = + describe "Modfiles" $ + it "Test module maps for a small package" $ + testModuleMaps + +pParser :: String -> IO (ProgramFile (Analysis A0)) +pParser name = do + contents <- flexReadFile name + let pf = Parser.byVerWithMods [] Fortran90 name contents + case pf of + Right pf -> return $ rename . analyseBBlocks . analyseRenames . initAnalysis $ pf + Left err -> error $ "Error parsing " ++ name ++ ": " ++ show err + +-- A simple test that checks that we correctly localise the declaration +-- of the variable `constant` to the leaf module, whilst understanding +-- in the `mid1` and `mid2` modules that it is an imported declaration. +testModuleMaps = do + paths <- expandDirs ["test-data" "module"] + -- parse all files into mod files + pfs <- mapM (\p -> pParser p) paths + let modFiles = map genModFile pfs + -- 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 + leaf `shouldBe` ("test-data" "module" "leaf.f90") + diff --git a/test/Language/Fortran/Analysis/ModGraphSpec.hs b/test/Language/Fortran/Analysis/ModGraphSpec.hs index dd2528db..bb6169ff 100644 --- a/test/Language/Fortran/Analysis/ModGraphSpec.hs +++ b/test/Language/Fortran/Analysis/ModGraphSpec.hs @@ -21,6 +21,10 @@ testDependencyList = do paths' <- expandDirs ["test-data" "module"] mg <- genModGraph (Just Fortran90) ["."] Nothing paths' let list = modGraphToList mg - let files = ["leaf.f90", "mid1.f90", "mid2.f90", "top.f90"] - let filesWithPaths = map (("test-data" "module") ) files - list `shouldBe` filesWithPaths + -- we should have two possible orderings + let files1 = ["leaf.f90", "mid1.f90", "mid2.f90", "top.f90"] + let filesWithPaths1 = map (("test-data" "module") ) files1 + -- or in a different order + let files2 = ["leaf.f90", "mid2.f90", "mid1.f90", "top.f90"] + let filesWithPaths2 = map (("test-data" "module") ) files2 + shouldSatisfy list (\x -> x == filesWithPaths1 || x == filesWithPaths2)