{-
   Copyright 2016, Dominic Orchard, Andrew Rice, Mistral Contrastin, Matthew Danish

   Licensed under the Apache License, Version 2.0 (the "License");
   you may not use this file except in compliance with the License.
   You may obtain a copy of the License at

       http://www.apache.org/licenses/LICENSE-2.0

   Unless required by applicable law or agreed to in writing, software
   distributed under the License is distributed on an "AS IS" BASIS,
   WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
   See the License for the specific language governing permissions and
   limitations under the License.
-}

{-|

Format of Camfort precompiled files with information about Fortran
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]
> ...
> case decodeModFile bytes of
>   Left error -> print error
>   Right modFile3:otherModuleFiles -> ...
>     where
>       moduleMap = combinedModuleMap (modFile3:otherModuleFiles)
>       myData    = lookupModFileData "mydata" modFile3
>       renamedPF = analyseRenamesWithModuleMap moduleMap programFile

-}

module Language.Fortran.Util.ModFile
  (
  -- * Main defitions
    ModFile, ModFiles, emptyModFile, emptyModFiles, modFileSuffix
  , lookupModFileData, getLabelsModFileData, alterModFileData, alterModFileDataF

  -- * Creation
  , genModFile, regenModFile

  -- * En/decoding
  , encodeModFile, decodeModFile, decodeModFiles, decodeModFiles'

  -- * Operations
  , moduleFilename
  , StringMap, extractStringMap, combinedStringMap
  , DeclContext(..), DeclMap, extractDeclMap, combinedDeclMap
  , extractModuleMap, combinedModuleMap, localisedModuleMap, combinedTypeEnv
  , ParamVarMap, extractParamVarMap, combinedParamVarMap
  , genUniqNameToFilenameMap
  , TimestampStatus(..), checkTimestamps
  ) where

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.Util.Position     as P
import           Language.Fortran.Util.Files ( getDirContents )

import Control.Monad.State
import Control.Monad -- required for mtl-2.3 (GHC 9.6)
import Data.Binary (Binary, encode, decodeOrFail)
import qualified Data.ByteString.Lazy.Char8 as LB
import Data.Data
import Data.Generics.Uniplate.Operations
import qualified Data.Map.Strict as M
import Data.Maybe
import GHC.Generics (Generic)
import System.Directory ( doesFileExist, getModificationTime )
import qualified System.FilePath
import System.FilePath ( (-<.>), (</>), normalise )
import System.IO ( hPutStrLn, stderr )

--------------------------------------------------

-- | Standard ending of fortran-src-format "mod files"
modFileSuffix :: String
modFileSuffix :: Name
modFileSuffix = Name
".fsmod"

-- | Returns 'true' for filepaths with an extension that identifies them as a
--   mod file.
isModFile :: FilePath -> Bool
isModFile :: Name -> Bool
isModFile = Name -> Name -> Bool
System.FilePath.isExtensionOf Name
modFileSuffix

-- | Context of a declaration: the ProgramUnit where it was declared.
data DeclContext = DCMain | DCBlockData | DCModule F.ProgramUnitName
                 | DCFunction (F.ProgramUnitName, F.ProgramUnitName)    -- ^ (uniqName, srcName)
                 | DCSubroutine (F.ProgramUnitName, F.ProgramUnitName)  -- ^ (uniqName, srcName)
  deriving (Eq DeclContext
Eq DeclContext =>
(DeclContext -> DeclContext -> Ordering)
-> (DeclContext -> DeclContext -> Bool)
-> (DeclContext -> DeclContext -> Bool)
-> (DeclContext -> DeclContext -> Bool)
-> (DeclContext -> DeclContext -> Bool)
-> (DeclContext -> DeclContext -> DeclContext)
-> (DeclContext -> DeclContext -> DeclContext)
-> Ord DeclContext
DeclContext -> DeclContext -> Bool
DeclContext -> DeclContext -> Ordering
DeclContext -> DeclContext -> DeclContext
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DeclContext -> DeclContext -> Ordering
compare :: DeclContext -> DeclContext -> Ordering
$c< :: DeclContext -> DeclContext -> Bool
< :: DeclContext -> DeclContext -> Bool
$c<= :: DeclContext -> DeclContext -> Bool
<= :: DeclContext -> DeclContext -> Bool
$c> :: DeclContext -> DeclContext -> Bool
> :: DeclContext -> DeclContext -> Bool
$c>= :: DeclContext -> DeclContext -> Bool
>= :: DeclContext -> DeclContext -> Bool
$cmax :: DeclContext -> DeclContext -> DeclContext
max :: DeclContext -> DeclContext -> DeclContext
$cmin :: DeclContext -> DeclContext -> DeclContext
min :: DeclContext -> DeclContext -> DeclContext
Ord, DeclContext -> DeclContext -> Bool
(DeclContext -> DeclContext -> Bool)
-> (DeclContext -> DeclContext -> Bool) -> Eq DeclContext
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DeclContext -> DeclContext -> Bool
== :: DeclContext -> DeclContext -> Bool
$c/= :: DeclContext -> DeclContext -> Bool
/= :: DeclContext -> DeclContext -> Bool
Eq, Int -> DeclContext -> ShowS
[DeclContext] -> ShowS
DeclContext -> Name
(Int -> DeclContext -> ShowS)
-> (DeclContext -> Name)
-> ([DeclContext] -> ShowS)
-> Show DeclContext
forall a.
(Int -> a -> ShowS) -> (a -> Name) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DeclContext -> ShowS
showsPrec :: Int -> DeclContext -> ShowS
$cshow :: DeclContext -> Name
show :: DeclContext -> Name
$cshowList :: [DeclContext] -> ShowS
showList :: [DeclContext] -> ShowS
Show, Typeable DeclContext
Typeable DeclContext =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> DeclContext -> c DeclContext)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c DeclContext)
-> (DeclContext -> Constr)
-> (DeclContext -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c DeclContext))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c DeclContext))
-> ((forall b. Data b => b -> b) -> DeclContext -> DeclContext)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> DeclContext -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> DeclContext -> r)
-> (forall u. (forall d. Data d => d -> u) -> DeclContext -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> DeclContext -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> DeclContext -> m DeclContext)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> DeclContext -> m DeclContext)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> DeclContext -> m DeclContext)
-> Data DeclContext
DeclContext -> Constr
DeclContext -> DataType
(forall b. Data b => b -> b) -> DeclContext -> DeclContext
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> DeclContext -> u
forall u. (forall d. Data d => d -> u) -> DeclContext -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DeclContext -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DeclContext -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DeclContext -> m DeclContext
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DeclContext -> m DeclContext
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DeclContext
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DeclContext -> c DeclContext
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DeclContext)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DeclContext)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DeclContext -> c DeclContext
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DeclContext -> c DeclContext
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DeclContext
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DeclContext
$ctoConstr :: DeclContext -> Constr
toConstr :: DeclContext -> Constr
$cdataTypeOf :: DeclContext -> DataType
dataTypeOf :: DeclContext -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DeclContext)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DeclContext)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DeclContext)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c DeclContext)
$cgmapT :: (forall b. Data b => b -> b) -> DeclContext -> DeclContext
gmapT :: (forall b. Data b => b -> b) -> DeclContext -> DeclContext
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DeclContext -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DeclContext -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DeclContext -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DeclContext -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> DeclContext -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> DeclContext -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> DeclContext -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> DeclContext -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DeclContext -> m DeclContext
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DeclContext -> m DeclContext
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DeclContext -> m DeclContext
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DeclContext -> m DeclContext
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DeclContext -> m DeclContext
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DeclContext -> m DeclContext
Data, Typeable, (forall x. DeclContext -> Rep DeclContext x)
-> (forall x. Rep DeclContext x -> DeclContext)
-> Generic DeclContext
forall x. Rep DeclContext x -> DeclContext
forall x. DeclContext -> Rep DeclContext x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DeclContext -> Rep DeclContext x
from :: forall x. DeclContext -> Rep DeclContext x
$cto :: forall x. Rep DeclContext x -> DeclContext
to :: forall x. Rep DeclContext x -> DeclContext
Generic)

