module Language.Fortran.Vars.Equivalence
  ( processEquivalence
  )
where

import           Data.Data                      ( Data )
import           Data.List                      ( foldl' )
import           Data.Maybe                     ( fromMaybe )
import           Language.Fortran.Analysis      ( Analysis
                                                , srcName
                                                )
import           Language.Fortran.AST           ( AList
                                                , aStrip
                                                , Expression
                                                , Statement(..)
                                                )

import           Language.Fortran.Vars.MemoryLocation
                                                ( getLocation )
import           Language.Fortran.Vars.Types    ( Location
                                                , ProgramUnitModel
                                                )
import           Language.Fortran.Vars.Union    ( union )

associate :: ProgramUnitModel -> [Location] -> ProgramUnitModel
associate :: ProgramUnitModel -> [Location] -> ProgramUnitModel
associate ProgramUnitModel
puModel [Location]
locations =
  let Location
firstLoc : [Location]
restLocs = [Location]
locations
      f :: (ProgramUnitModel, Location)
-> Location -> (ProgramUnitModel, Location)
f (ProgramUnitModel
model, Location
loc) = ProgramUnitModel
-> Location -> Location -> (ProgramUnitModel, Location)
union ProgramUnitModel
model Location
loc
      (ProgramUnitModel
puModel', Location
_) = ((ProgramUnitModel, Location)
 -> Location -> (ProgramUnitModel, Location))
-> (ProgramUnitModel, Location)
-> [Location]
-> (ProgramUnitModel, Location)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (ProgramUnitModel, Location)
-> Location -> (ProgramUnitModel, Location)
f (ProgramUnitModel
puModel, Location
firstLoc) [Location]
restLocs
  in  ProgramUnitModel
puModel'

equivalence
  :: Data a => ProgramUnitModel -> Statement (Analysis a) -> ProgramUnitModel
equivalence :: forall a.
Data a =>
ProgramUnitModel -> Statement (Analysis a) -> ProgramUnitModel
equivalence ProgramUnitModel
puModel0 (StEquivalence Analysis a
_ SrcSpan
ss AList (AList Expression) (Analysis a)
equivsList) = (ProgramUnitModel
 -> AList Expression (Analysis a) -> ProgramUnitModel)
-> ProgramUnitModel
-> [AList Expression (Analysis a)]
-> ProgramUnitModel
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
  ProgramUnitModel
-> AList Expression (Analysis a) -> ProgramUnitModel
forall a.
Data a =>
ProgramUnitModel
-> AList Expression (Analysis a) -> ProgramUnitModel
f
  ProgramUnitModel
puModel0
  (AList (AList Expression) (Analysis a)
-> [AList Expression (Analysis a)]
forall (t :: * -> *) a. AList t a -> [t a]
aStrip AList (AList Expression) (Analysis a)
equivsList)
 where
  f
    :: Data a
    => ProgramUnitModel
    -> AList Expression (Analysis a)
    -> ProgramUnitModel
  f :: forall a.
Data a =>
ProgramUnitModel
-> AList Expression (Analysis a) -> ProgramUnitModel
f model :: ProgramUnitModel
model@(SymbolTable
symTable, StorageTable
_) AList Expression (Analysis a)
equivs =
    let
      locations :: [Location]
locations =
        (\Expression (Analysis a)
x ->
            Location -> Maybe Location -> Location
forall a. a -> Maybe a -> a
fromMaybe
                (String -> Location
forall a. HasCallStack => String -> a
error (String -> Location) -> String -> Location
forall a b. (a -> b) -> a -> b
$ String
"Couldn't calculate location at " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> SrcSpan -> String
forall a. Show a => a -> String
show SrcSpan
ss String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Expression (Analysis a) -> String
forall a. Expression (Analysis a) -> String
srcName Expression (Analysis a)
x
                )
              (Maybe Location -> Location) -> Maybe Location -> Location
forall a b. (a -> b) -> a -> b
$ SymbolTable -> Expression (Analysis a) -> Maybe Location
forall a.
Data a =>
SymbolTable -> Expression (Analysis a) -> Maybe Location
getLocation SymbolTable
symTable Expression (Analysis a)
x
          )
          (Expression (Analysis a) -> Location)
-> [Expression (Analysis a)] -> [Location]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AList Expression (Analysis a) -> [Expression (Analysis a)]
forall (t :: * -> *) a. AList t a -> [t a]
aStrip AList Expression (Analysis a)
equivs
    in  ProgramUnitModel -> [Location] -> ProgramUnitModel
associate ProgramUnitModel
model [Location]
locations
equivalence ProgramUnitModel
model Statement (Analysis a)
_ = ProgramUnitModel
model

-- | Given a list of all the 'Statement's in the program and a 'ProgramUnitModel', produce a new
-- 'ProgramUnitModel' that accounts for any of the FORTRAN equivalences that were found in the
-- 'Language.Fortran.AST.ProgramUnit'
processEquivalence
  :: Data a => [Statement (Analysis a)] -> ProgramUnitModel -> ProgramUnitModel
processEquivalence :: forall a.
Data a =>
[Statement (Analysis a)] -> ProgramUnitModel -> ProgramUnitModel
processEquivalence [Statement (Analysis a)]
stmts ProgramUnitModel
puModel = (ProgramUnitModel -> Statement (Analysis a) -> ProgramUnitModel)
-> ProgramUnitModel -> [Statement (Analysis a)] -> ProgramUnitModel
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ProgramUnitModel -> Statement (Analysis a) -> ProgramUnitModel
forall a.
Data a =>
ProgramUnitModel -> Statement (Analysis a) -> ProgramUnitModel
equivalence ProgramUnitModel
puModel [Statement (Analysis a)]
eqvStmts
  where eqvStmts :: [Statement (Analysis a)]
eqvStmts = [ Statement (Analysis a)
s | s :: Statement (Analysis a)
s@StEquivalence{} <- [Statement (Analysis a)]
stmts ]