{-
   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.
-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}

module Camfort.Transformation.EquivalenceElim
  ( refactorEquivalences
  ) where

import           Camfort.Analysis
import           Camfort.Analysis.Annotations
import           Camfort.Helpers.Syntax
import           Camfort.Transformation.DeadCode
import           Control.Monad.State.Lazy hiding (ap)
import           Data.Generics.Uniplate.Operations
import           Data.List
import qualified Data.Map as M
import           Data.Void (Void)
import qualified Language.Fortran.AST as F
import qualified Language.Fortran.Analysis as FA
import qualified Language.Fortran.Analysis.Renaming as FAR
import qualified Language.Fortran.Analysis.Types as FAT (analyseTypes, TypeEnv)
import qualified Language.Fortran.Util.Position as FU

import qualified Debug.Trace

type EquivalenceRefactoring = PureAnalysis Void Void

type A1 = FA.Analysis Annotation
type RmEqState = ([[F.Expression A1]], Int)

refactorEquivalences :: F.ProgramFile A -> EquivalenceRefactoring (F.ProgramFile A)
refactorEquivalences :: ProgramFile Annotation
-> EquivalenceRefactoring (ProgramFile Annotation)
refactorEquivalences ProgramFile Annotation
pf = do
  let
    -- initialise analysis
    pf' :: ProgramFile A1
pf'             = ProgramFile A1 -> ProgramFile A1
forall a.
Data a =>
ProgramFile (Analysis a) -> ProgramFile (Analysis a)
FAR.analyseRenames (ProgramFile A1 -> ProgramFile A1)
-> (ProgramFile Annotation -> ProgramFile A1)
-> ProgramFile Annotation
-> ProgramFile A1
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProgramFile Annotation -> ProgramFile A1
forall (b :: * -> *) a. Functor b => b a -> b (Analysis a)
FA.initAnalysis (ProgramFile Annotation -> ProgramFile A1)
-> ProgramFile Annotation -> ProgramFile A1
forall a b. (a -> b) -> a -> b
$ ProgramFile Annotation
pf
    -- calculate types
    (ProgramFile A1
pf'', TypeEnv
typeEnv) = ProgramFile A1 -> (ProgramFile A1, TypeEnv)
forall a.
Data a =>
ProgramFile (Analysis a) -> (ProgramFile (Analysis a), TypeEnv)
FAT.analyseTypes ProgramFile A1
pf'
    -- Remove equivalences and add appropriate copy statements
  ProgramFile A1
pf''' <- TypeEnv
-> ProgramFile A1 -> EquivalenceRefactoring (ProgramFile A1)
refactoring TypeEnv
typeEnv ProgramFile A1
pf''
  -- Lastly deadcode eliminate any redundant copy statements
  -- generated by the refactoring (but don't dead code elim
  -- existing code)
  Bool
-> ProgramFile Annotation
-> EquivalenceRefactoring (ProgramFile Annotation)
deadCode Bool
True ((A1 -> Annotation) -> ProgramFile A1 -> ProgramFile Annotation
forall a b. (a -> b) -> ProgramFile a -> ProgramFile b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap A1 -> Annotation
forall a. Analysis a -> a
FA.prevAnnotation ProgramFile A1
pf''')
  where
    refactoring
      :: FAT.TypeEnv -> F.ProgramFile A1
      -> EquivalenceRefactoring (F.ProgramFile A1)
    refactoring :: TypeEnv
-> ProgramFile A1 -> EquivalenceRefactoring (ProgramFile A1)
refactoring TypeEnv
tenv ProgramFile A1
pf' = do
      (ProgramFile A1
pf'', RmEqState
_) <- StateT RmEqState EquivalenceRefactoring (ProgramFile A1)
-> RmEqState
-> AnalysisT Void Void Identity (ProgramFile A1, RmEqState)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT StateT RmEqState EquivalenceRefactoring (ProgramFile A1)
equiv ([], Int
0)
      ProgramFile A1 -> EquivalenceRefactoring (ProgramFile A1)
forall a. a -> AnalysisT Void Void Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return ProgramFile A1
pf''
      where
         equiv :: StateT RmEqState EquivalenceRefactoring (ProgramFile A1)
