fortran-src 0.3.0 → 0.4.0

raw patch · 18 files changed

+521/−154 lines, 18 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +11/−0
• LICENSE +1/−1
• fortran-src.cabal +5/−2
• src/Language/Fortran/AST.hs +46/−1
• src/Language/Fortran/Analysis.hs +11/−12
• src/Language/Fortran/Analysis/DataFlow.hs +67/−31
• src/Language/Fortran/Analysis/ModGraph.hs +158/−0
• src/Language/Fortran/Parser/Fortran2003.y +1/−0
• src/Language/Fortran/Parser/Fortran66.y +1/−0
• src/Language/Fortran/Parser/Fortran77.y +4/−4
• src/Language/Fortran/Parser/Fortran90.y +1/−0
• src/Language/Fortran/Parser/Fortran95.y +1/−0
• src/Language/Fortran/PrettyPrint.hs +1/−1
• src/Language/Fortran/Util/ModFile.hs +49/−21
• src/Language/Fortran/Util/Position.hs +4/−1
• src/Main.hs +140/−34
• test/Language/Fortran/Parser/Fortran77/ParserSpec.hs +19/−0
• test/Language/Fortran/Transformation/GroupingSpec.hs +1/−46

@@ -1,3 +1,14 @@+### 0.4.0 (August 29, 2019)++* ModGraph: parse Fortran files and assemble them into a dependency graph in order to construct automated 'build' plans for analysis and summarisation (e.g. with --make-mods option).+* Change name of compilation to summarisation. Remains as '-c' option.+* Allow multiple files and directories to be specified on command line.+* Search includedir recursively for fsmod files.+* Change format of fsmod-files so that they can contain [ModFile] since multiple Fortran files can be summarised into a single mod file.+* Introduce strictness and NFData dependencies across the board.+* Use Pipes to process large amounts of files in order to control memory usage and more efficiently process things.+* Parsing rules for StructStructures (thanks Raoul Charman)+ ### 0.3.0 (June 13, 2019)  * Add partial Fortran2003 support.

@@ -1,6 +1,6 @@ Copyright (c) 2015-2019: Mistral Contrastin, Matthew Danish, Dominic Orchard and Andrew Rice -Additional thanks for contributions from: Anthony Burzillo, Azeem Bande-Ali, Ben Moon, Bradley Hardy, Eric Seidel, Harry Clarke, Jason Xu, Lukasz Kolodziejczyk, TravelTissues and Vaibhav Yenamandra+Additional thanks for contributions from: Anthony Burzillo, Azeem Bande-Ali, Ben Moon, Bradley Hardy, Eric Seidel, Harry Clarke, Jason Xu, Lukasz Kolodziejczyk, Raoul Charman, TravelTissues and Vaibhav Yenamandra  Licensed under the Apache License, Version 2.0 (the "License"); you may not use this file except in compliance with the License.

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: f33857aa248d66c7f4c20fdc906e32ee466aeca57820d7fd2c0874092659737a+-- hash: 7ecba9dfd6edf736093629bbf1b7aa27d0e4d21260c2e931eaabda5aa5ff2c82  name:           fortran-src-version:        0.3.0+version:        0.4.0 synopsis:       Parser and anlyses for Fortran standards 66, 77, 90 and 95. description:    Provides lexing, parsing, and basic analyses of Fortran code covering standards: FORTRAN 66, FORTRAN 77, Fortran 90, and Fortran 95 and some legacy extensions. Includes data flow and basic block analysis, a renamer, and type analysis. For example usage, see the 'camfort' project, which uses fortran-src as its front end. category:       Language@@ -29,6 +29,7 @@   exposed-modules:       Language.Fortran.Analysis       Language.Fortran.Analysis.Renaming+      Language.Fortran.Analysis.ModGraph       Language.Fortran.Analysis.Types       Language.Fortran.Analysis.BBlocks       Language.Fortran.Analysis.DataFlow@@ -65,6 +66,7 @@     , binary >=0.8.3.0 && <0.9     , bytestring >=0.10 && <0.11     , containers >=0.5 && <0.7+    , deepseq     , directory >=1.2 && <2     , fgl >=5 && <6     , filepath >=1.4 && <2@@ -89,6 +91,7 @@     , binary >=0.8.3.0 && <0.9     , bytestring >=0.10 && <0.11     , containers >=0.5 && <0.7+    , deepseq     , directory >=1.2 && <2     , fgl >=5 && <6     , filepath >=1.4 && <2

@@ -16,6 +16,7 @@ import Data.Typeable () import Data.Binary import GHC.Generics (Generic)+import Control.DeepSeq import Text.PrettyPrint.GenericPretty import Language.Fortran.ParserMonad (FortranVersion(..)) @@ -460,7 +461,7 @@ data StructureItem a =     StructFields a SrcSpan (TypeSpec a) (Maybe (AList Attribute a)) (AList Declarator a)   | StructUnion a SrcSpan (AList UnionMap a)-  | StructStructure a SrcSpan (Maybe String) (AList StructureItem a)+  | StructStructure a SrcSpan (Maybe String) String (AList StructureItem a)   deriving (Eq, Show, Data, Typeable, Generic, Functor)  data UnionMap a =@@ -858,6 +859,7 @@   deriving (Ord, Eq, Show, Data, Typeable, Generic)  instance Binary ProgramUnitName+instance NFData ProgramUnitName  class Named a where   getName :: a -> ProgramUnitName@@ -979,3 +981,46 @@ nonExecutableStatementBlock v (BlStatement _ _ _ s) = nonExecutableStatement v s nonExecutableStatementBlock _ BlInterface{} = True nonExecutableStatementBlock _ _ = False++instance (NFData a, NFData (t a)) => NFData (AList t a)+instance NFData a => NFData (ProgramFile a)+instance NFData a => NFData (ProgramUnit a)+instance NFData a => NFData (Block a)+instance NFData a => NFData (Expression a)+instance NFData a => NFData (TypeSpec a)+instance NFData a => NFData (Index a)+instance NFData a => NFData (Value a)+instance NFData a => NFData (Comment a)+instance NFData a => NFData (Statement a)+instance NFData a => NFData (ProcDecl a)+instance NFData a => NFData (ProcInterface a)+instance NFData a => NFData (DoSpecification a)+instance NFData a => NFData (Selector a)+instance NFData a => NFData (ForallHeader a)+instance NFData a => NFData (Argument a)+instance NFData a => NFData (Use a)+instance NFData a => NFData (Attribute a)+instance NFData a => NFData (CommonGroup a)+instance NFData a => NFData (ControlPair a)+instance NFData a => NFData (AllocOpt a)+instance NFData a => NFData (DataGroup a)+instance NFData a => NFData (DimensionDeclarator a)+instance NFData a => NFData (Declarator a)+instance NFData a => NFData (FormatItem a)+instance NFData a => NFData (FlushSpec a)+instance NFData a => NFData (ImpElement a)+instance NFData a => NFData (ImpList a)+instance NFData a => NFData (Namelist a)+instance NFData a => NFData (Prefix a)+instance NFData a => NFData (Suffix a)+instance NFData a => NFData (StructureItem a)+instance NFData a => NFData (UnionMap a)+instance NFData MetaInfo+instance NFData FortranVersion+instance NFData CharacterLen+instance NFData BaseType+instance NFData UnaryOp+instance NFData BinaryOp+instance NFData Only+instance NFData ModuleNature+instance NFData Intent