instance Binary DeclContext

-- | Map of unique variable name to the unique name of the program
-- unit where it was defined, its source name,
-- and the corresponding SrcSpan.
type DeclMap = M.Map F.Name (DeclContext, F.Name, P.SrcSpan)

-- | A map of aliases => strings, in order to save space and share
-- structure for repeated strings.
type StringMap = M.Map String String

-- | A map of variables => their constant expression if known
type ParamVarMap = FAD.ParameterVarMap

-- | The data stored in the "mod files"
data ModFile = ModFile { ModFile -> Name
mfFilename    :: String
                       , ModFile -> StringMap
mfStringMap   :: StringMap
                       , ModFile -> ModuleMap
mfModuleMap   :: FAR.ModuleMap
                       , ModFile -> DeclMap
mfDeclMap     :: DeclMap
                       , ModFile -> TypeEnvExtended
mfTypeEnv     :: FAT.TypeEnvExtended
                       , ModFile -> ParamVarMap
mfParamVarMap :: ParamVarMap
                       , ModFile -> Map Name ByteString
mfOtherData   :: M.Map String LB.ByteString
                      }
  deriving (ModFile -> ModFile -> Bool
(ModFile -> ModFile -> Bool)
-> (ModFile -> ModFile -> Bool) -> Eq ModFile
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ModFile -> ModFile -> Bool
== :: ModFile -> ModFile -> Bool
$c/= :: ModFile -> ModFile -> Bool
/= :: ModFile -> ModFile -> Bool
Eq, Int -> ModFile -> ShowS
[ModFile] -> ShowS
ModFile -> Name
(Int -> ModFile -> ShowS)
-> (ModFile -> Name) -> ([ModFile] -> ShowS) -> Show ModFile
forall a.
(Int -> a -> ShowS) -> (a -> Name) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ModFile -> ShowS
showsPrec :: Int -> ModFile -> ShowS
$cshow :: ModFile -> Name
show :: ModFile -> Name
$cshowList :: [ModFile] -> ShowS
showList :: [ModFile] -> ShowS
Show, Typeable ModFile
Typeable ModFile =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> ModFile -> c ModFile)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ModFile)
-> (ModFile -> Constr)
-> (ModFile -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ModFile))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ModFile))
-> ((forall b. Data b => b -> b) -> ModFile -> ModFile)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ModFile -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ModFile -> r)
-> (forall u. (forall d. Data d => d -> u) -> ModFile -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> ModFile -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> ModFile -> m ModFile)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ModFile -> m ModFile)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ModFile -> m ModFile)
-> Data ModFile
ModFile -> Constr
ModFile -> DataType
(forall b. Data b => b -> b) -> ModFile -> ModFile
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> ModFile -> u
forall u. (forall d. Data d => d -> u) -> ModFile -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ModFile -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ModFile -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ModFile -> m ModFile
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ModFile -> m ModFile
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ModFile
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ModFile -> c ModFile
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ModFile)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ModFile)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ModFile -> c ModFile
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ModFile -> c ModFile
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ModFile
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ModFile
$ctoConstr :: ModFile -> Constr
toConstr :: ModFile -> Constr
$cdataTypeOf :: ModFile -> DataType
dataTypeOf :: ModFile -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ModFile)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ModFile)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ModFile)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ModFile)
$cgmapT :: (forall b. Data b => b -> b) -> ModFile -> ModFile
gmapT :: (forall b. Data b => b -> b) -> ModFile -> ModFile
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ModFile -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ModFile -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ModFile -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ModFile -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ModFile -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> ModFile -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ModFile -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ModFile -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ModFile -> m ModFile
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ModFile -> m ModFile
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ModFile -> m ModFile
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ModFile -> m ModFile
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ModFile -> m ModFile
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ModFile -> m ModFile
Data, Typeable, (forall x. ModFile -> Rep ModFile x)
-> (forall x. Rep ModFile x -> ModFile) -> Generic ModFile
forall x. Rep ModFile x -> ModFile
forall x. ModFile -> Rep ModFile x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ModFile -> Rep ModFile x
from :: forall x. ModFile -> Rep ModFile x
$cto :: forall x. Rep ModFile x -> ModFile
to :: forall x. Rep ModFile x -> ModFile
Generic)

instance Binary ModFile

-- | A set of decoded mod files.
type ModFiles = [ModFile]

-- | Empty set of mod files. (future proof: may not always be a list)
emptyModFiles :: ModFiles
emptyModFiles :: [ModFile]
emptyModFiles = []

-- | Starting point.
emptyModFile :: ModFile
emptyModFile :: ModFile
emptyModFile = Name
-> StringMap
-> ModuleMap
-> DeclMap
-> TypeEnvExtended
-> ParamVarMap
-> Map Name ByteString
-> ModFile
ModFile Name
"" StringMap
forall k a. Map k a
M.empty ModuleMap
forall k a. Map k a
M.empty DeclMap
forall k a. Map k a
M.empty TypeEnvExtended
forall k a. Map k a
M.empty ParamVarMap
forall k a. Map k a
M.empty Map Name ByteString
forall k a. Map k a
M.empty

-- | Extracts the module map, declaration map and type analysis from
-- an analysed and renamed ProgramFile, then inserts it into the
-- ModFile.
regenModFile :: forall a. (Data a) => F.ProgramFile (FA.Analysis a) -> ModFile -> ModFile
regenModFile :: forall a. Data a => ProgramFile (Analysis a) -> ModFile -> ModFile
regenModFile ProgramFile (Analysis a)
pf ModFile
mf = ModFile
mf { mfModuleMap   = extractModuleMap pf
                        , mfDeclMap     = extractDeclMap pf
                        , mfTypeEnv     = FAT.extractTypeEnvExtended pf
                        , mfParamVarMap = extractParamVarMap pf
                        , mfFilename    = F.pfGetFilename pf }

-- | Generate a fresh ModFile from the module map, declaration map and
-- type analysis of a given analysed and renamed ProgramFile.
genModFile :: forall a. (Data a) => F.ProgramFile (FA.Analysis a) -> ModFile
genModFile :: forall a. Data a => ProgramFile (Analysis a) -> ModFile
genModFile = (ProgramFile (Analysis a) -> ModFile -> ModFile)
-> ModFile -> ProgramFile (Analysis a) -> ModFile
forall a b c. (a -> b -> c) -> b -> a -> c
flip ProgramFile (Analysis a) -> ModFile -> ModFile
forall a. Data a => ProgramFile (Analysis a) -> ModFile -> ModFile
regenModFile ModFile
emptyModFile