equiv = do ProgramFile A1
pf'' <- (Block A1 -> StateT RmEqState EquivalenceRefactoring (Block A1))
-> ProgramFile A1
-> StateT RmEqState EquivalenceRefactoring (ProgramFile A1)
forall (m :: * -> *) from to.
(Monad m, Applicative m, Biplate from to) =>
(to -> m to) -> from -> m from
transformBiM Block A1 -> StateT RmEqState EquivalenceRefactoring (Block A1)
perBlockRmEquiv ProgramFile A1
pf'
                    ([Block A1] -> StateT RmEqState EquivalenceRefactoring [Block A1])
-> ProgramFile A1
-> StateT RmEqState EquivalenceRefactoring (ProgramFile A1)
forall from to (m :: * -> *).
(Biplate from to, Applicative m) =>
(to -> m to) -> from -> m from
forall (m :: * -> *).
Applicative m =>
([Block A1] -> m [Block A1])
-> ProgramFile A1 -> m (ProgramFile A1)
descendBiM (TypeEnv
-> [Block A1] -> StateT RmEqState EquivalenceRefactoring [Block A1]
addCopysPerBlockGroup TypeEnv
tenv) ProgramFile A1
pf''

addCopysPerBlockGroup
  :: FAT.TypeEnv -> [F.Block A1]
  -> StateT RmEqState EquivalenceRefactoring [F.Block A1]
addCopysPerBlockGroup :: TypeEnv
-> [Block A1] -> StateT RmEqState EquivalenceRefactoring [Block A1]
addCopysPerBlockGroup TypeEnv
tenv [Block A1]
blocks = do
    [[Block A1]]
blockss <- (Block A1 -> StateT RmEqState EquivalenceRefactoring [Block A1])
-> [Block A1]
-> StateT RmEqState EquivalenceRefactoring [[Block A1]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (TypeEnv
-> Block A1 -> StateT RmEqState EquivalenceRefactoring [Block A1]
addCopysPerBlock TypeEnv
tenv) [Block A1]
blocks
    [Block A1] -> StateT RmEqState EquivalenceRefactoring [Block A1]
forall a. a -> StateT RmEqState EquivalenceRefactoring a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Block A1] -> StateT RmEqState EquivalenceRefactoring [Block A1])
-> [Block A1] -> StateT RmEqState EquivalenceRefactoring [Block A1]
forall a b. (a -> b) -> a -> b
$ [[Block A1]] -> [Block A1]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Block A1]]
blockss

addCopysPerBlock
  :: FAT.TypeEnv -> F.Block A1
  -> StateT RmEqState EquivalenceRefactoring [F.Block A1]
addCopysPerBlock :: TypeEnv
-> Block A1 -> StateT RmEqState EquivalenceRefactoring [Block A1]
addCopysPerBlock TypeEnv
tenv b :: Block A1
b@(F.BlStatement A1
_ SrcSpan
_ Maybe (Expression A1)
_
                 (F.StExpressionAssign A1
a sp :: SrcSpan
sp@(FU.SrcSpan Position
s1 Position
_) Expression A1
dstE Expression A1
_))
  | Bool -> Bool
not (Annotation -> Bool
pRefactored (Annotation -> Bool) -> Annotation -> Bool
forall a b. (a -> b) -> a -> b
$ A1 -> Annotation
forall a. Analysis a -> a
FA.prevAnnotation A1
a) = do
    -- Find all variables/cells that are equivalent to the target
    -- of this assignment
    [Expression A1]
eqs <- Expression A1
-> StateT RmEqState EquivalenceRefactoring [Expression A1]
equivalentsToExpr Expression A1
dstE
    Name
-> StateT RmEqState EquivalenceRefactoring [Block A1]
-> StateT RmEqState EquivalenceRefactoring [Block A1]
forall a. Name -> a -> a
Debug.Trace.trace (Int -> Name
forall a. Show a => a -> Name
show ([Expression A1] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Expression A1]
eqs)) (StateT RmEqState EquivalenceRefactoring [Block A1]
 -> StateT RmEqState EquivalenceRefactoring [Block A1])
-> StateT RmEqState EquivalenceRefactoring [Block A1]
-> StateT RmEqState EquivalenceRefactoring [Block A1]
forall a b. (a -> b) -> a -> b
$
        -- If there is only one, then it must refer to itself, so do nothing
        if [Expression A1] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Expression A1]
eqs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1
          then [Block A1] -> StateT RmEqState EquivalenceRefactoring [Block A1]