@@ -15,7 +15,6 @@ where  import Prelude hiding (exp)-import Control.Monad (void) import Language.Fortran.Util.Position (SrcSpan) import Data.Generics.Uniplate.Data import Data.Data@@ -316,21 +315,21 @@      -- Match and give the varname for LHS of statement     match' v@(ExpValue _ _ ValVariable{}) = varName v-    match' (ExpSubscript _ _ v@(ExpValue _ _ ValVariable{}) _) = varName v-    match' (ExpDataRef _ _ v _) = match' v-    match' e = error $ "An unexpected LHS to an expression assign: " ++ show (void (const ()) e)+    match' (ExpSubscript _ _ e _)         = match' e+    match' (ExpDataRef _ _ v _)           = match' v+    match' e                              = error $ "An unexpected LHS to an expression assign: " ++ show (fmap (const ()) e)      -- Match and give the varname of LHSes which occur in subroutine calls-    match'' v@(ExpValue _ _ ValVariable{})                      = [varName v]-    match'' (ExpSubscript _ _ v@(ExpValue _ _ ValVariable{}) _) = [varName v]-    match'' (ExpDataRef _ _ v _)                                = match'' v-    match'' e                                                   = onExprs e+    match'' v@(ExpValue _ _ ValVariable{}) = [varName v]+    match'' (ExpSubscript _ _ e _)         = match'' e+    match'' (ExpDataRef _ _ v _)           = match'' v+    match'' e                              = onExprs e     -- Match and give the varname of LHSes which occur in function calls-    match v@(ExpValue _ _ ValVariable{})                      = [varName v]-    match (ExpSubscript _ _ v@(ExpValue _ _ ValVariable{}) _) = [varName v]-    match (ExpDataRef _ _ e _)                                = match e-    match _                                                   = []+    match v@(ExpValue _ _ ValVariable{}) = [varName v]+    match (ExpSubscript _ _ e _)         = match e+    match (ExpDataRef _ _ e _)           = match e+    match e                              = onExprs e  -- | Set of expressions used -- not defined -- by an AST-block. blockRhsExprs :: Data a => Block a -> [Expression a]