-- | Looks up the raw "other data" that may be stored in a ModFile by
-- applications that make use of fortran-src.
lookupModFileData :: String -> ModFile -> Maybe LB.ByteString
lookupModFileData :: Name -> ModFile -> Maybe ByteString
lookupModFileData Name
k = Name -> Map Name ByteString -> Maybe ByteString
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Name
k (Map Name ByteString -> Maybe ByteString)
-> (ModFile -> Map Name ByteString) -> ModFile -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModFile -> Map Name ByteString
mfOtherData

-- | Get a list of the labels present in the "other data" of a
-- ModFile. More of a meta-programming / debugging feature.
getLabelsModFileData :: ModFile -> [String]
getLabelsModFileData :: ModFile -> [Name]
getLabelsModFileData = Map Name ByteString -> [Name]
forall k a. Map k a -> [k]
M.keys (Map Name ByteString -> [Name])
-> (ModFile -> Map Name ByteString) -> ModFile -> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModFile -> Map Name ByteString
mfOtherData

-- | Allows modification/insertion/deletion of "other data" that may
-- be stored in a ModFile by applications that make use of
-- fortran-src. See 'Data.Map.Strict.alter' for more information about
-- the interface of this function.
alterModFileData :: (Maybe LB.ByteString -> Maybe LB.ByteString) -> String -> ModFile -> ModFile
alterModFileData :: (Maybe ByteString -> Maybe ByteString)
-> Name -> ModFile -> ModFile
alterModFileData Maybe ByteString -> Maybe ByteString
f Name
k ModFile
mf = ModFile
mf { mfOtherData = M.alter f k . mfOtherData $ mf }

alterModFileDataF
    :: Functor f
    => (Maybe LB.ByteString -> f (Maybe LB.ByteString)) -> String -> ModFile
    -> f ModFile
alterModFileDataF :: forall (f :: * -> *).
Functor f =>
(Maybe ByteString -> f (Maybe ByteString))
-> Name -> ModFile -> f ModFile
alterModFileDataF Maybe ByteString -> f (Maybe ByteString)
f Name
k ModFile
mf =
    (\Map Name ByteString
od -> ModFile
mf { mfOtherData = od }) (Map Name ByteString -> ModFile)
-> f (Map Name ByteString) -> f ModFile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Maybe ByteString -> f (Maybe ByteString))
-> Name -> Map Name ByteString -> f (Map Name ByteString)
forall (f :: * -> *) k a.
(Functor f, Ord k) =>
(Maybe a -> f (Maybe a)) -> k -> Map k a -> f (Map k a)
M.alterF Maybe ByteString -> f (Maybe ByteString)
f Name
k (ModFile -> Map Name ByteString
mfOtherData ModFile
mf)

-- | Convert ModFiles to a strict ByteString for writing to file.
encodeModFile :: [ModFile] -> LB.ByteString
encodeModFile :: [ModFile] -> ByteString
encodeModFile = [ModFile] -> ByteString
forall a. Binary a => a -> ByteString
encode ([ModFile] -> ByteString)
-> ([ModFile] -> [ModFile]) -> [ModFile] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ModFile -> ModFile) -> [ModFile] -> [ModFile]
forall a b. (a -> b) -> [a] -> [b]
map ModFile -> ModFile
each
  where
    each :: ModFile -> ModFile
each ModFile
mf = ModFile
mf' { mfStringMap = sm }
      where
        (ModFile
mf', StringMap
sm) = ModFile -> (ModFile, StringMap)
forall a. Data a => a -> (a, StringMap)
extractStringMap (ModFile
mf { mfStringMap = M.empty })

-- | Convert a strict ByteString to ModFiles, if possible. Revert the
-- String aliases according to the StringMap.
decodeModFile :: LB.ByteString -> Either String [ModFile]
decodeModFile :: ByteString -> Either Name [ModFile]
decodeModFile ByteString
bs = case ByteString
-> Either
     (ByteString, ByteOffset, Name) (ByteString, ByteOffset, [ModFile])
forall a.
Binary a =>
ByteString
-> Either
     (ByteString, ByteOffset, Name) (ByteString, ByteOffset, a)
decodeOrFail ByteString
bs of
  Left (ByteString
_, ByteOffset
_, Name
s)    -> Name -> Either Name [ModFile]
forall a b. a -> Either a b
Left Name
s
  Right (ByteString
_, ByteOffset
_, [ModFile]
mfs) -> [ModFile] -> Either Name [ModFile]
forall a b. b -> Either a b
Right ((ModFile -> ModFile) -> [ModFile] -> [ModFile]
forall a b. (a -> b) -> [a] -> [b]
map ModFile -> ModFile
each [ModFile]
mfs)
    where
      each :: ModFile -> ModFile
each ModFile
mf = (StringMap -> ModFile -> ModFile
forall a. Data a => StringMap -> a -> a
revertStringMap StringMap
sm ModFile
mf { mfStringMap = M.empty }) { mfStringMap = sm }
        where sm :: StringMap
sm = ModFile -> StringMap
mfStringMap ModFile
mf

decodeModFiles :: [FilePath] -> IO [(FilePath, ModFile)]
decodeModFiles :: [Name] -> IO [(Name, ModFile)]
decodeModFiles = ([(Name, ModFile)] -> Name -> IO [(Name, ModFile)])
-> [(Name, ModFile)] -> [Name] -> IO [(Name, ModFile)]
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\ [(Name, ModFile)]
modFiles Name
d -> do
      -- Figure out the camfort mod files and parse them.
      [Name]
modFileNames <- (Name -> Bool) -> [Name] -> [Name]
forall a. (a -> Bool) -> [a] -> [a]
filter Name -> Bool
isModFile ([Name] -> [Name]) -> IO [Name] -> IO [Name]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Name -> IO [Name]
getDirContents Name
d
      [(Name, ModFile)]
addedModFiles <- ([[(Name, ModFile)]] -> [(Name, ModFile)])
-> IO [[(Name, ModFile)]] -> IO [(Name, ModFile)]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[(Name, ModFile)]] -> [(Name, ModFile)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (IO [[(Name, ModFile)]] -> IO [(Name, ModFile)])
-> ((Name -> IO [(Name, ModFile)]) -> IO [[(Name, ModFile)]])
-> (Name -> IO [(Name, ModFile)])
-> IO [(Name, ModFile)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Name] -> (Name -> IO [(Name, ModFile)]) -> IO [[(Name, ModFile)]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Name]
modFileNames ((Name -> IO [(Name, ModFile)]) -> IO [(Name, ModFile)])
-> (Name -> IO [(Name, ModFile)]) -> IO [(Name, ModFile)]
forall a b. (a -> b) -> a -> b
$ \ Name
modFileName -> do
        ByteString
contents <- Name -> IO ByteString
LB.readFile (Name
d Name -> ShowS
</> Name
modFileName)
        case ByteString -> Either Name [ModFile]
decodeModFile ByteString
contents of
          Left Name
msg -> do
            Handle -> Name -> IO ()
hPutStrLn Handle
stderr (Name -> IO ()) -> Name -> IO ()
forall a b. (a -> b) -> a -> b
$ Name
modFileName Name -> ShowS
forall a. [a] -> [a] -> [a]
++ Name
": Error: " Name -> ShowS
forall a. [a] -> [a] -> [a]
++ Name
msg
            [(Name, ModFile)] -> IO [(Name, ModFile)]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [(Name
modFileName, ModFile
emptyModFile)]
          Right [ModFile]
mods -> do
            Handle -> Name -> IO ()
hPutStrLn Handle
stderr (Name -> IO ()) -> Name -> IO ()
forall a b. (a -> b) -> a -> b
$ Name
modFileName Name -> ShowS
forall a. [a] -> [a] -> [a]
++ Name
": successfully parsed precompiled file."
            [(Name, ModFile)] -> IO [(Name, ModFile)]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Name, ModFile)] -> IO [(Name, ModFile)])
