packages feed

camfort-0.905: src/Camfort/Specification/Units/Analysis/Criticals.hs

{- |
Module      :  Camfort.Specification.Units.Analysis.Criticals
Description :  Critical-units analysis.
Copyright   :  (c) 2017, Dominic Orchard, Andrew Rice, Mistral Contrastin, Matthew Danish
License     :  Apache-2.0

Maintainer  :  dom.orchard@gmail.com
Stability   :  experimental

This module defines an analysis for finding the 'critical' variables in a program.
These critical variables form a set of variables that, when given unit annotations,
can be used to infer the unit types of all other variables in the program.
-}

module Camfort.Specification.Units.Analysis.Criticals
  ( inferCriticalVariables
  ) where

import           Control.Monad.State (get)
import           Control.Monad.Reader (asks, lift)
import           Data.Generics.Uniplate.Operations
import qualified Data.Map.Strict       as M
import           Data.Maybe (fromMaybe)

import Camfort.Analysis
import Camfort.Analysis.Annotations
import Camfort.Analysis.ModFile (withCombinedModuleMap)
import Camfort.Specification.Units.InferenceBackendSBV (criticalVariables)

-- Provides the types and data accessors used in this module
import           Camfort.Specification.Units.Analysis (UnitAnalysis, runInference)
import qualified Camfort.Specification.Units.Annotation as UA
import           Camfort.Specification.Units.Environment
import           Camfort.Specification.Units.Monad
import           Camfort.Specification.Units.MonadTypes

import qualified Language.Fortran.AST               as F
import qualified Language.Fortran.Analysis          as FA
import qualified Language.Fortran.Analysis.Renaming as FAR
import           Language.Fortran.Util.ModFile
import qualified Language.Fortran.Util.Position     as FU

-- | An inference of variables that must be provided with
-- unit annotations before units for all variables can be
-- resolved.
data Criticals = Criticals
  {
    -- | 'ProgramFile' analysis was performed upon.
    criticalsPf           :: F.ProgramFile Annotation
    -- | The inferred critical variables.
  , criticalsVariables    :: [UnitInfo]
    -- | Map of all declarations.
  , criticalsDeclarations :: M.Map F.Name (DeclContext, FU.SrcSpan)
    -- | Map of unique names.
  , criticalsUniqMap      :: M.Map F.Name F.Name
    -- | Location of criticals.
  , criticalsFromWhere    :: M.Map F.Name FilePath
  }

instance ExitCodeOfReport Criticals where
  exitCodeOf _ = 0

instance Show Criticals where
  show crits =
    case vars of
      []   -> concat ["\n", fname, ": No additional annotations are necessary.\n"]
      _    -> concat ["\n", fname, ": ", show numVars
                     , " variable declarations suggested to be given a specification:\n"
                     , unlines [ "    " ++ declReport d | d <- M.toList dmapSlice ]]
      where
        fname        = F.pfGetFilename . criticalsPf $ crits
        dmap         = criticalsDeclarations           crits
        uniqnameMap  = criticalsUniqMap                crits
        fromWhereMap = criticalsFromWhere              crits
        vars         = criticalsVariables              crits
        unitVarName (UnitVar (v, _))                 = v
        unitVarName (UnitParamVarUse (_, (v, _), _)) = v
        unitVarName _                                = "<bad>"
        varNames  = map unitVarName vars
        dmapSlice = M.filterWithKey (\ k _ -> k `elem` varNames) dmap
        numVars   = M.size dmapSlice
        declReport (v, (_, ss)) = vfilename ++ " (" ++ showSpanStart ss ++ ")    " ++ fromMaybe v (M.lookup v uniqnameMap)
          where vfilename = fromMaybe fname $ M.lookup v fromWhereMap
                showSpanStart (FU.SrcSpan l _) = show l

instance Describe Criticals

-- | Return a list of critical variables as UnitInfo list (most likely
-- to be of the UnitVar constructor).
runCriticalVariables :: UnitSolver [UnitInfo]
runCriticalVariables = do
  cons <- usConstraints `fmap` get
  return $ criticalVariables cons

-- | Infer one possible set of critical variables for a program.
inferCriticalVariables :: UnitAnalysis Criticals
inferCriticalVariables = do
  pf <- asks unitProgramFile
  mfs <- lift analysisModFiles
  (eVars, _) <- runInference runCriticalVariables
  let
    -- Use the module map derived from all of the included Camfort Mod files.
    (pfRenamed, mmap) = withCombinedModuleMap mfs . FA.initAnalysis . fmap UA.mkUnitAnnotation $ pf
    -- unique name -> src name across modules

    -- Map of all declarations
    dmap = extractDeclMap pfRenamed `M.union` combinedDeclMap mfs
    uniqnameMap = M.fromList [
                (FA.varName e, FA.srcName e) |
                e@(F.ExpValue _ _ F.ValVariable{}) <- universeBi pfRenamed :: [F.Expression UA]
                -- going to ignore intrinsics here
              ] `M.union` (M.unions . map (M.fromList . map (\ (a, (b, _)) -> (b, a)) . M.toList) $ M.elems mmap)
    fromWhereMap = genUniqNameToFilenameMap mfs
  pure Criticals { criticalsPf           = pf
                 , criticalsVariables    = eVars
                 , criticalsDeclarations = dmap
                 , criticalsUniqMap      = uniqnameMap
                 , criticalsFromWhere    = fromWhereMap
                 }