@@ -1,6 +1,6 @@ -- | Dataflow analysis to be applied once basic block analysis is complete. -{-# LANGUAGE FlexibleContexts, PatternGuards, ScopedTypeVariables, TupleSections, DeriveGeneric, DeriveDataTypeable #-}+{-# LANGUAGE FlexibleContexts, PatternGuards, ScopedTypeVariables, TupleSections, DeriveGeneric, DeriveDataTypeable, BangPatterns #-} module Language.Fortran.Analysis.DataFlow   ( dominators, iDominators, DomMap, IDomMap   , postOrder, revPostOrder, preOrder, revPreOrder, OrderF@@ -25,7 +25,9 @@ import Data.Generics.Uniplate.Data import GHC.Generics import Data.Data-import Control.Monad.State.Lazy+import qualified Control.Monad.State.Lazy as Lazy+import Control.Monad.State.Strict+import Control.DeepSeq import Control.Arrow ((&&&)) import Text.PrettyPrint.GenericPretty (Out) import Language.Fortran.Parser.Utils@@ -34,6 +36,7 @@ import Language.Fortran.AST import qualified Data.Map as M import qualified Data.IntMap.Lazy as IM+import qualified Data.IntMap.Strict as IMS import qualified Data.Set as S import qualified Data.IntSet as IS import Data.Graph.Inductive hiding (trc, dom, order, inn, out, rc)@@ -48,7 +51,7 @@ type BBNodeSet = IS.IntSet type ASTBlockNodeMap = IM.IntMap type ASTBlockNodeSet = IS.IntSet-type ASTExprNodeMap = IM.IntMap+type ASTExprNodeMap = IMS.IntMap type ASTExprNodeSet = IS.IntSet  -- | DomMap : node -> dominators of node@@ -115,19 +118,22 @@ -- | OutF, a function that returns the out-dataflow for a given node type OutF t     = Node -> t --- | Apply the iterative dataflow analysis method.-dataFlowSolver :: Ord t => BBGr a            -- ^ basic block graph-                        -> (Node -> InOut t) -- ^ initialisation for in and out dataflows-                        -> OrderF a          -- ^ ordering function-                        -> (OutF t -> InF t) -- ^ compute the in-flow given an out-flow function-                        -> (InF t -> OutF t) -- ^ compute the out-flow given an in-flow function-                        -> InOutMap t        -- ^ final dataflow for each node-dataFlowSolver gr initF order inF outF = converge (==) $ iterate step initM+-- | Apply the iterative dataflow analysis method. Forces evaluation+-- of intermediate data structures at each step.+dataFlowSolver :: (NFData t, Ord t)+               => BBGr a            -- ^ basic block graph+               -> (Node -> InOut t) -- ^ initialisation for in and out dataflows+               -> OrderF a          -- ^ ordering function+               -> (OutF t -> InF t) -- ^ compute the in-flow given an out-flow function+               -> (InF t -> OutF t) -- ^ compute the out-flow given an in-flow function+               -> InOutMap t        -- ^ final dataflow for each node+dataFlowSolver gr initF order inF outF = converge (==) $ iterate' step initM   where-    ordNodes = order gr-    initM    = IM.fromList [ (n, initF n) | n <- ordNodes ]-    step m   = IM.fromList [ (n, (inF (snd . get' m) n, outF (fst . get' m) n)) | n <- ordNodes ]-    get' m n  = fromJustMsg ("dataFlowSolver: get " ++ show n) $ IM.lookup n m+    ordNodes     = order gr+    initM        = IM.fromList [ (n, initF n) | n <- ordNodes ]+    step !m      = IM.fromList [ (n, (inF (snd . get' m) n, outF (fst . get' m) n)) | n <- ordNodes ]+    get' m n     = fromJustMsg ("dataFlowSolver: get " ++ show n) $ IM.lookup n m+    iterate' f x = x `deepseq` x : iterate' f (f x)  -- Similar to above but return a list of states instead of just the final one. --dataFlowSolver' :: Ord t => BBGr a            -- ^ basic block graph@@ -514,69 +520,80 @@ -- It's a 'lattice' but will leave it ungeneralised for the moment. data InductionExpr   = IETop                 -- not enough info-  | IELinear Name Int Int -- Basic induction var 'Name' * coefficient + offset+  | IELinear !Name !Int !Int -- Basic induction var 'Name' * coefficient + offset   | IEBottom              -- too difficult   deriving (Show, Eq, Ord, Typeable, Generic, Data)-+instance NFData InductionExpr type DerivedInductionMap = ASTExprNodeMap InductionExpr -data IEFlow = IEFlow { ieFlowVars :: M.Map Name InductionExpr, ieFlowExprs :: DerivedInductionMap }+data IEFlow = IEFlow { ieFlowVars :: M.Map Name InductionExpr, ieFlowExprs :: !DerivedInductionMap }   deriving (Show, Eq, Ord, Typeable, Generic, Data)+instance NFData IEFlow  ieFlowInsertVar :: Name -> InductionExpr -> IEFlow -> IEFlow ieFlowInsertVar v ie flow = flow { ieFlowVars = M.insert v ie (ieFlowVars flow) }  ieFlowInsertExpr :: ASTExprNode -> InductionExpr -> IEFlow -> IEFlow-ieFlowInsertExpr i ie flow = flow { ieFlowExprs = IM.insert i ie (ieFlowExprs flow) }+ieFlowInsertExpr i ie flow = flow { ieFlowExprs = IMS.insert i ie (ieFlowExprs flow) }  emptyIEFlow :: IEFlow-emptyIEFlow = IEFlow M.empty IM.empty+emptyIEFlow = IEFlow M.empty IMS.empty  joinIEFlows :: [IEFlow] -> IEFlow joinIEFlows flows = IEFlow flowV flowE   where     flowV = M.unionsWith joinInductionExprs (map ieFlowVars flows)-    flowE = IM.unionsWith joinInductionExprs (map ieFlowExprs flows)+    flowE = IMS.unionsWith joinInductionExprs (map ieFlowExprs flows)  -- | For every expression in a loop, try to derive its relationship to -- a basic induction variable. genDerivedInductionMap :: forall a. Data a => BackEdgeMap -> BBGr (Analysis a) -> DerivedInductionMap-genDerivedInductionMap bedges gr = ieFlowExprs . joinIEFlows . map snd . IM.elems . IM.filterWithKey inLoop $ inOutMaps+genDerivedInductionMap bedges gr = ieFlowExprs . joinIEFlows . map snd . IMS.elems . IMS.filterWithKey inLoop $ inOutMaps   where     bivMap = basicInductionVars bedges gr -- basic indvars indexed by loop header node     loopNodeSet = IS.unions (loopNodes bedges $ bbgrGr gr) -- set of nodes within a loop     inLoop i _ = i `IS.member` loopNodeSet      step :: IEFlow -> Block (Analysis a) -> IEFlow-    step flow b = case b of+    step !flow b = case b of       BlStatement _ _ _ (StExpressionAssign _ _ lv@(ExpValue _ _ (ValVariable _)) rhs)-        | _ <- insLabel (getAnnotation rhs)-        , flow''   <- ieFlowInsertVar (varName lv) (derivedInductionExpr flow' rhs) flow' -> stepExpr flow'' lv+        | _ <- insLabel (getAnnotation rhs), flow'' <- ieFlowInsertVar (varName lv) (derivedInductionExprMemo flow' rhs) flow'+        -> stepExpr flow'' lv       _ -> flow'       where-        flow' = foldl' stepExpr flow (universeBi b)+        -- flow' = foldl' stepExpr flow (universeBi b)+        flow' = execState (trans (\ e -> derivedInductionExprM e >> pure e) b) flow -- monadic version+        trans = transformBiM :: (Expression (Analysis a) -> State IEFlow (Expression (Analysis a))) -> Block (Analysis a) -> State IEFlow (Block (Analysis a)) +     stepExpr :: IEFlow -> Expression (Analysis a) -> IEFlow-    stepExpr flow e = ieFlowInsertExpr label ie flow+    stepExpr !flow e = ieFlowInsertExpr label ie flow       where         ie = derivedInductionExpr flow e         label = fromJustMsg "stepExpr" $ insLabel (getAnnotation e)      out :: InF IEFlow -> OutF IEFlow-    out inF node = foldl' step flow (fromJustMsg ("analyseDerivedIE out(" ++ show node ++ ")") $ lab (bbgrGr gr) node)+    out inF node = flow'       where         flow = joinIEFlows [fst (initF node), inF node]+        flow' = foldl' step flow (fromJustMsg ("analyseDerivedIE out(" ++ show node ++ ")") $ lab (bbgrGr gr) node)      inn :: OutF IEFlow -> InF IEFlow     inn outF node = joinIEFlows [ outF p | p <- pre (bbgrGr gr) node ]      initF :: Node -> InOut IEFlow-    initF node = case IM.lookup node bivMap of-                   Just set -> (IEFlow (M.fromList [ (n, IELinear n 1 0) | n <- S.toList set ]) IM.empty, emptyIEFlow)+    initF node = case IMS.lookup node bivMap of+                   Just set -> (IEFlow (M.fromList [ (n, IELinear n 1 0) | n <- S.toList set ]) IMS.empty, emptyIEFlow)                    Nothing  -> (emptyIEFlow, emptyIEFlow)      inOutMaps = dataFlowSolver gr initF revPostOrder inn out +derivedInductionExprMemo :: Data a => IEFlow -> Expression (Analysis a) -> InductionExpr+derivedInductionExprMemo flow e+  | Just label <- insLabel (getAnnotation e)+  , Just iexpr <- IMS.lookup label (ieFlowExprs flow) = iexpr+  | otherwise = derivedInductionExpr flow e+ -- Compute the relationship between the given expression and a basic -- induction variable, if possible. derivedInductionExpr :: Data a => IEFlow -> Expression (Analysis a) -> InductionExpr@@ -591,6 +608,25 @@   where     derive = derivedInductionExpr flow +-- Monadic version using State.+derivedInductionExprM :: Data a => Expression (Analysis a) -> State IEFlow InductionExpr+derivedInductionExprM e = do+  flow <- get+  let derive e' | Just label <- insLabel (getAnnotation e')+                , Just iexpr <- IMS.lookup label (ieFlowExprs flow) = pure iexpr+                | otherwise = derivedInductionExprM e'+  ie <- case e of+        v@(ExpValue _ _ (ValVariable _))   -> pure . fromMaybe IETop $ M.lookup (varName v) (ieFlowVars flow)+        ExpValue _ _ (ValInteger str)+          | Just i <- readInteger str      -> pure $ IELinear "" 0 (fromIntegral i)+        ExpBinary _ _ Addition e1 e2       -> addInductionExprs <$> derive e1 <*> derive e2+        ExpBinary _ _ Subtraction e1 e2    -> addInductionExprs <$> derive e1 <*> (negInductionExpr <$> derive e2)+        ExpBinary _ _ Multiplication e1 e2 -> mulInductionExprs <$> derive e1 <*> derive e2+        _                                  -> pure $ IETop -- unsure+  let Just label = insLabel (getAnnotation e)+  put $ ieFlowInsertExpr label ie flow+  pure ie+ -- Combine two induction variable relationships through addition. addInductionExprs :: InductionExpr -> InductionExpr -> InductionExpr addInductionExprs (IELinear ln lc lo) (IELinear rn rc ro)@@ -701,7 +737,7 @@  -- | Create a call map showing the structure of the program. genCallMap :: Data a => ProgramFile (Analysis a) -> CallMap-genCallMap pf = flip execState M.empty $ do+genCallMap pf = flip Lazy.execState M.empty $ do   let uP = universeBi :: Data a => ProgramFile a -> [ProgramUnit a]   forM_ (uP pf) $ \ pu -> do     let n = puName pu

@@ -0,0 +1,158 @@+{-# LANGUAGE DeriveDataTypeable, ScopedTypeVariables, PatternGuards, TupleSections #-}++-- | Generate a module use-graph.+module Language.Fortran.Analysis.ModGraph+  (genModGraph, ModGraph(..), ModOrigin(..), modGraphToDOT, takeNextMods, delModNodes)+where++import Prelude hiding (mod)+import Control.Monad+import Control.Monad.State.Strict+import Data.Data+import Data.Generics.Uniplate.Data+import Data.Graph.Inductive hiding (version)+import Data.Graph.Inductive.PatriciaTree (Gr)+import Data.Maybe+import Data.Text.Encoding (encodeUtf8, decodeUtf8With)+import Data.Text.Encoding.Error (replace)+import Language.Fortran.AST hiding (setName)+import Language.Fortran.Parser.Any+import Language.Fortran.ParserMonad (FortranVersion(..), fromRight)+import Language.Fortran.Util.ModFile+import qualified Data.ByteString.Char8 as B+import qualified Data.ByteString.Lazy.Char8 as LB+import qualified Data.Map as M+import System.IO+import System.Directory+import System.FilePath++--------------------------------------------------++data ModOrigin = MOFile FilePath | MOFSMod FilePath+  deriving (Eq, Data, Show)++instance Ord ModOrigin where+  MOFSMod _ <= MOFSMod _ = True+  a <= b = a == b++data ModGraph = ModGraph { mgModNodeMap :: M.Map String (Node, Maybe ModOrigin)+                         , mgGraph      :: Gr String ()+                         , mgNumNodes   :: Int }+  deriving (Eq, Data)++modGraph0 :: ModGraph+modGraph0 = ModGraph M.empty empty 0++type ModGrapher a = StateT ModGraph IO a++maybeAddModName :: String -> Maybe ModOrigin -> ModGrapher Node+maybeAddModName modName org = do+  mg@ModGraph { mgModNodeMap = mnmap, mgGraph = gr, mgNumNodes = numNodes } <- get+  case M.lookup modName mnmap of+    Just (i, org') | org <= org' -> pure i+                   | otherwise   -> do+                       let mnmap' = M.insert modName (i, org) mnmap+                       put $ mg { mgModNodeMap = mnmap' }+                       pure i+    Nothing -> do+      let i = numNodes + 1+      let mnmap' = M.insert modName (i, org) mnmap+      let gr' = insNode (i, modName) gr+      put $ mg { mgModNodeMap = mnmap', mgGraph = gr', mgNumNodes = i }+      pure i++addModDep :: String -> String -> ModGrapher ()+addModDep modName depName = do+  i <- maybeAddModName modName Nothing+  j <- maybeAddModName depName Nothing+  mg@ModGraph { mgGraph = gr } <- get+  put $ mg { mgGraph = insEdge (i, j, ()) gr }++genModGraph :: Maybe FortranVersion -> [FilePath] -> [FilePath] -> IO ModGraph+genModGraph mversion includeDirs paths = do+  let perModule path pu@(PUModule _ _ modName _ _) = do+        _ <- maybeAddModName modName (Just $ MOFile path)+        let uses = [ usedName | StUse _ _ (ExpValue _ _ (ValVariable usedName)) _ _ _ <-+                                universeBi pu :: [Statement ()] ]+        forM_ uses $ \ usedName -> do+          _ <- maybeAddModName usedName Nothing+          addModDep modName usedName+      perModule path pu | Named puName <- getName pu = do+        _ <- maybeAddModName puName (Just $ MOFile path)+        let uses = [ usedName | StUse _ _ (ExpValue _ _ (ValVariable usedName)) _ _ _ <-+                                universeBi pu :: [Statement ()] ]+        forM_ uses $ \ usedName -> do+          _ <- maybeAddModName usedName Nothing+          addModDep puName usedName+      perModule _ _ = pure ()+  let iter :: FilePath -> ModGrapher ()+      iter path = do+        contents <- liftIO $ flexReadFile path+        let version = fromMaybe (deduceVersion path) mversion+        let (Just parserF0) = lookup version parserWithModFilesVersions+        let parserF m b s = fromRight (parserF0 m b s)+        fileMods <- liftIO $ decodeModFiles includeDirs+        let mods = map snd fileMods+        forM_ fileMods $ \ (fileName, mod) -> do+          forM_ [ name | Named name <- M.keys (combinedModuleMap [mod]) ] $ \ name -> do+            _ <- maybeAddModName name . Just $ MOFSMod fileName+            pure ()+        let pf = parserF mods contents path+        mapM_ (perModule path) (childrenBi pf :: [ProgramUnit ()])+        pure ()+  execStateT (mapM_ iter paths) modGraph0++modGraphToDOT :: ModGraph -> String+modGraphToDOT ModGraph { mgGraph = gr } = unlines dot+  where+    dot = [ "strict digraph {\n"+          , "node [shape=box,fontname=\"Courier New\"]\n" ] +++          concatMap (\ (i, name) ->+                        [ "n" ++ show i ++ "[label=\"" ++ name ++ "\"]\n"+                        , "n" ++ show i ++ " -> {" ] +++                        [ " n" ++ show j | j <- suc gr i ] +++                        ["}\n"])+                    (labNodes gr) +++          [ "}\n" ]++takeNextMods :: ModGraph -> [(Node, Maybe ModOrigin)]+takeNextMods ModGraph { mgModNodeMap = mnmap, mgGraph = gr } = noDepFiles+  where+    noDeps = [ (i, modName) | (i, modName) <- labNodes gr, null (suc gr i) ]+    noDepFiles = [ (i, mo) | (i, modName) <- noDeps+                           , (_, mo) <- maybeToList (M.lookup modName mnmap) ]++delModNodes :: [Node] -> ModGraph -> ModGraph+delModNodes ns mg@ModGraph { mgGraph = gr } = mg'+  where+    mg' = mg { mgGraph = delNodes ns gr }++--------------------------------------------------++flexReadFile :: String -> IO B.ByteString+flexReadFile = fmap (encodeUtf8 . decodeUtf8With (replace ' ')) . B.readFile++decodeModFiles :: [String] -> IO [(FilePath, ModFile)]+decodeModFiles = foldM (\ modFiles d -> do+      -- Figure out the camfort mod files and parse them.+      modFileNames <- filter isModFile `fmap` getDirContents d+      addedModFiles <- fmap concat . forM modFileNames $ \ modFileName -> do+        contents <- LB.readFile (d </> modFileName)+        case decodeModFile contents of+          Left msg -> do+            hPutStrLn stderr $ modFileName ++ ": Error: " ++ msg+            return [(modFileName, emptyModFile)]+          Right mods -> do+            hPutStrLn stderr $ modFileName ++ ": successfully parsed precompiled file."+            return $ map (modFileName,) mods+      return $ addedModFiles ++ modFiles+    ) []++isModFile :: FilePath -> Bool+isModFile = (== modFileSuffix) . takeExtension++-- List files in dir+getDirContents :: String -> IO [String]+getDirContents d = do+  d' <- canonicalizePath d+  map (d' </>) `fmap` listDirectory d'

@@ -236,6 +236,7 @@  PROGRAM_INNER :: { ProgramFile A0 } : PROGRAM_UNITS { ProgramFile (MetaInfo { miVersion = Fortran2003, miFilename = "" }) (reverse $1) }+| {- empty -}   { ProgramFile (MetaInfo { miVersion = Fortran2003, miFilename = "" }) [] }  PROGRAM_UNITS :: { [ ProgramUnit A0 ] } : PROGRAM_UNITS PROGRAM_UNIT MAYBE_NEWLINE { $2 : $1 }

@@ -111,6 +111,7 @@ PROGRAM_INNER :: { ProgramFile A0 } PROGRAM_INNER : PROGRAM_UNITS BLOCKS { ProgramFile (MetaInfo { miVersion = Fortran66, miFilename = "" })  (reverse $1 ++ convCmts (reverse $2)) }+| {- empty -}   { ProgramFile (MetaInfo { miVersion = Fortran66, miFilename = "" }) [] }  PROGRAM_UNITS :: { [ ProgramUnit A0 ] } PROGRAM_UNITS

@@ -196,6 +196,7 @@ PROGRAM_INNER :: { ProgramFile A0 } PROGRAM_INNER : PROGRAM_UNITS { ProgramFile (MetaInfo { miVersion = Fortran77, miFilename = "" }) (reverse $1) }+| {- empty -}   { ProgramFile (MetaInfo { miVersion = Fortran77, miFilename = "" }) [] }  PROGRAM_UNITS :: { [ ProgramUnit A0 ] } PROGRAM_UNITS@@ -363,7 +364,6 @@ FORMAT_ID : FORMAT_ID '/' '/' FORMAT_ID %prec CONCAT { ExpBinary () (getTransSpan $1 $4) Concatenation $1 $4 } | INTEGER_LITERAL               { $1 }-| STRING                        { $1 } -- There should be FUNCTION_CALL here but as far as the parser is concerned it is same as SUBSCRIPT, -- hence putting it here would cause a reduce/reduce conflict. | SUBSCRIPT                     { $1 }@@ -431,7 +431,6 @@ | '(' CI_EXPRESSION ')' { setSpan (getTransSpan $1 $3) $2 } | INTEGER_LITERAL               { $1 } | LOGICAL_LITERAL               { $1 }-| STRING                        { $1 } -- There should be FUNCTION_CALL here but as far as the parser is concerned it is same as SUBSCRIPT, -- hence putting it here would cause a reduce/reduce conflict. | SUBSCRIPT                     { $1 }@@ -526,6 +525,8 @@     in StructFields () s t attrs decls } | union NEWLINE UNION_MAPS endunion NEWLINE   { StructUnion () (getTransSpan $1 $5) (fromReverseList $3) }+| structure MAYBE_NAME NAME NEWLINE STRUCTURE_DECLARATIONS endstructure NEWLINE+  { StructStructure () (getTransSpan $1 $7) $2 $3 (fromReverseList $5) }  UNION_MAPS :: { [ UnionMap A0 ] } UNION_MAPS@@ -805,7 +806,6 @@ | NUMERIC_LITERAL                   { $1 } | '(' EXPRESSION ',' EXPRESSION ')' { ExpValue () (getTransSpan $1 $5) (ValComplex $2 $4) } | LOGICAL_LITERAL                   { $1 }-| STRING                            { $1 } | HOLLERITH                         { $1 } -- There should be FUNCTION_CALL here but as far as the parser is concerned it is same as SUBSCRIPT, -- hence putting it here would cause a reduce/reduce conflict.@@ -860,7 +860,6 @@ | NUMERIC_LITERAL               { $1 } | '(' CONSTANT_EXPRESSION ',' CONSTANT_EXPRESSION ')' { ExpValue () (getTransSpan $1 $5) (ValComplex $2 $4)} | LOGICAL_LITERAL               { $1 }-| string                        { let (TString s cs) = $1 in ExpValue () s (ValString cs) } | SUBSCRIPT                    { $1 } | HOLLERITH                    { $1 } | '(/' EXPRESSION_LIST '/)' {@@ -900,6 +899,7 @@ | SUBSCRIPT '(' INDICIES ')'   { ExpSubscript () (getTransSpan $1 $4) $1 (fromReverseList $3) } | VARIABLE { $1 }+| STRING { $1 }  INDICIES :: { [ Index A0 ] } : INDICIES ',' INDEX { $3 : $1 }

@@ -211,6 +211,7 @@  PROGRAM_INNER :: { ProgramFile A0 } : PROGRAM_UNITS { ProgramFile (MetaInfo { miVersion = Fortran90, miFilename = "" }) (reverse $1) }+| {- empty -}   { ProgramFile (MetaInfo { miVersion = Fortran90, miFilename = "" }) [] }  PROGRAM_UNITS :: { [ ProgramUnit A0 ] } : PROGRAM_UNITS PROGRAM_UNIT MAYBE_NEWLINE { $2 : $1 }

@@ -215,6 +215,7 @@  PROGRAM_INNER :: { ProgramFile A0 } : PROGRAM_UNITS { ProgramFile (MetaInfo { miVersion = Fortran95, miFilename = "" }) (reverse $1) }+| {- empty -}   { ProgramFile (MetaInfo { miVersion = Fortran95, miFilename = "" }) [] }  PROGRAM_UNITS :: { [ ProgramUnit A0 ] } : PROGRAM_UNITS PROGRAM_UNIT MAYBE_NEWLINE { $2 : $1 }

@@ -974,7 +974,7 @@     "union" <> newline <>     foldl' (\doc item -> doc <> pprint v item (incIndentation i) <> newline) empty (aStrip maps) <>     "end union"-  pprint v (StructStructure a s mName items) _ = pprint' v (StStructure a s mName items)+  pprint v (StructStructure a s mName _ items) _ = pprint' v (StStructure a s mName items)  instance IndentablePretty (UnionMap a) where   pprint v (UnionMap _ _ items) i =

@@ -26,15 +26,18 @@ modules. The 'ModuleMap' stores information important to the renamer. The other data is up to you. +Note that the encoder and decoder work on lists of ModFile so that one+fsmod-file may contain information about multiple Fortran files.+ One typical usage might look like:  > let modFile1 = genModFile programFile > let modFile2 = alterModFileData (const (Just ...)) "mydata" modFile1-> let bytes    = encodeModFile modFile2+> let bytes    = encodeModFile [modFile2] > ... > case decodeModFile bytes of >   Left error -> print error->   Right modFile3 -> ...+>   Right modFile3:otherModuleFiles -> ... >     where >       moduleMap = combinedModuleMap (modFile3:otherModuleFiles) >       myData    = lookupModFileData "mydata" modFile3@@ -48,26 +51,27 @@   , genModFile, regenModFile, encodeModFile, decodeModFile   , StringMap, DeclMap, ParamVarMap, DeclContext(..), extractModuleMap, extractDeclMap   , moduleFilename, combinedStringMap, combinedDeclMap, combinedModuleMap, combinedTypeEnv, combinedParamVarMap-  , genUniqNameToFilenameMap )+  , genUniqNameToFilenameMap+  , TimestampStatus(..), checkTimestamps ) where +import Control.Monad.State+import Data.Binary (Binary, encode, decodeOrFail)+import qualified Data.ByteString.Lazy.Char8 as LB import Data.Data-import Data.Maybe import Data.Generics.Uniplate.Operations import qualified Data.Map.Strict as M-import Data.Binary (Binary, encode, decodeOrFail)-import Control.Monad.State+import Data.Maybe import GHC.Generics (Generic)--- import qualified Data.ByteString.Char8 as B-import qualified Data.ByteString.Lazy.Char8 as LB--import qualified Language.Fortran.Util.Position as P import qualified Language.Fortran.AST as F import qualified Language.Fortran.Analysis as FA+import qualified Language.Fortran.Analysis.BBlocks as FAB+import qualified Language.Fortran.Analysis.DataFlow as FAD import qualified Language.Fortran.Analysis.Renaming as FAR import qualified Language.Fortran.Analysis.Types as FAT-import qualified Language.Fortran.Analysis.DataFlow as FAD-import qualified Language.Fortran.Analysis.BBlocks as FAB+import qualified Language.Fortran.Util.Position as P+import System.Directory+import System.FilePath  -------------------------------------------------- @@ -153,19 +157,23 @@ -- alterModFileDataF :: Functor f => (Maybe B.ByteString -> f (Maybe B.ByteString)) -> String -> ModFile -> f ModFile -- alterModFileDataF f k mf = (\ od -> mf { mfOtherData = od }) <$> M.alterF f k (mfOtherData mf) --- | Convert ModFile to a strict ByteString for writing to file.-encodeModFile :: ModFile -> LB.ByteString-encodeModFile mf = encode mf' { mfStringMap = sm }+-- | Convert ModFiles to a strict ByteString for writing to file.+encodeModFile :: [ModFile] -> LB.ByteString+encodeModFile = encode . map each   where-    (mf', sm) = extractStringMap (mf { mfStringMap = M.empty })+    each mf = mf' { mfStringMap = sm }+      where+        (mf', sm) = extractStringMap (mf { mfStringMap = M.empty }) --- | Convert a strict ByteString to a ModFile, if possible. Revert the+-- | Convert a strict ByteString to ModFiles, if possible. Revert the -- String aliases according to the StringMap.-decodeModFile :: LB.ByteString -> Either String ModFile+decodeModFile :: LB.ByteString -> Either String [ModFile] decodeModFile bs = case decodeOrFail bs of-  Left (_, _, s)   -> Left s-  Right (_, _, mf) -> Right (revertStringMap sm mf { mfStringMap = M.empty }) { mfStringMap = sm }-    where sm = mfStringMap mf+  Left (_, _, s)    -> Left s+  Right (_, _, mfs) -> Right (map each mfs)+    where+      each mf = (revertStringMap sm mf { mfStringMap = M.empty }) { mfStringMap = sm }+        where sm = mfStringMap mf  -- | Extract the combined module map from a set of ModFiles. Useful -- for parsing a Fortran file in a large context of other modules.@@ -297,3 +305,23 @@           , st@F.StParameter {}                               <- universeBi bs  :: [F.Statement (FA.Analysis a)]           , (F.DeclVariable _ _ v _ _)                        <- universeBi st  :: [F.Declarator (FA.Analysis a)]           , Just con                                          <- [FA.constExp (F.getAnnotation v)] ]++-- | Status of mod-file compared to Fortran file.+data TimestampStatus = NoSuchFile | CompileFile | ModFileExists FilePath++-- | Compare the source file timestamp to the fsmod file timestamp, if+-- it exists.+checkTimestamps :: FilePath -> IO TimestampStatus+checkTimestamps path = do+  pathExists <- doesFileExist path+  modExists <- doesFileExist $ path -<.> modFileSuffix+  case (pathExists, modExists) of+    (False, _)    -> pure NoSuchFile+    (True, False) -> pure CompileFile+    (True, True)  -> do+      let modPath = path -<.> modFileSuffix+      pathModTime <- getModificationTime path+      modModTime  <- getModificationTime modPath+      if pathModTime < modModTime+        then pure $ ModFileExists modPath+        else pure CompileFile