-> [(Name, ModFile)] -> IO [(Name, ModFile)]
forall a b. (a -> b) -> a -> b
$ (ModFile -> (Name, ModFile)) -> [ModFile] -> [(Name, ModFile)]
forall a b. (a -> b) -> [a] -> [b]
map (Name
modFileName,) [ModFile]
mods
      [(Name, ModFile)] -> IO [(Name, ModFile)]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Name, ModFile)] -> IO [(Name, ModFile)])
-> [(Name, ModFile)] -> IO [(Name, ModFile)]
forall a b. (a -> b) -> a -> b
$ [(Name, ModFile)]
addedModFiles [(Name, ModFile)] -> [(Name, ModFile)] -> [(Name, ModFile)]
forall a. [a] -> [a] -> [a]
++ [(Name, ModFile)]
modFiles
    ) [] -- can't use emptyModFiles

decodeModFiles' :: [FilePath] -> IO ModFiles
decodeModFiles' :: [Name] -> IO [ModFile]
decodeModFiles' = ([(Name, ModFile)] -> [ModFile])
-> IO [(Name, ModFile)] -> IO [ModFile]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((Name, ModFile) -> ModFile) -> [(Name, ModFile)] -> [ModFile]
forall a b. (a -> b) -> [a] -> [b]
map (Name, ModFile) -> ModFile
forall a b. (a, b) -> b
snd) (IO [(Name, ModFile)] -> IO [ModFile])
-> ([Name] -> IO [(Name, ModFile)]) -> [Name] -> IO [ModFile]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Name] -> IO [(Name, ModFile)]
decodeModFiles

-- | Extract the combined module map from a set of ModFiles. Useful
-- for parsing a Fortran file in a large context of other modules.
combinedModuleMap :: ModFiles -> FAR.ModuleMap
combinedModuleMap :: [ModFile] -> ModuleMap
combinedModuleMap = [ModuleMap] -> ModuleMap
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
M.unions ([ModuleMap] -> ModuleMap)
-> ([ModFile] -> [ModuleMap]) -> [ModFile] -> ModuleMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ModFile -> ModuleMap) -> [ModFile] -> [ModuleMap]
forall a b. (a -> b) -> [a] -> [b]
map ModFile -> ModuleMap
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 :: ModuleMap -> ModuleMap
localisedModuleMap = (Map Name (Name, NameType) -> Map Name (Name, NameType))
-> ModuleMap -> ModuleMap
forall a b k. (a -> b) -> Map k a -> Map k b
M.map (((Name, NameType) -> Bool)
-> Map Name (Name, NameType) -> Map Name (Name, NameType)
forall a k. (a -> Bool) -> Map k a -> Map k a
M.filter (Bool -> Bool
not (Bool -> Bool)
-> ((Name, NameType) -> Bool) -> (Name, NameType) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NameType -> Bool
FA.isImported (NameType -> Bool)
-> ((Name, NameType) -> NameType) -> (Name, NameType) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name, NameType) -> NameType
forall a b. (a, b) -> b
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.TypeEnvExtended
combinedTypeEnv :: [ModFile] -> TypeEnvExtended
combinedTypeEnv = [TypeEnvExtended] -> TypeEnvExtended
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
M.unions ([TypeEnvExtended] -> TypeEnvExtended)
-> ([ModFile] -> [TypeEnvExtended]) -> [ModFile] -> TypeEnvExtended
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ModFile -> TypeEnvExtended) -> [ModFile] -> [TypeEnvExtended]
forall a b. (a -> b) -> [a] -> [b]
map ModFile -> TypeEnvExtended
mfTypeEnv

-- | Extract the combined declaration map from a set of
-- ModFiles. Useful for parsing a Fortran file in a large context of
-- other modules.
combinedDeclMap :: ModFiles -> DeclMap
combinedDeclMap :: [ModFile] -> DeclMap
combinedDeclMap = [DeclMap] -> DeclMap
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
M.unions ([DeclMap] -> DeclMap)
-> ([ModFile] -> [DeclMap]) -> [ModFile] -> DeclMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ModFile -> DeclMap) -> [ModFile] -> [DeclMap]
forall a b. (a -> b) -> [a] -> [b]
map ModFile -> DeclMap
mfDeclMap

-- | Extract the combined string map of ModFiles. Mainly internal use.
combinedStringMap :: ModFiles -> StringMap
combinedStringMap :: [ModFile] -> StringMap
combinedStringMap = [StringMap] -> StringMap
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
M.unions ([StringMap] -> StringMap)
-> ([ModFile] -> [StringMap]) -> [ModFile] -> StringMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ModFile -> StringMap) -> [ModFile] -> [StringMap]
forall a b. (a -> b) -> [a] -> [b]
map ModFile -> StringMap
mfStringMap

-- | Extract the combined string map of ModFiles. Mainly internal use.
combinedParamVarMap :: ModFiles -> ParamVarMap
combinedParamVarMap :: [ModFile] -> ParamVarMap
combinedParamVarMap = [ParamVarMap] -> ParamVarMap
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
M.unions ([ParamVarMap] -> ParamVarMap)
-> ([ModFile] -> [ParamVarMap]) -> [ModFile] -> ParamVarMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ModFile -> ParamVarMap) -> [ModFile] -> [ParamVarMap]
forall a b. (a -> b) -> [a] -> [b]
map ModFile -> ParamVarMap
mfParamVarMap

-- | Get the associated Fortran filename that was used to compile the
-- ModFile.
moduleFilename :: ModFile -> String
moduleFilename :: ModFile -> Name
moduleFilename = ModFile -> Name
mfFilename

--------------------------------------------------

-- | Create a map that links all unique variable/function names in the
-- ModFiles to their corresponding *originating* filename (i.e., where they are declared)
-- paired with their source name (maybe)
genUniqNameToFilenameMap :: FilePath -> ModFiles -> M.Map F.Name (String, Maybe F.Name)
genUniqNameToFilenameMap :: Name -> [ModFile] -> Map Name (Name, Maybe Name)
genUniqNameToFilenameMap Name
localPath [ModFile]
m = [Map Name (Name, Maybe Name)] -> Map Name (Name, Maybe Name)
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
M.unions ([Map Name (Name, Maybe Name)] -> Map Name (Name, Maybe Name))
-> ([ModFile] -> [Map Name (Name, Maybe Name)])
-> [ModFile]
-> Map Name (Name, Maybe Name)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ModFile -> Map Name (Name, Maybe Name))
-> [ModFile] -> [Map Name (Name, Maybe Name)]
forall a b. (a -> b) -> [a] -> [b]
map ModFile -> Map Name (Name, Maybe Name)
perMF ([ModFile] -> Map Name (Name, Maybe Name))
-> [ModFile] -> Map Name (Name, Maybe Name)
forall a b. (a -> b) -> a -> b
$ [ModFile]
m
  where
    perMF :: ModFile -> Map Name (Name, Maybe Name)