forall a. a -> StateT RmEqState EquivalenceRefactoring a
forall (m :: * -> *) a. Monad m => a -> m a
return [Block A1
b]
        -- If there are more than one, copy statements must be generated
          else do
            ([[Expression A1]]
equivs, Int
n) <- StateT RmEqState EquivalenceRefactoring RmEqState
forall s (m :: * -> *). MonadState s m => m s
get

            -- Remove the destination from the equivalents
            let eqs' :: [Expression A1]
eqs' = (Expression A1 -> Expression A1 -> Bool)
-> Expression A1 -> [Expression A1] -> [Expression A1]
forall a. (a -> a -> Bool) -> a -> [a] -> [a]
deleteBy (\ Expression A1
x Expression A1
y -> Expression A1 -> AnnotationFree (Expression A1)
forall t. t -> AnnotationFree t
af Expression A1
x AnnotationFree (Expression A1)
-> AnnotationFree (Expression A1) -> Bool
forall a. Eq a => a -> a -> Bool
== Expression A1 -> AnnotationFree (Expression A1)
forall t. t -> AnnotationFree t
af Expression A1
y) Expression A1
dstE [Expression A1]
eqs

            -- Make copy statements
            let pos :: Position
pos = SrcSpan -> Position
afterAligned SrcSpan
sp
            let copies :: [Block A1]
copies = (Expression A1 -> Block A1) -> [Expression A1] -> [Block A1]
forall a b. (a -> b) -> [a] -> [b]
map (TypeEnv -> Position -> Expression A1 -> Expression A1 -> Block A1
mkCopy TypeEnv
tenv Position
pos Expression A1
dstE) [Expression A1]
eqs'

            let (FU.Position Int
ao Int
c Int
l Name
f Maybe (Int, Name)
p) = Position
s1
                reportSpan :: Int -> SrcSpan
reportSpan Int
i =
                  let pos' :: Position
pos' = Int -> Int -> Int -> Name -> Maybe (Int, Name) -> Position
FU.Position (Int
ao Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i) Int
c (Int
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i) Name
f Maybe (Int, Name)
p
                  in (Position -> Position -> SrcSpan
FU.SrcSpan Position
pos' Position
pos')

            [Int]
-> (Int -> StateT RmEqState EquivalenceRefactoring ())
-> StateT RmEqState EquivalenceRefactoring ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Int
n..(Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Block A1] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Block A1]
copies Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)] ((Int -> StateT RmEqState EquivalenceRefactoring ())
 -> StateT RmEqState EquivalenceRefactoring ())
-> (Int -> StateT RmEqState EquivalenceRefactoring ())
-> StateT RmEqState EquivalenceRefactoring ()
forall a b. (a -> b) -> a -> b
$ \Int
i -> do
              Origin
origin <- SrcSpan -> StateT RmEqState EquivalenceRefactoring Origin
forall e w (m :: * -> *) a.
(MonadLogger e w m, Spanned a) =>
a -> m Origin
atSpanned (Int -> SrcSpan
reportSpan Int
i)
              Origin -> Text -> StateT RmEqState EquivalenceRefactoring ()
forall e w (m :: * -> *).
MonadLogger e w m =>
Origin -> Text -> m ()
logInfo Origin
origin (Text -> StateT RmEqState EquivalenceRefactoring ())
-> Text -> StateT RmEqState EquivalenceRefactoring ()
forall a b. (a -> b) -> a -> b
$ Text
"added copy due to refactored equivalence"

            -- Update refactoring state
            RmEqState -> StateT RmEqState EquivalenceRefactoring ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put ([[Expression A1]]
equivs, Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Expression A1] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Expression A1]
eqs')
            -- Sequence original assignment with new assignments
            [Block A1] -> StateT RmEqState EquivalenceRefactoring [Block A1]
forall a. a -> StateT RmEqState EquivalenceRefactoring a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Block A1] -> StateT RmEqState EquivalenceRefactoring [Block A1])
-> [Block A1] -> StateT RmEqState EquivalenceRefactoring [Block A1]
forall a b. (a -> b) -> a -> b
$ Block A1
b Block A1 -> [Block A1] -> [Block A1]
forall a. a -> [a] -> [a]
: [Block A1]
copies

addCopysPerBlock TypeEnv
tenv Block A1
x = do
   Block A1