@@ -9,6 +9,8 @@ import Text.PrettyPrint.GenericPretty import Text.PrettyPrint import Data.Binary+import GHC.Generics (Generic)+import Control.DeepSeq  import Language.Fortran.Util.SecondParameter @@ -24,6 +26,7 @@   } deriving (Eq, Ord, Data, Typeable, Generic)  instance Binary Position+instance NFData Position  instance Show Position where   show (Position _ c l _ _) = show l ++ ':' : show c@@ -53,7 +56,7 @@ data SrcSpan = SrcSpan Position Position deriving (Eq, Ord, Typeable, Data, Generic)  instance Binary SrcSpan-+instance NFData SrcSpan instance Show SrcSpan where   show (SrcSpan s1 s2)= '(' : show s1 ++ ")-(" ++ show s2 ++ ")" 

@@ -3,7 +3,7 @@  module Main where -import Prelude hiding (readFile)+import Prelude hiding (readFile, mod) import qualified Data.ByteString.Char8 as B import qualified Data.ByteString.Lazy.Char8 as LB import Data.Text.Encoding (encodeUtf8, decodeUtf8With)@@ -38,6 +38,7 @@ import Language.Fortran.Analysis import Language.Fortran.AST import Language.Fortran.Analysis.Types+import Language.Fortran.Analysis.ModGraph import Language.Fortran.Analysis.BBlocks import Language.Fortran.Analysis.DataFlow import Language.Fortran.Analysis.Renaming@@ -56,7 +57,52 @@   args <- getArgs   (opts, parsedArgs) <- compileArgs args   case (parsedArgs, action opts) of-    ([path], actionOpt) -> do+    (paths, ShowMakeGraph) -> do+      paths' <- expandDirs paths+      mg <- genModGraph (fortranVersion opts) (includeDirs opts) paths'+      putStrLn $ modGraphToDOT mg+    -- make: construct a build-dep graph and follow it+    (paths, Make) -> do+      let mvers = fortranVersion opts+      paths' <- expandDirs paths+      -- Build the graph of module dependencies+      mg0 <- genModGraph mvers (includeDirs opts) paths'+      -- Start the list of mods with those from the command line+      mods0 <- decodeModFiles $ includeDirs opts+      -- Loop through the dependency graph until it is empty+      let loop mg mods+            | nxt <- takeNextMods mg+            , not (null nxt) = do+                let fnPaths = [ fn | (_, Just (MOFile fn)) <- nxt ]+                newMods <- fmap concat . forM fnPaths $ \ fnPath -> do+                  tsStatus <- checkTimestamps fnPath+                  case tsStatus of+                    NoSuchFile -> do+                      putStr $ "Does not exist: " ++ fnPath+                      pure [emptyModFile]+                    ModFileExists modPath -> do+                      putStrLn $ "Loading mod file " ++ modPath ++ "."+                      decodeOneModFile modPath+                    CompileFile -> do+                      putStr $ "Summarising " ++ fnPath ++ "..."+                      mod <- compileFileToMod mvers mods fnPath Nothing+                      putStrLn "done"+                      pure [mod]++                let ns  = map fst nxt+                let mg' = delModNodes ns mg+                loop mg' $ newMods ++ mods+          loop _ mods = pure mods++      allMods <- loop mg0 mods0+      case outputFile opts of+        Nothing -> pure ()+        Just f  -> LB.writeFile f $ encodeModFile allMods++    (paths, Compile) -> do+      mods <- decodeModFiles $ includeDirs opts+      mapM_ (\ p -> compileFileToMod (fortranVersion opts) mods p (outputFile opts)) paths+    (path:_, actionOpt) -> do       contents <- flexReadFile path       let version = fromMaybe (deduceVersion path) (fortranVersion opts)       let (Just parserF0) = lookup version parserWithModFilesVersions@@ -76,7 +122,6 @@             where pf' = analyseParameterVars pvm . analyseBBlocks . analyseRenamesWithModuleMap mmap . initAnalysis $ pf                   bbm = genBBlockMap pf'                   sgr = genSuperBBGr bbm-      let runCompile = encodeModFile . genModFile . fst . analyseTypesWithEnv tenv . analyseRenamesWithModuleMap mmap . initAnalysis       let findBlockPU pf astBlockId = listToMaybe             [ pu | pu <- universeBi pf :: [ProgramUnit (Analysis A0)]                  , bbgr <- maybeToList (bBlocks (getAnnotation pu))@@ -95,22 +140,19 @@         BBlocks    -> putStrLn . runBBlocks $ parserF mods contents path         SuperGraph -> putStrLn . runSuperGraph $ parserF mods contents path         Reprint    -> putStrLn . render . flip (pprint version) (Just 0) $ parserF mods contents path-        Compile    -> do-          let bytes = runCompile $ parserF mods contents path-          let fspath = path <.> modFileSuffix-          LB.writeFile fspath bytes         DumpModFile -> do           let path' = if modFileSuffix `isSuffixOf` path then path else path <.> modFileSuffix           contents' <- LB.readFile path'           case decodeModFile contents' of-            Left msg -> putStrLn $ "Error: " ++ msg-            Right mf -> putStrLn $ "Filename: " ++ moduleFilename mf ++-                                   "\n\nStringMap:\n" ++ showStringMap (combinedStringMap [mf]) ++-                                   "\n\nModuleMap:\n" ++ showModuleMap (combinedModuleMap [mf]) ++-                                   "\n\nDeclMap:\n" ++ showGenericMap (combinedDeclMap [mf]) ++-                                   "\n\nTypeEnv:\n" ++ showTypes (combinedTypeEnv [mf]) ++-                                   "\n\nParamVarMap:\n" ++ showGenericMap (combinedParamVarMap [mf]) ++-                                   "\n\nOther Data Labels: " ++ show (getLabelsModFileData mf)+            Left msg  -> putStrLn $ "Error: " ++ msg+            Right mfs -> forM_ mfs $ \ mf ->+              putStrLn $ "Filename: " ++ moduleFilename mf +++                       "\n\nStringMap:\n" ++ showStringMap (combinedStringMap [mf]) +++                       "\n\nModuleMap:\n" ++ showModuleMap (combinedModuleMap [mf]) +++                       "\n\nDeclMap:\n" ++ showGenericMap (combinedDeclMap [mf]) +++                       "\n\nTypeEnv:\n" ++ showTypes (combinedTypeEnv [mf]) +++                       "\n\nParamVarMap:\n" ++ showGenericMap (combinedParamVarMap [mf]) +++                       "\n\nOther Data Labels: " ++ show (getLabelsModFileData mf)         ShowFlows isFrom isSuper astBlockId -> do           let pf = analyseParameterVars pvm .                    analyseBBlocks .@@ -156,8 +198,57 @@                 let suffix | null nodeIDs = ""                            | otherwise    = B.replicate (maxLen - B.length line + 1) ' ' <> "!" <> nodeStr                 B.putStrLn $ line <> suffix+        _ -> 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+  let version = fromMaybe (deduceVersion path) mvers+  let (Just parserF0) = lookup version parserWithModFilesVersions+  let parserF m b s = fromRight (parserF0 m b s)+  let mmap = combinedModuleMap mods+  let tenv = combinedTypeEnv mods+  let runCompile = genModFile . fst . analyseTypesWithEnv tenv . analyseRenamesWithModuleMap mmap . initAnalysis+  let mod = runCompile $ parserF mods contents path+  let fspath = path -<.> modFileSuffix `fromMaybe` moutfile+  LB.writeFile fspath $ encodeModFile [mod]+  return mod+ -- List files in dir recursively rGetDirContents :: String -> IO [String] rGetDirContents d = canonicalizePath d >>= \d' -> go [d'] d'@@ -181,21 +272,23 @@   map (d' </>) `fmap` listDirectory d'  decodeModFiles :: [String] -> IO ModFiles-decodeModFiles = foldM (\ modFiles d -> do-      -- Figure out the camfort mod files and parse them.-      modFileNames <- filter isModFile `fmap` getDirContents d-      addedModFiles <- forM modFileNames $ \ modFileName -> do-        contents <- LB.readFile (d </> modFileName)-        case decodeModFile contents of-          Left msg -> do-            hPutStrLn stderr $ modFileName ++ ": Error: " ++ msg-            return emptyModFile-          Right modFile -> do-            hPutStrLn stderr $ modFileName ++ ": successfully parsed precompiled file."-            return modFile-      return $ addedModFiles ++ modFiles-    ) emptyModFiles+decodeModFiles = flip foldM emptyModFiles $ \ modFiles d -> do+  -- Figure out the camfort mod files and parse them.+  modFileNames <- filter isModFile `fmap` getDirContents d+  addedModFiles <- concat <$> mapM (decodeOneModFile . (d </>)) modFileNames+  return $ addedModFiles ++ modFiles +decodeOneModFile :: FilePath -> IO ModFiles+decodeOneModFile path = do+  contents <- LB.readFile path+  case decodeModFile contents of+    Left msg -> do+      hPutStrLn stderr $ path ++ ": Error: " ++ msg+      return []+    Right modFiles -> do+      hPutStrLn stderr $ path ++ ": successfully parsed summary file."+      return modFiles+ isModFile :: FilePath -> Bool isModFile = (== modFileSuffix) . takeExtension @@ -262,7 +355,7 @@  data Action   = Lex | Parse | Typecheck | Rename | BBlocks | SuperGraph | Reprint | DumpModFile | Compile-  | ShowFlows Bool Bool Int | ShowBlocks (Maybe Int)+  | ShowFlows Bool Bool Int | ShowBlocks (Maybe Int) | ShowMakeGraph | Make   deriving Eq  instance Read Action where@@ -280,10 +373,11 @@   { fortranVersion  :: Maybe FortranVersion   , action          :: Action   , outputFormat    :: OutputFormat+  , outputFile      :: Maybe FilePath   , includeDirs     :: [String] }  initOptions :: Options-initOptions = Options Nothing Parse Default []+initOptions = Options Nothing Parse Default Nothing []  options :: [OptDescr (Options -> Options)] options =@@ -328,10 +422,22 @@       (ReqArg (\ d opts -> opts { includeDirs = d:includeDirs opts }) "DIR")       "directory to search for precompiled 'mod files'"   , Option ['c']-      ["compile"]+      ["summarise", "compile-mod"]       (NoArg $ \ opts -> opts { action = Compile })-      "compile an .fsmod file from the input"+      "build an .fsmod file from the input"+  , Option ['o']+      ["output-file"]+      (ReqArg (\ f opts -> opts { outputFile = Just f }) "FILE")+      "name of output file (e.g. name of generated fsmod file)"   , Option []+      ["make-mods", "make"]+      (NoArg $ \ opts -> opts { action = Make })+      "determine dependency order of modules and automatically build .fsmod files"+  , Option []+      ["show-make-graph"]+      (NoArg $ \ opts -> opts { action = ShowMakeGraph })+      "dump a graph showing the build structure of modules"+  , Option []       ["show-block-numbers"]       (OptArg (\a opts -> opts { action = ShowBlocks (a >>= readMaybe) }               ) "LINE-NUM")@@ -358,7 +464,7 @@     (o, n, []) -> return (foldl (flip id) initOptions o, n)     (_, _, errors) -> ioError $ userError $ concat errors ++ usageInfo header options   where-    header = "Usage: " ++ programName ++ " [OPTION...] <file>"+    header = "Usage: " ++ programName ++ " [OPTION...] <file...>"  instance {-# OVERLAPPING #-} Show [ FixedForm.Token ] where   show = unlines . lines'