perMF ModFile
mf = [(Name, (Name, Maybe Name))] -> Map Name (Name, Maybe Name)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList
                ([(Name, (Name, Maybe Name))] -> Map Name (Name, Maybe Name))
-> [(Name, (Name, Maybe Name))] -> Map Name (Name, Maybe Name)
forall a b. (a -> b) -> a -> b
$ [ (Name
n, (Name
fname, Maybe Name
forall a. Maybe a
Nothing))
                     | (ProgramUnitName
_p, Map Name (Name, NameType)
modEnv) <- ModuleMap -> [(ProgramUnitName, Map Name (Name, NameType))]
forall k a. Map k a -> [(k, a)]
M.toList ModuleMap
localModuleMap
                     , (Name
n, NameType
_) <- Map Name (Name, NameType) -> [(Name, NameType)]
forall k a. Map k a -> [a]
M.elems Map Name (Name, NameType)
modEnv ]
              -- decl map information
               [(Name, (Name, Maybe Name))]
-> [(Name, (Name, Maybe Name))] -> [(Name, (Name, Maybe Name))]
forall a. Semigroup a => a -> a -> a
<>  [(Name
n, (Name
fname, Name -> Maybe Name
forall a. a -> Maybe a
Just Name
srcName)) | (Name
n, (DeclContext
_dc, Name
srcName, SrcSpan
_)) <- DeclMap -> [(Name, (DeclContext, Name, SrcSpan))]
forall k a. Map k a -> [(k, a)]
M.toList DeclMap
declMap ]

      where
        -- Make sure that we remove imported declarations so we can
        -- properly localise declarations to the originator file.
        localModuleMap :: ModuleMap
localModuleMap = ModuleMap -> ModuleMap
localisedModuleMap (ModuleMap -> ModuleMap) -> ModuleMap -> ModuleMap
forall a b. (a -> b) -> a -> b
$ ModFile -> ModuleMap
mfModuleMap ModFile
mf
        declMap :: DeclMap
declMap        = ModFile -> DeclMap
mfDeclMap ModFile
mf
        fname :: Name
fname = ShowS
normalise ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Name
localPath Name -> ShowS
</> ModFile -> Name
mfFilename ModFile
mf

--------------------------------------------------

-- | Extract all module maps (name -> environment) by collecting all
-- of the stored module maps within the PUModule annotation.
extractModuleMap :: forall a. Data a => F.ProgramFile (FA.Analysis a) -> FAR.ModuleMap
extractModuleMap :: forall a. Data a => ProgramFile (Analysis a) -> ModuleMap
extractModuleMap ProgramFile (Analysis a)
pf
  -- in case there are no modules, store global program unit names under the name 'NamelessMain'
  | [(ProgramUnitName, Map Name (Name, NameType))] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(ProgramUnitName, Map Name (Name, NameType))]
mmap = ProgramUnitName -> Map Name (Name, NameType) -> ModuleMap
forall k a. k -> a -> Map k a
M.singleton ProgramUnitName
F.NamelessMain (Map Name (Name, NameType) -> ModuleMap)
-> Map Name (Name, NameType) -> ModuleMap
forall a b. (a -> b) -> a -> b
$ [Map Name (Name, NameType)] -> Map Name (Name, NameType)
forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
M.unions [Map Name (Name, NameType)]
combinedEnv
  | Bool
otherwise = [(ProgramUnitName, Map Name (Name, NameType))] -> ModuleMap
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(ProgramUnitName, Map Name (Name, NameType))]
mmap
  where
    mmap :: [(ProgramUnitName, Map Name (Name, NameType))]
mmap = [ (ProgramUnitName
n, Map Name (Name, NameType)
env) | pu :: ProgramUnit (Analysis a)
pu@F.PUModule{} <- ProgramFile (Analysis a) -> [ProgramUnit (Analysis a)]
forall from to. Biplate from to => from -> [to]
childrenBi ProgramFile (Analysis a)
pf :: [F.ProgramUnit (FA.Analysis a)]
                      , let a :: Analysis a
a = ProgramUnit (Analysis a) -> Analysis a
forall a. ProgramUnit a -> a
forall (f :: * -> *) a. Annotated f => f a -> a
F.getAnnotation ProgramUnit (Analysis a)
pu
                      , let n :: ProgramUnitName
n = ProgramUnit (Analysis a) -> ProgramUnitName
forall a. Named a => a -> ProgramUnitName
F.getName ProgramUnit (Analysis a)
pu
                      , Map Name (Name, NameType)
env <- Maybe (Map Name (Name, NameType)) -> [Map Name (Name, NameType)]
forall a. Maybe a -> [a]
maybeToList (Analysis a -> Maybe (Map Name (Name, NameType))
forall a. Analysis a -> Maybe (Map Name (Name, NameType))
FA.moduleEnv Analysis a
a) ]
    combinedEnv :: [Map Name (Name, NameType)]
combinedEnv = [ Map Name (Name, NameType)
env | ProgramUnit (Analysis a)
pu <- ProgramFile (Analysis a) -> [ProgramUnit (Analysis a)]
forall from to. Biplate from to => from -> [to]
childrenBi ProgramFile (Analysis a)
pf :: [F.ProgramUnit (FA.Analysis a)]
                        , let a :: Analysis a
a = ProgramUnit (Analysis a) -> Analysis a
forall a. ProgramUnit a -> a
forall (f :: * -> *) a. Annotated f => f a -> a
F.getAnnotation ProgramUnit (Analysis a)
pu
                        , Map Name (Name, NameType)
env <- Maybe (Map Name (Name, NameType)) -> [Map Name (Name, NameType)]
forall a. Maybe a -> [a]
maybeToList (Analysis a -> Maybe (Map Name (Name, NameType))
forall a. Analysis a -> Maybe (Map Name (Name, NameType))
FA.moduleEnv Analysis a
a) ]

-- | Extract map of declared variables with their associated program
-- unit and source span.
extractDeclMap :: forall a. Data a => F.ProgramFile (FA.Analysis a) -> DeclMap
extractDeclMap :: forall a. Data a => ProgramFile (Analysis a) -> DeclMap
extractDeclMap ProgramFile (Analysis a)
pf = [(Name, (DeclContext, Name, SrcSpan))] -> DeclMap
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Name, (DeclContext, Name, SrcSpan))] -> DeclMap)
-> ([ProgramUnit (Analysis a)]
    -> [(Name, (DeclContext, Name, SrcSpan))])
-> [ProgramUnit (Analysis a)]
-> DeclMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProgramUnit (Analysis a)
 -> [(Name, (DeclContext, Name, SrcSpan))])
