packages feed

fortran-src 0.15.1 → 0.16.0

raw patch · 25 files changed

+407/−109 lines, 25 files

Files

CHANGELOG.md view
@@ -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
README.md view
@@ -161,3 +161,7 @@ contact with one of the team on the [CamFort team page](https://camfort.github.io/team.html) -- or create an issue describing your problem and we'll have a look.++### For maintainers+See `doc/maintainers.md` in+[camfort/camfort](https://github.com/camfort/camfort).
app/Main.hs view
@@ -50,15 +50,24 @@ 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'       putStrLn $ modGraphToDOT mg+    (paths, ShowMakeList) -> do+      paths' <- expandDirs paths+      mg <- genModGraph (fortranVersion opts) (includeDirs opts) (cppOptions opts) paths'+      mapM_ putStrLn (modGraphToList mg)     -- make: construct a build-dep graph and follow it     (paths, Make) -> do       let mvers = fortranVersion opts@@ -205,39 +214,7 @@         _ -> fail $ usageInfo programName options     _ -> fail $ usageInfo programName options --- | Expand all paths that are directories into a list of Fortran--- files from a recursive directory listing.-expandDirs :: [FilePath] -> IO [FilePath]-expandDirs = fmap concat . mapM each-  where-    each path = do-      isDir <- doesDirectoryExist path-      if isDir-        then listFortranFiles path-        else pure [path] --- | Get a list of Fortran files under the given directory.-listFortranFiles :: FilePath -> IO [FilePath]-listFortranFiles dir = filter isFortran <$> listDirectoryRecursively dir-  where-    -- | True if the file has a valid fortran extension.-    isFortran :: FilePath -> Bool-    isFortran x = map toLower (takeExtension x) `elem` exts-      where exts = [".f", ".f90", ".f77", ".f03"]--listDirectoryRecursively :: FilePath -> IO [FilePath]-listDirectoryRecursively dir = listDirectoryRec dir ""-  where-    listDirectoryRec :: FilePath -> FilePath -> IO [FilePath]-    listDirectoryRec d f = do-      let fullPath = d </> f-      isDir <- doesDirectoryExist fullPath-      if isDir-      then do-        conts <- listDirectory fullPath-        concat <$> mapM (listDirectoryRec fullPath) conts-      else pure [fullPath]- compileFileToMod :: Maybe FortranVersion -> ModFiles -> FilePath -> Maybe FilePath -> IO ModFile compileFileToMod mvers mods path moutfile = do   contents <- flexReadFile path@@ -245,8 +222,12 @@       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@@ -328,7 +309,8 @@  data Action   = Lex | Parse | Typecheck | Rename | BBlocks | SuperGraph | Reprint | DumpModFile | Compile-  | ShowFlows Bool Bool Int | ShowBlocks (Maybe Int) | ShowMakeGraph | Make+  | ShowFlows Bool Bool Int | ShowBlocks (Maybe Int) | ShowMakeGraph | ShowMakeList | Make+  | ShowMyVersion   deriving Eq  instance Read Action where@@ -357,7 +339,11 @@  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]"@@ -423,6 +409,10 @@       ["show-make-graph"]       (NoArg $ \ opts -> opts { action = ShowMakeGraph })       "dump a graph showing the build structure of modules"+  , Option []+      ["show-make-list"]+      (NoArg $ \ opts -> opts { action = ShowMakeList })+      "dump a list of files in build dependency order (topological sort from the dependency graph)"   , Option []       ["show-block-numbers"]       (OptArg (\a opts -> opts { action = ShowBlocks (a >>= readMaybe) }
fortran-src.cabal view
@@ -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 @<https://hackage.haskell.org/package/camfort CamFort>@ project, which uses fortran-src as its front end. category:       Language@@ -27,6 +27,10 @@     CHANGELOG.md     test-data/f77-include/foo.f     test-data/f77-include/no-newline/foo.f+    test-data/module/leaf.f90+    test-data/module/mid1.f90+    test-data/module/mid2.f90+    test-data/module/top.f90     test-data/rewriter/replacementsmap-columnlimit/001_foo.f     test-data/rewriter/replacementsmap-columnlimit/001_foo.f.expected     test-data/rewriter/replacementsmap-columnlimit/002_other.f@@ -276,6 +280,8 @@   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       Language.Fortran.Analysis.TypesSpec
src/Language/Fortran/Analysis.hs view
@@ -6,7 +6,8 @@   ( 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,9 +78,30 @@ 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.
src/Language/Fortran/Analysis/ModGraph.hs view
@@ -1,6 +1,6 @@ -- | Generate a module use-graph. module Language.Fortran.Analysis.ModGraph-  (genModGraph, ModGraph(..), ModOrigin(..), modGraphToDOT, takeNextMods, delModNodes)+  (genModGraph, ModGraph(..), ModOrigin(..), modGraphToList, modGraphToDOT, takeNextMods, delModNodes) where  import Language.Fortran.AST hiding (setName)@@ -16,7 +16,6 @@ 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  --------------------------------------------------@@ -85,16 +84,28 @@         let version = fromMaybe (deduceFortranVersion path) mversion             mods = map snd fileMods             parserF0 = Parser.byVerWithMods mods version-            parserF fn bs = fromRight' $ parserF0 fn bs+            parserF fn bs =+              case parserF0 fn bs of+                Right x -> return x+                Left  err -> do+                  error $ show err         forM_ fileMods $ \ (fileName, mod) -> do           forM_ [ name | Named name <- M.keys (combinedModuleMap [mod]) ] $ \ name -> do             _ <- maybeAddModName name . Just $ MOFSMod fileName             pure ()-        let pf = parserF path contents+        pf <- parserF path contents         mapM_ (perModule path) (childrenBi pf :: [ProgramUnit ()])         pure ()   execStateT (mapM_ iter paths) modGraph0 +-- Remove duplicates from a list preserving the left most occurrence.+removeDuplicates :: Eq a => [a] -> [a]+removeDuplicates [] = []+removeDuplicates (x:xs) =+  if x `elem` xs+    then x : removeDuplicates (filter (/= x) xs)+    else x : removeDuplicates xs+ modGraphToDOT :: ModGraph -> String modGraphToDOT ModGraph { mgGraph = gr } = unlines dot   where@@ -107,6 +118,18 @@                         ["}\n"])                     (labNodes gr) ++           [ "}\n" ]++-- Provides a topological sort of the graph, giving a list of filenames+modGraphToList :: ModGraph -> [String]+modGraphToList m = removeDuplicates $ modGraphToList' m+  where+    modGraphToList' mg+      | nxt <- takeNextMods mg+      , not (null nxt) =+          let mg' = delModNodes (map fst nxt) mg+          in [ fn | (_, Just (MOFile fn)) <- nxt ] ++ modGraphToList' mg'+    modGraphToList' _ = []+  takeNextMods :: ModGraph -> [(Node, Maybe ModOrigin)] takeNextMods ModGraph { mgModNodeMap = mnmap, mgGraph = gr } = noDepFiles
src/Language/Fortran/Analysis/Renaming.hs view
@@ -120,7 +120,7 @@   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 @@   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 @@   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 @@    -- 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 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 @@ -- 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 @@ -- 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 @@  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
src/Language/Fortran/Parser.hs view
@@ -17,6 +17,7 @@   , f66, f77, f77e, f77l, f90, f95, f2003    -- * Main parsers without post-parse transformation+  , byVerNoTransform   , f66NoTransform, f77NoTransform, f77eNoTransform, f77lNoTransform     , f90NoTransform, f95NoTransform, f2003NoTransform @@ -30,6 +31,10 @@   , f66StmtNoTransform, f77StmtNoTransform, f77eStmtNoTransform     , f77lStmtNoTransform, f90StmtNoTransform, f95StmtNoTransform     , f2003StmtNoTransform+  , byVerInclude+  , f66IncludesNoTransform, f77IncludesNoTransform, f77eIncludesNoTransform+  , f77lIncludesNoTransform, f90IncludesNoTransform, f95IncludesNoTransform+  , f2003IncludesNoTransform    -- * Various combinators   , transformAs, defaultTransformation@@ -43,7 +48,10 @@    -- * F77 with inlined includes   -- $f77includes-  , f77lInlineIncludes+  , byVerInlineIncludes+  , f66InlineIncludes, f77InlineIncludes, f77eInlineIncludes+  , f77lInlineIncludes, f90InlineIncludes , f95InlineIncludes+  , f2003InlineIncludes   ) where  import Language.Fortran.AST@@ -175,6 +183,18 @@   v                 -> error $  "Language.Fortran.Parser.byVerStmt: "                              <> "no parser available for requested version: "                              <> show v+byVerNoTransform :: FortranVersion -> Parser (ProgramFile A0)+byVerNoTransform = \case+  Fortran66         -> f66NoTransform+  Fortran77         -> f77NoTransform+  Fortran77Legacy   -> f77lNoTransform+  Fortran77Extended -> f77eNoTransform+  Fortran90         -> f90NoTransform+  Fortran95         -> f90NoTransform+  Fortran2003       -> f2003NoTransform+  v                 -> error $  "Language.Fortran.Parser.byVerNoTransform: "+                           <> "no parser available for requested version: "+                           <> show v  f90Expr :: Parser (Expression A0) f90Expr = makeParser initParseStateFreeExpr F90.expressionParser Fortran90@@ -291,35 +311,47 @@ Can be cleaned up and generalized to use for other parsers. -} -f77lInlineIncludes-    :: [FilePath] -> ModFiles -> String -> B.ByteString+f66InlineIncludes, f77InlineIncludes, f77eInlineIncludes, f77lInlineIncludes,+  f90InlineIncludes, f95InlineIncludes, f2003InlineIncludes+  :: [FilePath] -> ModFiles -> String -> B.ByteString -> IO (ProgramFile A0)+f66InlineIncludes = byVerInlineIncludes Fortran66+f77lInlineIncludes = byVerInlineIncludes Fortran77Legacy+f77eInlineIncludes = byVerInlineIncludes Fortran77Extended+f77InlineIncludes = byVerInlineIncludes Fortran77+f90InlineIncludes = byVerInlineIncludes Fortran90+f95InlineIncludes = byVerInlineIncludes Fortran95+f2003InlineIncludes = byVerInlineIncludes Fortran2003++byVerInlineIncludes+    :: FortranVersion -> [FilePath] -> ModFiles -> String -> B.ByteString     -> IO (ProgramFile A0)-f77lInlineIncludes incs mods fn bs = do-    case f77lNoTransform fn bs of-      Left e -> liftIO $ throwIO e-      Right pf -> do-        let pf' = pfSetFilename fn pf-        pf'' <- evalStateT (descendBiM (f77lInlineIncludes' incs []) pf') Map.empty-        let pf''' = runTransform (combinedTypeEnv mods)-                                 (combinedModuleMap mods)-                                 (defaultTransformation Fortran77Legacy)-                                 pf''-        return pf'''+byVerInlineIncludes version incs mods fn bs = do+  case byVerNoTransform version fn bs of+    Left e -> liftIO $ throwIO e+    Right pf -> do+      let pf' = pfSetFilename fn pf+      pf'' <- evalStateT (descendBiM (parserInlineIncludes version incs []) pf') Map.empty+      let pf''' = runTransform (combinedTypeEnv mods)+                                (combinedModuleMap mods)+                                (defaultTransformation version)+                                pf''+      return pf''' -f77lInlineIncludes'-    :: [FilePath] -> [FilePath] -> Statement A0+-- Internal function to go through the includes and inline them+parserInlineIncludes+    :: FortranVersion -> [FilePath] -> [FilePath] -> Statement A0     -> StateT (Map String [Block A0]) IO (Statement A0)-f77lInlineIncludes' dirs = go+parserInlineIncludes version dirs = go   where     go seen st = case st of       StInclude a s e@(ExpValue _ _ (ValString path)) Nothing -> do-        if notElem path seen then do+        if path `notElem` seen then do           incMap <- get           case Map.lookup path incMap of             Just blocks' -> pure $ StInclude a s e (Just blocks')             Nothing -> do               (fullPath, incBs) <- liftIO $ readInDirs dirs path-              case f77lIncludesNoTransform fullPath incBs of+              case byVerInclude version fullPath incBs of                 Right blocks -> do                   blocks' <- descendBiM (go (path:seen)) blocks                   modify (Map.insert path blocks')@@ -328,8 +360,30 @@         else pure st       _ -> pure st -f77lIncludesNoTransform :: Parser [Block A0]+f66IncludesNoTransform, f77IncludesNoTransform, f77eIncludesNoTransform,+  f77lIncludesNoTransform, f90IncludesNoTransform, f95IncludesNoTransform,+  f2003IncludesNoTransform+  :: Parser [Block A0]+f66IncludesNoTransform = makeParserFixed F66.includesParser Fortran66+f77IncludesNoTransform = makeParserFixed F77.includesParser Fortran77+f77eIncludesNoTransform = makeParserFixed F77.includesParser Fortran77Extended f77lIncludesNoTransform = makeParserFixed F77.includesParser Fortran77Legacy+f90IncludesNoTransform = makeParserFree F90.includesParser Fortran90+f95IncludesNoTransform = makeParserFree F95.includesParser Fortran95+f2003IncludesNoTransform = makeParserFree F2003.includesParser Fortran2003++byVerInclude :: FortranVersion -> Parser [Block A0]+byVerInclude = \case+  Fortran66         -> f66IncludesNoTransform+  Fortran77         -> f77IncludesNoTransform+  Fortran77Extended -> f77eIncludesNoTransform+  Fortran77Legacy   -> f77lIncludesNoTransform+  Fortran90         -> f90IncludesNoTransform+  Fortran95         -> f95IncludesNoTransform+  Fortran2003       -> f2003IncludesNoTransform+  v                 -> error $  "Language.Fortran.Parser.byVerInclude: "+                           <> "no parser available for requested version: "+                           <> show v  readInDirs :: [String] -> String -> IO (String, B.ByteString) readInDirs [] f = fail $ "cannot find file: " ++ f
src/Language/Fortran/Parser/Fixed/Fortran66.y view
@@ -6,6 +6,7 @@   , blockParser   , statementParser   , expressionParser+  , includesParser   ) where  import Language.Fortran.Version@@ -25,6 +26,7 @@ %name blockParser      BLOCK %name statementParser  STATEMENT %name expressionParser EXPRESSION+%name includesParser   INCLUDES %monad { LexAction } %lexer { lexer } { TEOF _ } %tokentype { Token }@@ -138,6 +140,9 @@ | {- Nothing -} { Nothing }  NAME :: { Name } : id { let (TId _ name) = $1 in name }++INCLUDES :: { [ Block A0 ] }+: BLOCKS NEWLINE { reverse $1 }  BLOCKS :: { [ Block A0 ] } : BLOCKS BLOCK { $2 : $1 }
src/Language/Fortran/Parser/Fixed/Fortran77.y view
@@ -467,8 +467,12 @@ | dimension INITIALIZED_ARRAY_DECLARATORS { StDimension () (getTransSpan $1 $2) (aReverse $2) } | common COMMON_GROUPS { StCommon () (getTransSpan $1 $2) (aReverse $2) } | equivalence EQUIVALENCE_GROUPS { StEquivalence () (getTransSpan $1 $2) (aReverse $2) }-| pointer POINTER_LIST { StPointer () (getTransSpan $1 $2) (fromReverseList $2) }-| data DATA_GROUPS { StData () (getTransSpan $1 $2) (fromReverseList $2) }+| pointer POINTER_LIST+  { let pl = fromReverseList $2+    in StPointer () (getTransSpan $1 pl) pl }+| data DATA_GROUPS+  { let dgs = fromReverseList $2+    in StData () (getTransSpan $1 dgs) dgs } | automatic INITIALIZED_DECLARATORS { StAutomatic () (getTransSpan $1 $2) (aReverse $2) } | static INITIALIZED_DECLARATORS { StStatic () (getTransSpan $1 $2) (aReverse $2) } -- Following is a fake node to make arbitrary FORMAT statements parsable.
src/Language/Fortran/Parser/Free/Fortran2003.y view
@@ -7,6 +7,7 @@   , blockParser   , statementParser   , expressionParser+  , includesParser   ) where  import Language.Fortran.Version@@ -28,6 +29,7 @@ %name blockParser      BLOCK %name statementParser  STATEMENT %name expressionParser EXPRESSION+%name includesParser   INCLUDES %monad { LexAction } %lexer { lexer } { TEOF _ } %tokentype { Token }@@ -348,6 +350,9 @@ IMPORT_NAME_LIST :: { [Expression A0] } : IMPORT_NAME_LIST ',' VARIABLE { $3 : $1 } | VARIABLE { [ $1 ] }++INCLUDES :: { [ Block A0 ] }+: BLOCKS NEWLINE { reverse $1 }  BLOCKS :: { [ Block A0 ] } : BLOCKS BLOCK { $2 : $1 } | {- EMPTY -} { [ ] }
src/Language/Fortran/Parser/Free/Fortran90.y view
@@ -7,6 +7,7 @@   , blockParser   , statementParser   , expressionParser+  , includesParser   ) where  import Language.Fortran.Version@@ -27,6 +28,7 @@ %name functionParser   SUBPROGRAM_UNIT %name blockParser      BLOCK %name statementParser  STATEMENT+%name includesParser   INCLUDES %name expressionParser EXPRESSION %monad { LexAction } %lexer { lexer } { TEOF _ }@@ -295,6 +297,9 @@ : end { $1 } | endInterface { $1 } | endInterface id { $2 }  NAME :: { Name } : id { let (TId _ name) = $1 in name }++INCLUDES :: { [ Block A0 ] }+: BLOCKS NEWLINE { reverse $1 }  BLOCKS :: { [ Block A0 ] } : BLOCKS BLOCK { $2 : $1 } | {- EMPTY -} { [ ] }
src/Language/Fortran/Parser/Free/Fortran95.y view
@@ -7,6 +7,7 @@   , blockParser   , statementParser   , expressionParser+  , includesParser   ) where  import Language.Fortran.Version@@ -28,6 +29,7 @@ %name blockParser      BLOCK %name statementParser  STATEMENT %name expressionParser EXPRESSION+%name includesParser   INCLUDES %monad { LexAction } %lexer { lexer } { TEOF _ } %tokentype { Token }@@ -304,6 +306,9 @@ : end { $1 } | endInterface { $1 } | endInterface id { $2 }  NAME :: { Name } : id { let (TId _ name) = $1 in name }++INCLUDES :: { [ Block A0 ] }+: BLOCKS NEWLINE { reverse $1 }  BLOCKS :: { [ Block A0 ] } : BLOCKS BLOCK { $2 : $1 } | {- EMPTY -} { [ ] }
src/Language/Fortran/Parser/Free/Lexer.x view
@@ -51,9 +51,9 @@ @label = $digit{1,5} @name = $letter $alphanumeric* -@binary = b\'$bit+\'-@octal  = o\'$octalDigit+\'-@hex    = z\'$hexDigit+\'+@binary = b\'$bit+\' | \'$bit+\'b+@octal  = o\'$octalDigit+\' | \'$octalDigit+\'o+@hex    = [xz]\'$hexDigit+\' | \'$hexDigit+\'[xz]  @digitString = $digit+ @kindParam = (@digitString|@name)
src/Language/Fortran/PrettyPrint.hs view
@@ -5,6 +5,7 @@  import Data.Maybe (isJust, isNothing, listToMaybe) import Data.List (foldl')+import qualified Data.List as List  import Prelude hiding (EQ,LT,GT,pred,exp,(<>)) @@ -16,11 +17,6 @@  import Text.PrettyPrint -tooOld :: FortranVersion -> String -> FortranVersion -> a-tooOld currentVersion featureName featureVersion = prettyError $-    featureName ++ " was introduced in " ++ show featureVersion ++-    ". You called pretty print with " ++ show currentVersion ++ "."- -- | Continue only if the given version is equal to or older than a "maximum" --   version, or emit a runtime error. olderThan :: FortranVersion -> String -> FortranVersion -> a -> a@@ -33,6 +29,24 @@             ++ show ver ++ "."     else cont +-- | Continue if the given version is one of the given "permitted" versions,+--   else emit a runtime error.+continueOnlyFor :: [FortranVersion] -> String -> FortranVersion -> a -> a+continueOnlyFor permittedVers featureName ver cont =+    if ver `List.elem` permittedVers then cont+    else prettyError $+            featureName+            ++ " is only available for: " ++ show permittedVers+            ++ ". You called pretty print with " ++ show ver ++ "."++-- | Emit a runtime error due to bad pretty printing.+--+-- Intended to be used in the @otherwise@ guard.+tooOld :: FortranVersion -> String -> FortranVersion -> a+tooOld currentVersion featureName featureVersion = prettyError $+    featureName ++ " was introduced in " ++ show featureVersion +++    ". You called pretty print with " ++ show currentVersion ++ "."+ (<?>) :: Doc -> Doc -> Doc doc1 <?> doc2 = if doc1 == empty || doc2 == empty then empty else doc1 <> doc2 infixl 7 <?>@@ -391,9 +405,9 @@     pprint' _ TypeReal    = "real"     pprint' _ TypeDoublePrecision = "double precision"     pprint' _ TypeComplex = "complex"-    pprint' v TypeDoubleComplex-      | v == Fortran77Extended = "double complex"-      | otherwise = tooOld v "Double complex" Fortran77Extended+    pprint' v TypeDoubleComplex =+        continueOnlyFor [Fortran77Extended] "Double complex" v $+            "double complex"     pprint' _ TypeLogical = "logical"     pprint' v TypeCharacter       | v >= Fortran77 = "character"@@ -530,19 +544,21 @@       | v >= Fortran90 = "data" <+> pprint' v aDataGroups       | otherwise = "data" <+> hsep (map (pprint' v) dataGroups) -    pprint' v (StAutomatic _ _ decls)-      | v == Fortran77Extended = "automatic" <+> pprint' v decls-      | otherwise = tooOld v "Automatic statement" Fortran90+    pprint' v (StAutomatic _ _ decls) =+        continueOnlyFor [Fortran77Extended, Fortran77Legacy] "Automatic statement" v $+            "automatic" <+> pprint' v decls -    pprint' v (StStatic _ _ decls)-      | v == Fortran77Extended = "static" <+> pprint' v decls-      | otherwise = tooOld v "Static statement" Fortran90+    pprint' v (StStatic _ _ decls) =+        continueOnlyFor [Fortran77Extended, Fortran77Legacy] "Static statement" v $+            "static" <+> pprint' v decls      pprint' v (StNamelist _ _ namelist)       | v >= Fortran90 = "namelist" <+> pprint' v namelist       | otherwise = tooOld v "Namelist statement" Fortran90 -    pprint' v (StParameter _ _ aDecls) = "parameter" <+> parens (pprint' v aDecls)+    -- We reuse the declaration node, but parameter statements use `=` even in+    -- the older standards+    pprint' _ (StParameter _ _ aDecls) = "parameter" <+> parens (pprint' Fortran90 aDecls)      pprint' v (StExternal _ _ vars) = "external" <+> pprint' v vars     pprint' v (StIntrinsic _ _ vars) = "intrinsic" <+> pprint' v vars@@ -650,7 +666,7 @@     pprint' v (StGotoComputed _ _ labels target) =       "goto" <+> parens (pprint' v labels) <+> pprint' v target -    pprint' v (StCall _ _ name args) = pprint' v name <+> parens (pprint' v args)+    pprint' v (StCall _ _ name args) = "call" <+> pprint' v name <+> parens (pprint' v args)      pprint' _ (StContinue _ _) = "continue" @@ -669,10 +685,9 @@       "write" <+> parens (pprint' v cilist) <+> pprint' v mIolist     pprint' v (StPrint _ _ formatId mIolist) =       "print" <+> pprint' v formatId <> comma <?+> pprint' v mIolist-    pprint' v (StTypePrint _ _ formatId mIolist)-      | v == Fortran77Extended-      = "type" <+> pprint' v formatId <> comma <?+> pprint' v mIolist-      | otherwise = tooOld v "Type (print) statement" Fortran77Extended+    pprint' v (StTypePrint _ _ formatId mIolist) =+        continueOnlyFor [Fortran77Extended] "Type (print) statement" v $+            "type" <+> pprint' v formatId <> comma <?+> pprint' v mIolist      pprint' v (StOpen _ _ cilist) = "open" <+> parens (pprint' v cilist)     pprint' v (StClose _ _ cilist) = "close" <+> parens (pprint' v cilist)
src/Language/Fortran/Repr/Value/Machine.hs view
@@ -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,14 @@ 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
src/Language/Fortran/Repr/Value/Scalar/Machine.hs view
src/Language/Fortran/Util/Files.hs view
@@ -3,6 +3,9 @@   , runCPP   , getDirContents   , rGetDirContents+  , expandDirs+  , listFortranFiles+  , listDirectoryRecursively   ) where  import qualified Data.Text.Encoding         as T@@ -10,11 +13,11 @@ import qualified Data.ByteString.Char8      as B import           System.Directory (listDirectory, canonicalizePath,                                    doesDirectoryExist, getDirectoryContents)-import           System.FilePath  ((</>))+import           System.FilePath  ((</>), takeExtension) import           System.IO.Temp   (withSystemTempDirectory) import           System.Process   (callProcess) import           Data.List        ((\\), foldl')-import           Data.Char        (isNumber)+import           Data.Char        (isNumber, toLower) -- | Obtain a UTF-8 safe 'B.ByteString' representation of a file's contents. -- -- Invalid UTF-8 is replaced with the space character.@@ -36,11 +39,11 @@       fmap concat . mapM f $ ds \\ [".", ".."] -- remove '.' and '..' entries         where           f x = do-            path <- canonicalizePath $ d ++ "/" ++ x+            path <- canonicalizePath $ d </> x             g <- doesDirectoryExist path             if g && notElem path seen then do               x' <- go (path : seen) path-              return $ map (\ y -> x ++ "/" ++ y) x'+              return $ map (\ y -> x </> y) x'             else return [x]  -- | Run the C Pre Processor over the file before reading into a bytestring@@ -68,3 +71,36 @@     let ls = B.lines contents     let ls' = reverse . fst $ foldl' processCPPLine ([], 1) ls     return $ B.unlines ls'++-- | Expand all paths that are directories into a list of Fortran+-- files from a recursive directory listing.+expandDirs :: [FilePath] -> IO [FilePath]+expandDirs = fmap concat . mapM each+  where+    each path = do+      isDir <- doesDirectoryExist path+      if isDir+        then listFortranFiles path+        else pure [path]++-- | Get a list of Fortran files under the given directory.+listFortranFiles :: FilePath -> IO [FilePath]+listFortranFiles dir = filter isFortran <$> listDirectoryRecursively dir+  where+    -- | True if the file has a valid fortran extension.+    isFortran :: FilePath -> Bool+    isFortran x = map toLower (takeExtension x) `elem` exts+      where exts = [".f", ".f90", ".f77", ".f03"]++listDirectoryRecursively :: FilePath -> IO [FilePath]+listDirectoryRecursively dir = listDirectoryRec dir ""+  where+    listDirectoryRec :: FilePath -> FilePath -> IO [FilePath]+    listDirectoryRec d f = do+      let fullPath = d </> f+      isDir <- doesDirectoryExist fullPath+      if isDir+      then do+        conts <- listDirectory fullPath+        concat <$> mapM (listDirectoryRec fullPath) conts+      else pure [fullPath]
src/Language/Fortran/Util/ModFile.hs view
@@ -55,7 +55,7 @@   , moduleFilename   , StringMap, extractStringMap, combinedStringMap   , DeclContext(..), DeclMap, extractDeclMap, combinedDeclMap-  , extractModuleMap, combinedModuleMap, combinedTypeEnv+  , extractModuleMap, combinedModuleMap, localisedModuleMap, combinedTypeEnv   , ParamVarMap, extractParamVarMap, combinedParamVarMap   , genUniqNameToFilenameMap   , TimestampStatus(..), checkTimestamps@@ -217,6 +217,9 @@ combinedModuleMap :: ModFiles -> FAR.ModuleMap combinedModuleMap = M.unions . map mfModuleMap +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 +247,16 @@ --------------------------------------------------  -- | 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  --------------------------------------------------
+ test-data/module/leaf.f90 view
@@ -0,0 +1,4 @@+module leaf+  implicit none+  real :: constant = 0.1+end module
+ test-data/module/mid1.f90 view
@@ -0,0 +1,4 @@+module mid1+  implicit none+  use leaf+end module
+ test-data/module/mid2.f90 view
@@ -0,0 +1,4 @@+module mid2+  implicit none+  use leaf+end module
+ test-data/module/top.f90 view
@@ -0,0 +1,5 @@+module top+  implicit none+  use mid1+  use mid2+end module
+ test/Language/Fortran/Analysis/ModFileSpec.hs view
@@ -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")+
+ test/Language/Fortran/Analysis/ModGraphSpec.hs view
@@ -0,0 +1,30 @@+module Language.Fortran.Analysis.ModGraphSpec (spec) where++import Test.Hspec+import TestUtil++import Language.Fortran.Analysis.ModGraph+import Language.Fortran.Util.Files (expandDirs)+import Language.Fortran.Version+import System.FilePath ((</>))++spec :: Spec+spec =+  describe "Modgraph" $+    it "Dependency graph and topological sort on small package" $+      testDependencyList++-- A simple test on a simple module structure to check that+-- we are understanding this correctly (via the dependency graph+-- and then its topological sort).+testDependencyList = do+    paths' <- expandDirs ["test-data" </> "module"]+    mg <- genModGraph (Just Fortran90) ["."] Nothing paths'+    let list = modGraphToList mg+    -- 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)