@@ -135,6 +135,11 @@             exp = ExpSubscript () u (varGen "a") (AList () u [ range ])         eParser "a(5:)" `shouldBe'` exp +      it "parses literal string subscript" $ do+        let range = IxRange () u (Just $ intGen 1) (Just $ intGen 2) Nothing+            exp = ExpSubscript () u (strGen "abc") (AList () u [ range ])+        eParser "'abc'(1:2)" `shouldBe'` exp+     describe "GOTO" $ do       it "parses computed GOTO with integer expression" $ do         let exp = ExpBinary () u Multiplication (intGen 42) (intGen 24)@@ -229,6 +234,20 @@                     AList () u [DeclVariable () u (varGen "r") Nothing Nothing]]                  ]             st = StStructure () u (Just "foo") $ AList () u [StructUnion () u $ AList () u ds]+        resetSrcSpan (slParser src) `shouldBe` st++      it "parses nested structure blocks" $ do+        let src = init+                $ unlines [ "      structure /foo/"+                          , "        structure /bar/ baz"+                          , "          integer qux"+                          , "        end structure"+                          , "      end structure"]+            var = DeclVariable () u (varGen "qux") Nothing Nothing+            innerst = StructStructure () u (Just "bar") ("baz")+              $ AList () u [StructFields () u (TypeSpec () u TypeInteger Nothing) Nothing+                $ AList () u [var]]+            st = StStructure () u (Just "foo") $ AList () u [innerst]         resetSrcSpan (slParser src) `shouldBe` st        it "parses character declarations with unspecfied lengths" $ do