-> [ProgramUnit (Analysis a)]
-> [(Name, (DeclContext, Name, SrcSpan))]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((DeclContext, Maybe (Name, Name, SrcSpan), [Block (Analysis a)])
-> [(Name, (DeclContext, Name, SrcSpan))]
blockDecls ((DeclContext, Maybe (Name, Name, SrcSpan), [Block (Analysis a)])
 -> [(Name, (DeclContext, Name, SrcSpan))])
-> (ProgramUnit (Analysis a)
    -> (DeclContext, Maybe (Name, Name, SrcSpan),
        [Block (Analysis a)]))
-> ProgramUnit (Analysis a)
-> [(Name, (DeclContext, Name, SrcSpan))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProgramUnit (Analysis a)
-> (DeclContext, Maybe (Name, Name, SrcSpan), [Block (Analysis a)])
nameAndBlocks) ([ProgramUnit (Analysis a)] -> DeclMap)
-> [ProgramUnit (Analysis a)] -> DeclMap
forall a b. (a -> b) -> a -> b
$ ProgramFile (Analysis a) -> [ProgramUnit (Analysis a)]
forall from to. Biplate from to => from -> [to]
universeBi ProgramFile (Analysis a)
pf
  where
    -- Extract variable names, source spans from declarations (and
    -- from function return variable if present)
    blockDecls :: (DeclContext, Maybe (F.Name, F.Name, P.SrcSpan), [F.Block (FA.Analysis a)]) -> [(F.Name, (DeclContext, F.Name, P.SrcSpan))]
    blockDecls :: (DeclContext, Maybe (Name, Name, SrcSpan), [Block (Analysis a)])
-> [(Name, (DeclContext, Name, SrcSpan))]
blockDecls (DeclContext
dc, Maybe (Name, Name, SrcSpan)
mret, [Block (Analysis a)]
bs)
      | Maybe (Name, Name, SrcSpan)
Nothing        <- Maybe (Name, Name, SrcSpan)
mret = (Declarator (Analysis a) -> (Name, (DeclContext, Name, SrcSpan)))
-> [Declarator (Analysis a)]
-> [(Name, (DeclContext, Name, SrcSpan))]
forall a b. (a -> b) -> [a] -> [b]
map Declarator (Analysis a) -> (Name, (DeclContext, Name, SrcSpan))
decls ([Block (Analysis a)] -> [Declarator (Analysis a)]
forall from to. Biplate from to => from -> [to]
universeBi [Block (Analysis a)]
bs)
      | Just (Name
ret, Name
srcName, SrcSpan
ss) <- Maybe (Name, Name, SrcSpan)
mret = (Name
ret, (DeclContext
dc, Name
srcName, SrcSpan
ss))(Name, (DeclContext, Name, SrcSpan))
-> [(Name, (DeclContext, Name, SrcSpan))]
-> [(Name, (DeclContext, Name, SrcSpan))]
forall a. a -> [a] -> [a]
:(Declarator (Analysis a) -> (Name, (DeclContext, Name, SrcSpan)))
-> [Declarator (Analysis a)]
-> [(Name, (DeclContext, Name, SrcSpan))]
forall a b. (a -> b) -> [a] -> [b]
map Declarator (Analysis a) -> (Name, (DeclContext, Name, SrcSpan))
decls ([Block (Analysis a)] -> [Declarator (Analysis a)]
forall from to. Biplate from to => from -> [to]
universeBi [Block (Analysis a)]
bs)
      where
        decls :: Declarator (Analysis a) -> (Name, (DeclContext, Name, SrcSpan))
decls Declarator (Analysis a)
d = let (Name
v, Name
srcName, SrcSpan
ss) = Declarator (Analysis a) -> (Name, Name, SrcSpan)
declVarName Declarator (Analysis a)
d in (Name
v, (DeclContext
dc, Name
srcName, SrcSpan
ss))

    -- Extract variable name and source span from declaration
    declVarName :: F.Declarator (FA.Analysis a) -> (F.Name, F.Name, P.SrcSpan)
    declVarName :: Declarator (Analysis a) -> (Name, Name, SrcSpan)
declVarName (F.Declarator Analysis a
_ SrcSpan
_ Expression (Analysis a)
e DeclaratorType (Analysis a)
_ Maybe (Expression (Analysis a))
_ Maybe (Expression (Analysis a))
_)  = (Expression (Analysis a) -> Name
forall a. Expression (Analysis a) -> Name
FA.varName Expression (Analysis a)
e, Expression (Analysis a) -> Name
forall a. Expression (Analysis a) -> Name
FA.srcName Expression (Analysis a)
e, Expression (Analysis a) -> SrcSpan
forall a. Spanned a => a -> SrcSpan
P.getSpan Expression (Analysis a)
e)

    -- Extract context identifier, a function return value (+ source
    -- span) if present, and a list of contained blocks
    nameAndBlocks :: F.ProgramUnit (FA.Analysis a) -> (DeclContext, Maybe (F.Name, F.Name, P.SrcSpan), [F.Block (FA.Analysis a)])
    nameAndBlocks :: ProgramUnit (Analysis a)
-> (DeclContext, Maybe (Name, Name, SrcSpan), [Block (Analysis a)])
nameAndBlocks ProgramUnit (Analysis a)
pu = case ProgramUnit (Analysis a)
pu of
      F.PUMain       Analysis a
_ SrcSpan
_ Maybe Name
_ [Block (Analysis a)]
b Maybe [ProgramUnit (Analysis a)]
_            -> (DeclContext
DCMain, Maybe (Name, Name, SrcSpan)
forall a. Maybe a
Nothing, [Block (Analysis a)]
b)
      F.PUModule     Analysis a
_ SrcSpan
_ Name
_ [Block (Analysis a)]
b Maybe [ProgramUnit (Analysis a)]
_            -> (ProgramUnitName -> DeclContext
DCModule (ProgramUnitName -> DeclContext) -> ProgramUnitName -> DeclContext
forall a b. (a -> b) -> a -> b
$ ProgramUnit (Analysis a) -> ProgramUnitName
forall a. ProgramUnit (Analysis a) -> ProgramUnitName
FA.puName ProgramUnit (Analysis a)
pu, Maybe (Name, Name, SrcSpan)
forall a. Maybe a
Nothing, [Block (Analysis a)]
b)
      F.PUSubroutine Analysis a
_ SrcSpan
_ PrefixSuffix (Analysis a)
_ Name
_ Maybe (AList Expression (Analysis a))
_ [Block (Analysis a)]
b Maybe [ProgramUnit (Analysis a)]
_        -> ((ProgramUnitName, ProgramUnitName) -> DeclContext
DCSubroutine (ProgramUnit (Analysis a) -> ProgramUnitName
forall a. ProgramUnit (Analysis a) -> ProgramUnitName
FA.puName ProgramUnit (Analysis a)
pu, ProgramUnit (Analysis a) -> ProgramUnitName
forall a. ProgramUnit (Analysis a) -> ProgramUnitName
FA.puSrcName ProgramUnit (Analysis a)
pu), Maybe (Name, Name, SrcSpan)
forall a. Maybe a
Nothing, [Block (Analysis a)]
b)
      F.PUFunction   Analysis a
_ SrcSpan
_ Maybe (TypeSpec (Analysis a))
_ PrefixSuffix (Analysis a)
_ Name
_ Maybe (AList Expression (Analysis a))
_ Maybe (Expression (Analysis a))
mret [Block (Analysis a)]
b Maybe [ProgramUnit (Analysis a)]
_
        | Maybe (Expression (Analysis a))
Nothing   <- Maybe (Expression (Analysis a))
mret
        , F.Named Name
n <- ProgramUnit (Analysis a) -> ProgramUnitName
forall a. ProgramUnit (Analysis a) -> ProgramUnitName
FA.puName ProgramUnit (Analysis a)
pu       -> ((ProgramUnitName, ProgramUnitName) -> DeclContext
DCFunction (ProgramUnit (Analysis a) -> ProgramUnitName
forall a. ProgramUnit (Analysis a) -> ProgramUnitName
FA.puName ProgramUnit (Analysis a)
pu, ProgramUnit (Analysis a) -> ProgramUnitName
forall a. ProgramUnit (Analysis a) -> ProgramUnitName
FA.puSrcName ProgramUnit (Analysis a)
pu), (Name, Name, SrcSpan) -> Maybe (Name, Name, SrcSpan)
forall a. a -> Maybe a
Just (Name
n, Name
n, ProgramUnit (Analysis a) -> SrcSpan
forall a. Spanned a => a -> SrcSpan
P.getSpan ProgramUnit (Analysis a)
pu), [Block (Analysis a)]
b)
        | Just Expression (Analysis a)
ret <- Maybe (Expression (Analysis a))
mret                -> ((ProgramUnitName, ProgramUnitName) -> DeclContext
DCFunction (ProgramUnit (Analysis a) -> ProgramUnitName
forall a. ProgramUnit (Analysis a) -> ProgramUnitName
FA.puName ProgramUnit (Analysis a)
pu, ProgramUnit (Analysis a) -> ProgramUnitName
forall a. ProgramUnit (Analysis a) -> ProgramUnitName
FA.puSrcName ProgramUnit (Analysis a)
pu), (Name, Name, SrcSpan) -> Maybe (Name, Name, SrcSpan)
forall a. a -> Maybe a
Just (Expression (Analysis a) -> Name
forall a. Expression (Analysis a) -> Name
FA.varName Expression (Analysis a)
ret, Expression (Analysis a) -> Name
forall a. Expression (Analysis a) -> Name
FA.srcName Expression (Analysis a)
ret, Expression (Analysis a) -> SrcSpan
forall a. Spanned a => a -> SrcSpan
P.getSpan Expression (Analysis a)
ret), [Block (Analysis a)]
b)
        | Bool
otherwise                       -> Name
-> (DeclContext, Maybe (Name, Name, SrcSpan), [Block (Analysis a)])
forall a. HasCallStack => Name -> a
error (Name
 -> (DeclContext, Maybe (Name, Name, SrcSpan),
     [Block (Analysis a)]))
-> Name
-> (DeclContext, Maybe (Name, Name, SrcSpan), [Block (Analysis a)])
forall a b. (a -> b) -> a -> b
$ Name
"nameAndBlocks: un-named function with no return value! " Name -> ShowS
forall a. [a] -> [a] -> [a]
++ ProgramUnitName -> Name
forall a. Show a => a -> Name
show (ProgramUnit (Analysis a) -> ProgramUnitName
forall a. ProgramUnit (Analysis a) -> ProgramUnitName
FA.puName ProgramUnit (Analysis a)
pu) Name -> ShowS
forall a. [a] -> [a] -> [a]
++ Name
" at source-span " Name -> ShowS
forall a. [a] -> [a] -> [a]
++ SrcSpan -> Name
forall a. Show a => a -> Name
show (ProgramUnit (Analysis a) -> SrcSpan
forall a. Spanned a => a -> SrcSpan
P.getSpan ProgramUnit (Analysis a)
pu)
      F.PUBlockData  Analysis a
_ SrcSpan
_ Maybe Name
_ [Block (Analysis a)]
b              -> (DeclContext
DCBlockData, Maybe (Name, Name, SrcSpan)
forall a. Maybe a
Nothing, [Block (Analysis a)]
b)
      F.PUComment    {}                   -> (DeclContext
DCBlockData, Maybe (Name, Name, SrcSpan)
forall a. Maybe a
Nothing, []) -- no decls inside of comments, so ignore it

-- | Extract a string map from the given data, leaving behind aliased
-- values in place of strings in the returned version.
extractStringMap :: Data a => a -> (a, StringMap)
extractStringMap :: forall a. Data a => a -> (a, StringMap)
extractStringMap a
x = ((StringMap, Int) -> StringMap)
-> (a, (StringMap, Int)) -> (a, StringMap)
forall a b. (a -> b) -> (a, a) -> (a, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (StringMap -> StringMap
forall {a}. Map a Name -> Map Name a
inv (StringMap -> StringMap)
-> ((StringMap, Int) -> StringMap) -> (StringMap, Int) -> StringMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StringMap, Int) -> StringMap
forall a b. (a, b) -> a
fst) ((a, (StringMap, Int)) -> (a, StringMap))
-> (State (StringMap, Int) a -> (a, (StringMap, Int)))
-> State (StringMap, Int) a
-> (a, StringMap)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (State (StringMap, Int) a
 -> (StringMap, Int) -> (a, (StringMap, Int)))
-> (StringMap, Int)
-> State (StringMap, Int) a
-> (a, (StringMap, Int))
forall a b c. (a -> b -> c) -> b -> a -> c
flip State (StringMap, Int) a
-> (StringMap, Int) -> (a, (StringMap, Int))
forall s a. State s a -> s -> (a, s)
runState (StringMap
forall k a. Map k a
M.empty, Int
0) (State (StringMap, Int) a -> (a, StringMap))
-> State (StringMap, Int) a -> (a, StringMap)
forall a b. (a -> b) -> a -> b
$ (Name -> StateT (StringMap, Int) Identity Name)
-> a -> State (StringMap, Int) a
forall from to (m :: * -> *).
(Biplate from to, Applicative m) =>
(to -> m to) -> from -> m from
forall (m :: * -> *). Applicative m => (Name -> m Name) -> a -> m a
descendBiM Name -> StateT (StringMap, Int) Identity Name
f a
x
  where
    inv :: Map a Name -> Map Name a
inv = [(Name, a)] -> Map Name a
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Name, a)] -> Map Name a)
-> (Map a Name -> [(Name, a)]) -> Map a Name -> Map Name a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((a, Name) -> (Name, a)) -> [(a, Name)] -> [(Name, a)]
forall a b. (a -> b) -> [a] -> [b]
map (\ (a
a,Name
b) -> (Name
b,a
a)) ([(a, Name)] -> [(Name, a)])
-> (Map a Name -> [(a, Name)]) -> Map a Name -> [(Name, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map a Name -> [(a, Name)]
forall k a. Map k a -> [(k, a)]
M.toList
    f :: String -> State (StringMap, Int) String
    f :: Name -> StateT (StringMap, Int) Identity Name
f Name
s = do
      (StringMap
m, Int
n) <- StateT (StringMap, Int) Identity (StringMap, Int)
forall s (m :: * -> *). MonadState s m => m s
get
      case Name -> StringMap -> Maybe Name
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Name
s StringMap
m of
        Just Name
s' -> Name -> StateT (StringMap, Int) Identity Name
forall a. a -> StateT (StringMap, Int) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Name
s'
        Maybe Name
Nothing -> do
          let s' :: Name
s' = Char
'@'Char -> ShowS
forall a. a -> [a] -> [a]
:Int -> Name
forall a. Show a => a -> Name
show Int
n
          (StringMap, Int) -> StateT (StringMap, Int) Identity ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Name -> Name -> StringMap -> StringMap
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Name
s Name
s' StringMap
m, Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
          Name -> StateT (StringMap, Int) Identity Name
forall a. a -> StateT (StringMap, Int) Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Name
s'

-- | Rewrite the data with the string map aliases replaced by the
-- actual values (implicitly sharing structure).
revertStringMap :: Data a => StringMap -> a -> a
revertStringMap :: forall a. Data a => StringMap -> a -> a
revertStringMap StringMap
sm = ShowS -> a -> a
forall from to. Biplate from to => (to -> to) -> from -> from
descendBi (\ Name
s -> Name
s Name -> Maybe Name -> Name
forall a. a -> Maybe a -> a
`fromMaybe` Name -> StringMap -> Maybe Name
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Name
s StringMap
sm)

-- | Extract a map of variables assigned to constant values.
extractParamVarMap :: forall a. Data a => F.ProgramFile (FA.Analysis a) -> ParamVarMap
extractParamVarMap :: forall a. Data a => ProgramFile (Analysis a) -> ParamVarMap
extractParamVarMap ProgramFile (Analysis a)
pf = [(Name, FValue)] -> ParamVarMap
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Name, FValue)]
cvm
  where
    pf' :: ProgramFile (Analysis a)
