Infer.hs

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

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

{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric      #-}

module Camfort.Specification.Units.Analysis.Infer
  ( InferenceReport
  , InferenceResult(..)
  , getInferred
  , inferUnits
  ) where

import           Data.Data (Data)
import           Data.Generics.Uniplate.Operations
  (universeBi)
import           Data.List (sort)
import qualified Data.Map.Strict as M
import           Data.Maybe (mapMaybe, maybeToList)
import           GHC.Generics (Generic)
import qualified Data.ByteString as B

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

import Camfort.Analysis (ExitCodeOfReport(..), Describe(..))
import Camfort.Analysis.Annotations (Annotation)
import Camfort.Specification.Units.Analysis
  (UnitAnalysis, puName, puSrcName, runInference)
import Camfort.Specification.Units.Analysis.Consistent
  (ConsistencyError, ConsistencyReport(..), checkUnits)
import Camfort.Specification.Units.Environment
-- import Camfort.Specification.Units.InferenceBackendSBV (inferVariables)
import Camfort.Specification.Units.InferenceBackend (inferVariables,
                                                     chooseImplicitNames)
import Camfort.Specification.Units.Monad

import Camfort.Helpers (FileOrDir, Filename)

data ExpInfo = ExpInfo
  { eiSrcSpan :: FU.SrcSpan
  , eiVName   :: F.Name
  , eiSName   :: F.Name
  } deriving (Show, Eq, Ord, Typeable, Data, Generic)

-- | Report from unit inference.
data InferenceReport
  = InferenceReport (F.ProgramFile UA) [(VV, UnitInfo)]

data InferenceResult
  = Inferred InferenceReport
  | InfInconsistent ConsistencyError

instance ExitCodeOfReport InferenceResult where
  exitCodeOf (Inferred _) = 0
  exitCodeOf (InfInconsistent _) = 1

instance Show InferenceReport where
  show (InferenceReport pf vars) =
    concat ["\n", fname, ":\n", unlines [ expReport ei | ei <- expInfo ]]
    where
      expReport (ei, u) = "  " ++ showSrcSpan (eiSrcSpan ei) ++ " unit " ++ show u ++ " :: " ++ eiSName ei
      showSrcSpan :: FU.SrcSpan -> String
      showSrcSpan (FU.SrcSpan l _) = show l
      fname = F.pfGetFilename pf
      expInfo = [ (ei, u) | ei <- declVariableNames
                          , u <- maybeToList ((eiVName ei, eiSName ei) `lookup` vars) ]
      -- | List of declared variables (including both decl statements & function returns, defaulting to first)
      declVariableNames :: [ExpInfo]
      declVariableNames = sort . M.elems $ M.unionWith (curry fst) declInfo puInfo
        where
          declInfo = M.fromList [ (eiVName ei, ei) | ei <- declVariableNamesDecl ]
          puInfo   = M.fromList [ (eiVName ei, ei) | ei <- declVariableNamesPU ]
      declVariableNamesDecl :: [ExpInfo]
      declVariableNamesDecl = flip mapMaybe (universeBi pf :: [F.Declarator UA]) $ \ d -> case d of
        F.DeclVariable _ ss v@(F.ExpValue _ _ (F.ValVariable _)) _ _   -> Just (ExpInfo ss (FA.varName v) (FA.srcName v))
        F.DeclArray    _ ss v@(F.ExpValue _ _ (F.ValVariable _)) _ _ _ -> Just (ExpInfo ss (FA.varName v) (FA.srcName v))
        _                                                             -> Nothing
      declVariableNamesPU :: [ExpInfo]
      declVariableNamesPU = flip mapMaybe (universeBi pf :: [F.ProgramUnit UA]) $ \ pu -> case pu of
        F.PUFunction _ ss _ _ _ _ (Just v@(F.ExpValue _ _ (F.ValVariable _))) _ _ -> Just (ExpInfo ss (FA.varName v) (FA.srcName v))
        F.PUFunction _ ss _ _ _ _ Nothing _ _                                     -> Just (ExpInfo ss (puName pu) (puSrcName pu))
        _                                                                         -> Nothing

instance Show InferenceResult where
  show (Inferred report) = show report
  show (InfInconsistent err) = show err

instance Describe InferenceReport
instance Describe InferenceResult

getInferred :: InferenceReport -> [(VV, UnitInfo)]
getInferred (InferenceReport _ vars) = vars

-- | Check and infer units-of-measure for a program
--
-- This produces an output of all the unit information for a program.
inferUnits :: UnitAnalysis InferenceResult
inferUnits = do
  (eVars, state) <- runInference (chooseImplicitNames <$> runInferVariables)
  let pfUA = usProgramFile state -- the program file after units analysis is done
  case eVars of
    [] -> do
      consistency <- checkUnits
      pure $ case consistency of
        Consistent{}     -> Inferred (InferenceReport pfUA eVars)
        Inconsistent err -> InfInconsistent err
    _ -> pure . Inferred $ InferenceReport pfUA eVars

-- | Return a list of variable names mapped to their corresponding
-- unit that was inferred.
runInferVariables :: UnitSolver [(VV, UnitInfo)]
runInferVariables = inferVariables <$> getConstraints