@@ -4,7 +4,7 @@ import Test.Hspec hiding (Selector) import TestUtil import Control.Exception (evaluate)-import Control.DeepSeq (force, NFData)+import Control.DeepSeq (force) import Data.ByteString.Char8 (ByteString, pack)  import Language.Fortran.Transformer@@ -20,51 +20,6 @@ groupDo = transform [ GroupLabeledDo ] groupForall :: ProgramFile () -> ProgramFile () groupForall = transform [ GroupForall ]--instance NFData MetaInfo-instance NFData FortranVersion-instance NFData SrcSpan-instance NFData Position-instance NFData CharacterLen-instance NFData BaseType-instance NFData UnaryOp-instance NFData BinaryOp-instance NFData Only-instance NFData ModuleNature-instance NFData Intent-instance (NFData a, NFData (t a)) => NFData (AList t a)-instance NFData a => NFData (ProgramFile a)-instance NFData a => NFData (ProgramUnit a)-instance NFData a => NFData (Block a)-instance NFData a => NFData (Expression a)-instance NFData a => NFData (TypeSpec a)-instance NFData a => NFData (Index a)-instance NFData a => NFData (Value a)-instance NFData a => NFData (Comment a)-instance NFData a => NFData (Statement a)-instance NFData a => NFData (ProcDecl a)-instance NFData a => NFData (ProcInterface a)-instance NFData a => NFData (DoSpecification a)-instance NFData a => NFData (Selector a)-instance NFData a => NFData (ForallHeader a)-instance NFData a => NFData (Argument a)-instance NFData a => NFData (Use a)-instance NFData a => NFData (Attribute a)-instance NFData a => NFData (CommonGroup a)-instance NFData a => NFData (ControlPair a)-instance NFData a => NFData (AllocOpt a)-instance NFData a => NFData (DataGroup a)-instance NFData a => NFData (DimensionDeclarator a)-instance NFData a => NFData (Declarator a)-instance NFData a => NFData (FormatItem a)-instance NFData a => NFData (FlushSpec a)-instance NFData a => NFData (ImpElement a)-instance NFData a => NFData (ImpList a)-instance NFData a => NFData (Namelist a)-instance NFData a => NFData (Prefix a)-instance NFData a => NFData (Suffix a)-instance NFData a => NFData (StructureItem a)-instance NFData a => NFData (UnionMap a)  spec :: Spec spec = do