pf' = ProgramFile (Analysis a) -> ProgramFile (Analysis a)
forall a.
Data a =>
ProgramFile (Analysis a) -> ProgramFile (Analysis a)
FAD.analyseConstExps (ProgramFile (Analysis a) -> ProgramFile (Analysis a))
-> ProgramFile (Analysis a) -> ProgramFile (Analysis a)
forall a b. (a -> b) -> a -> b
$ ProgramFile (Analysis a) -> ProgramFile (Analysis a)
forall a.
Data a =>
ProgramFile (Analysis a) -> ProgramFile (Analysis a)
FAB.analyseBBlocks ProgramFile (Analysis a)
pf
    cvm :: [(Name, FValue)]
cvm = [ (Expression (Analysis a) -> Name
forall a. Expression (Analysis a) -> Name
FA.varName Expression (Analysis a)
v, FValue
con)
          | F.PUModule Analysis a
_ SrcSpan
_ Name
_ [Block (Analysis a)]
bs Maybe [ProgramUnit (Analysis a)]
_                             <- ProgramFile (Analysis a) -> [ProgramUnit (Analysis a)]
forall from to. Biplate from to => from -> [to]
universeBi ProgramFile (Analysis a)
pf' :: [F.ProgramUnit (FA.Analysis a)]
          , st :: Statement (Analysis a)
st@(F.StDeclaration Analysis a
_ SrcSpan
_ (F.TypeSpec Analysis a
_ SrcSpan
_ BaseType
_ Maybe (Selector (Analysis a))
_) Maybe (AList Attribute (Analysis a))
_ AList Declarator (Analysis a)
_) <- [Block (Analysis a)] -> [Statement (Analysis a)]
forall from to. Biplate from to => from -> [to]
universeBi [Block (Analysis a)]
bs  :: [F.Statement (FA.Analysis a)]
          , F.AttrParameter Analysis a
_ SrcSpan
_                               <- Statement (Analysis a) -> [Attribute (Analysis a)]
forall from to. Biplate from to => from -> [to]
universeBi Statement (Analysis a)
st  :: [F.Attribute (FA.Analysis a)]
          , (F.Declarator Analysis a
_ SrcSpan
_ Expression (Analysis a)
v DeclaratorType (Analysis a)
F.ScalarDecl Maybe (Expression (Analysis a))
_ Maybe (Expression (Analysis a))
_)       <- Statement (Analysis a) -> [Declarator (Analysis a)]
forall from to. Biplate from to => from -> [to]
universeBi Statement (Analysis a)
st  :: [F.Declarator (FA.Analysis a)]
          , Just FValue
con                                          <- [Analysis a -> Maybe FValue
forall a. Analysis a -> Maybe FValue
FA.constExp (Expression (Analysis a) -> Analysis a
forall a. Expression a -> a
forall (f :: * -> *) a. Annotated f => f a -> a
F.getAnnotation Expression (Analysis a)
v)] ] [(Name, FValue)] -> [(Name, FValue)] -> [(Name, FValue)]
forall a. [a] -> [a] -> [a]
++
          [ (Expression (Analysis a) -> Name
forall a. Expression (Analysis a) -> Name
FA.varName Expression (Analysis a)
v, FValue
con)
          | F.PUModule Analysis a
_ SrcSpan
_ Name
_ [Block (Analysis a)]
bs Maybe [ProgramUnit (Analysis a)]
_                             <- ProgramFile (Analysis a) -> [ProgramUnit (Analysis a)]
forall from to. Biplate from to => from -> [to]
universeBi ProgramFile (Analysis a)
pf' :: [F.ProgramUnit (FA.Analysis a)]
          , st :: Statement (Analysis a)
st@F.StParameter {}                               <- [Block (Analysis a)] -> [Statement (Analysis a)]
forall from to. Biplate from to => from -> [to]
universeBi [Block (Analysis a)]
bs  :: [F.Statement (FA.Analysis a)]
          , (F.Declarator Analysis a
_ SrcSpan
_ Expression (Analysis a)
v DeclaratorType (Analysis a)
F.ScalarDecl Maybe (Expression (Analysis a))
_ Maybe (Expression (Analysis a))
_)       <- Statement (Analysis a) -> [Declarator (Analysis a)]
forall from to. Biplate from to => from -> [to]
universeBi Statement (Analysis a)
st  :: [F.Declarator (FA.Analysis a)]
          , Just FValue
con                                          <- [Analysis a -> Maybe FValue
forall a. Analysis a -> Maybe FValue
FA.constExp (Expression (Analysis a) -> Analysis a
forall a. Expression a -> a
forall (f :: * -> *) a. Annotated f => f a -> a
F.getAnnotation Expression (Analysis a)
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 :: Name -> IO TimestampStatus
checkTimestamps Name
path = do
  Bool
pathExists <- Name -> IO Bool
doesFileExist Name
path
  Bool
modExists <- Name -> IO Bool
doesFileExist (Name -> IO Bool) -> Name -> IO Bool
forall a b. (a -> b) -> a -> b
$ Name
path Name -> ShowS
-<.> Name
modFileSuffix
  case (Bool
pathExists, Bool
modExists) of
    (Bool
False, Bool
_)    -> TimestampStatus -> IO TimestampStatus
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TimestampStatus
NoSuchFile
    (Bool
True, Bool
False) -> TimestampStatus -> IO TimestampStatus
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TimestampStatus
CompileFile
    (Bool
True, Bool
True)  -> do
      let modPath :: Name
modPath = Name
path Name -> ShowS
-<.> Name
modFileSuffix
      UTCTime
pathModTime <- Name -> IO UTCTime
getModificationTime Name
path
      UTCTime
modModTime  <- Name -> IO UTCTime
getModificationTime Name
modPath
      if UTCTime
pathModTime UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
< UTCTime
modModTime
        then TimestampStatus -> IO TimestampStatus
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TimestampStatus -> IO TimestampStatus)
-> TimestampStatus -> IO TimestampStatus
forall a b. (a -> b) -> a -> b
$ Name -> TimestampStatus
ModFileExists Name
modPath
        else TimestampStatus -> IO TimestampStatus
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TimestampStatus
CompileFile