x' <- ([Block A1] -> StateT RmEqState EquivalenceRefactoring [Block A1])
-> Block A1 -> StateT RmEqState EquivalenceRefactoring (Block A1)
forall from to (m :: * -> *).
(Biplate from to, Applicative m) =>
(to -> m to) -> from -> m from
forall (m :: * -> *).
Applicative m =>
([Block A1] -> m [Block A1]) -> Block A1 -> m (Block A1)
descendBiM (TypeEnv
-> [Block A1] -> StateT RmEqState EquivalenceRefactoring [Block A1]
addCopysPerBlockGroup TypeEnv
tenv) Block A1
x
   [Block A1] -> StateT RmEqState EquivalenceRefactoring [Block A1]
forall a. a -> StateT RmEqState EquivalenceRefactoring a
forall (m :: * -> *) a. Monad m => a -> m a
return [Block A1
x']

-- see if two expressions have the same type
equalTypes :: FAT.TypeEnv -> F.Expression A1 -> F.Expression A1 -> Maybe FA.IDType
equalTypes :: TypeEnv -> Expression A1 -> Expression A1 -> Maybe IDType
equalTypes TypeEnv
tenv Expression A1
e Expression A1
e' = do
    Name
v1 <- Expression A1 -> Maybe Name
forall a. Expression a -> Maybe Name
extractVariable Expression A1
e
    Name
v2 <- Expression A1 -> Maybe Name
forall a. Expression a -> Maybe Name
extractVariable Expression A1
e'
    IDType
t1 <- Name -> TypeEnv -> Maybe IDType
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Name
v1 TypeEnv
tenv
    IDType
t2 <- Name -> TypeEnv -> Maybe IDType
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Name
v2 TypeEnv
tenv
    if IDType
t1 IDType -> IDType -> Bool
forall a. Eq a => a -> a -> Bool
== IDType
t2 then IDType -> Maybe IDType
forall a. a -> Maybe a
Just IDType
t1 else Maybe IDType
forall a. Maybe a
Nothing

-- Create copy statements. Parameters:
--    * A type environment to find out if a type cast is needed
--    * A SrcPos where the copy statements are going to inserted at
--    * The source expression
--    * The number of copies to increment the line by
--           paired with the destination expression
mkCopy :: FAT.TypeEnv
       -> FU.Position
       -> F.Expression A1 -> F.Expression A1 -> F.Block A1
mkCopy :: TypeEnv -> Position -> Expression A1 -> Expression A1 -> Block A1
mkCopy TypeEnv
tenv Position
pos Expression A1
srcE Expression A1
dstE = Block Annotation -> Block A1
forall (b :: * -> *) a. Functor b => b a -> b (Analysis a)
FA.initAnalysis (Block Annotation -> Block A1) -> Block Annotation -> Block A1
forall a b. (a -> b) -> a -> b
$
   Annotation
-> SrcSpan
-> Maybe (Expression Annotation)
-> Statement Annotation
-> Block Annotation
forall a.
a -> SrcSpan -> Maybe (Expression a) -> Statement a -> Block a
F.BlStatement Annotation
a SrcSpan
sp Maybe (Expression Annotation)
forall a. Maybe a
Nothing (Statement Annotation -> Block Annotation)
-> Statement Annotation -> Block Annotation
forall a b. (a -> b) -> a -> b
$
     case TypeEnv -> Expression A1 -> Expression A1 -> Maybe IDType
equalTypes TypeEnv
tenv Expression A1
srcE Expression A1
dstE of
       -- Types not equal, so create a transfer
       Maybe IDType
Nothing -> Annotation
-> SrcSpan
-> Expression Annotation
-> Expression Annotation
-> Statement Annotation
forall a.
a -> SrcSpan -> Expression a -> Expression a -> Statement a
F.StExpressionAssign Annotation
a SrcSpan
sp Expression Annotation
dstE' Expression Annotation
call
                    where
                     call :: Expression Annotation
call = Annotation
-> SrcSpan
-> Expression Annotation
-> AList Argument Annotation
-> Expression Annotation
forall a.
a -> SrcSpan -> Expression a -> AList Argument a -> Expression a
F.ExpFunctionCall Annotation
a SrcSpan
sp Expression Annotation
transf AList Argument Annotation
argst
                     transf :: Expression Annotation
transf = Annotation -> SrcSpan -> Value Annotation -> Expression Annotation
forall a. a -> SrcSpan -> Value a -> Expression a
F.ExpValue Annotation
a SrcSpan
sp (Name -> Value Annotation
forall a. Name -> Value a
F.ValVariable Name
"transfer")
                     argst :: AList Argument Annotation
argst  = Annotation
-> SrcSpan -> [Argument Annotation] -> AList Argument Annotation
forall (t :: * -> *) a. a -> SrcSpan -> [t a] -> AList t a
F.AList Annotation
a SrcSpan
sp [Argument Annotation]
args
                     args :: [Argument Annotation]
args   = (Expression Annotation -> Argument Annotation)
-> [Expression Annotation] -> [Argument Annotation]
forall a b. (a -> b) -> [a] -> [b]
map (Annotation
-> SrcSpan
-> Maybe Name
-> ArgumentExpression Annotation
-> Argument Annotation
forall a.
a -> SrcSpan -> Maybe Name -> ArgumentExpression a -> Argument a
F.Argument Annotation
a SrcSpan
sp Maybe Name
forall a. Maybe a
Nothing (ArgumentExpression Annotation -> Argument Annotation)
-> (Expression Annotation -> ArgumentExpression Annotation)
-> Expression Annotation
-> Argument Annotation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expression Annotation -> ArgumentExpression Annotation
forall a. Expression a -> ArgumentExpression a
F.ArgExpr) [Expression Annotation
srcE', Expression Annotation
dstE']
       -- Types are equal, simple a assignment
       Just IDType
_ -> Annotation
-> SrcSpan
-> Expression Annotation
-> Expression Annotation
-> Statement Annotation
forall a.
a -> SrcSpan -> Expression a -> Expression a -> Statement a
F.StExpressionAssign Annotation
a SrcSpan
sp Expression Annotation
dstE' Expression Annotation
srcE'
  where
     -- Set position to be at col = 0
     sp :: SrcSpan
sp   = Position -> Position -> SrcSpan
FU.SrcSpan (Position -> Position
toCol0 Position
pos) (Position -> Position
toCol0 Position
pos)
     -- But store the aligned position in refactored so
     -- that the reprint algorithm can add the appropriate indentation
     a :: Annotation
a = Annotation
unitAnnotation { refactored :: Maybe Position
refactored = Position -> Maybe Position
forall a. a -> Maybe a
Just Position
pos, newNode :: Bool
newNode = Bool
True }
     dstE' :: Expression Annotation
dstE' = Expression A1 -> Expression Annotation
forall (b :: * -> *) a. Functor b => b (Analysis a) -> b a
FA.stripAnalysis Expression A1
dstE
     srcE' :: Expression Annotation
srcE' = Expression A1 -> Expression Annotation
forall (b :: * -> *) a. Functor b => b (Analysis a) -> b a
FA.stripAnalysis Expression A1
srcE

perBlockRmEquiv :: F.Block A1 -> StateT RmEqState EquivalenceRefactoring (F.Block A1)
perBlockRmEquiv :: Block A1 -> StateT RmEqState EquivalenceRefactoring (Block A1)
perBlockRmEquiv = (Statement A1
 -> StateT RmEqState EquivalenceRefactoring (Statement A1))
-> Block A1 -> StateT RmEqState EquivalenceRefactoring (Block A1)
forall (m :: * -> *) from to.
(Monad m, Applicative m, Biplate from to) =>
(to -> m to) -> from -> m from
transformBiM Statement A1
-> StateT RmEqState EquivalenceRefactoring (Statement A1)
perStatementRmEquiv

perStatementRmEquiv
  :: F.Statement A1
  -> StateT RmEqState EquivalenceRefactoring (F.Statement A1)
perStatementRmEquiv :: Statement A1
-> StateT RmEqState EquivalenceRefactoring (Statement A1)
perStatementRmEquiv (F.StEquivalence A1
a sp :: SrcSpan
sp@(FU.SrcSpan Position
spL Position
_) AList (AList Expression) A1
equivs) = do
    ([[Expression A1]]
ess, Int
n) <- StateT RmEqState EquivalenceRefactoring RmEqState
forall s (m :: * -> *). MonadState s m => m s
get

    let spL' :: SrcSpan
spL' = Position -> Position -> SrcSpan
FU.SrcSpan Position
spL Position
spL
    SrcSpan -> Text -> StateT RmEqState EquivalenceRefactoring ()
forall a.
Spanned a =>
a -> Text -> StateT RmEqState EquivalenceRefactoring ()
forall e w (m :: * -> *) a.
(MonadLogger e w m, Spanned a) =>
a -> Text -> m ()
logInfo' SrcSpan
spL' (Text -> StateT RmEqState EquivalenceRefactoring ())
-> Text -> StateT RmEqState EquivalenceRefactoring ()
forall a b. (a -> b) -> a -> b
$ Text
"removed equivalence"

    RmEqState -> StateT RmEqState EquivalenceRefactoring ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put ((((AList Expression A1 -> [Expression A1])
-> [AList Expression A1] -> [[Expression A1]]
forall a b. (a -> b) -> [a] -> [b]
map AList Expression A1 -> [Expression A1]
forall (t :: * -> *) a. AList t a -> [t a]
F.aStrip) ([AList Expression A1] -> [[Expression A1]])
-> (AList (AList Expression) A1 -> [AList Expression A1])
-> AList (AList Expression) A1
-> [[Expression A1]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AList (AList Expression) A1 -> [AList Expression A1]
forall (t :: * -> *) a. AList t a -> [t a]
F.aStrip (AList (AList Expression) A1 -> [[Expression A1]])
-> AList (AList Expression) A1 -> [[Expression A1]]
forall a b. (a -> b) -> a -> b
$ AList (AList Expression) A1
equivs) [[Expression A1]] -> [[Expression A1]] -> [[Expression A1]]
forall a. [a] -> [a] -> [a]
++ [[Expression A1]]
ess, Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
    let a' :: A1
a' = (Annotation -> Annotation) -> A1 -> A1
forall a. (a -> a) -> Analysis a -> Analysis a
onPrev (\Annotation
ap -> Annotation
ap {refactored :: Maybe Position
refactored = Position -> Maybe Position
forall a. a -> Maybe a
Just Position
spL, deleteNode :: Bool
deleteNode = Bool
True}) A1
a
    Statement A1
-> StateT RmEqState EquivalenceRefactoring (Statement A1)
forall a. a -> StateT RmEqState EquivalenceRefactoring a
forall (m :: * -> *) a. Monad m => a -> m a
return (A1 -> SrcSpan -> AList (AList Expression) A1 -> Statement A1
forall a. a -> SrcSpan -> AList (AList Expression) a -> Statement a
F.StEquivalence A1
a' (SrcSpan -> SrcSpan
deleteLine SrcSpan
sp) AList (AList Expression) A1
equivs)
perStatementRmEquiv Statement A1
f = Statement A1
-> StateT RmEqState EquivalenceRefactoring (Statement A1)
forall a. a -> StateT RmEqState EquivalenceRefactoring a
forall (m :: * -> *) a. Monad m => a -> m a
return Statement A1
f

-- 'equivalents e' returns a list of variables/memory cells
-- that have been equivalenced with "e".
equivalentsToExpr
  :: F.Expression A1
  -> StateT RmEqState EquivalenceRefactoring [F.Expression A1]
equivalentsToExpr :: Expression A1
-> StateT RmEqState EquivalenceRefactoring [Expression A1]
equivalentsToExpr Expression A1
y = do
    ([[Expression A1]]
equivs, Int
_) <- StateT RmEqState EquivalenceRefactoring RmEqState
forall s (m :: * -> *). MonadState s m => m s
get
    [Expression A1]
-> StateT RmEqState EquivalenceRefactoring [Expression A1]
forall a. a -> StateT RmEqState EquivalenceRefactoring a
forall (m :: * -> *) a. Monad m => a -> m a
return (Expression A1 -> [[Expression A1]] -> [Expression A1]
forall {t}. Eq (AnnotationFree t) => t -> [[t]] -> [t]
inGroup Expression A1
y [[Expression A1]]
equivs)
  where
    inGroup :: t -> [[t]] -> [t]
inGroup t
_ [] = []
    inGroup t
x ([t]
xs:[[t]]
xss) =
        if t -> AnnotationFree t
forall t. t -> AnnotationFree t
AnnotationFree t
x AnnotationFree t -> [AnnotationFree t] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (t -> AnnotationFree t) -> [t] -> [AnnotationFree t]
forall a b. (a -> b) -> [a] -> [b]
map t -> AnnotationFree t
forall t. t -> AnnotationFree t
AnnotationFree [t]
xs
        then [t]
xs
        else t -> [[t]] -> [t]
inGroup t
x [[t]]
xss