{-# 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
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
(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'
ProgramFile A1
pf''' <- TypeEnv
-> ProgramFile A1 -> EquivalenceRefactoring (ProgramFile A1)
refactoring TypeEnv
typeEnv ProgramFile A1
pf''
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
[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 [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]
else do
([[Expression A1]]
equivs, Int
n) <- StateT RmEqState EquivalenceRefactoring RmEqState
forall s (m :: * -> *). MonadState s m => m s
get
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
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"
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')
[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']
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
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
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']
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
sp :: SrcSpan
sp = Position -> Position -> SrcSpan
FU.SrcSpan (Position -> Position
toCol0 Position
pos) (Position -> Position
toCol0 Position
pos)
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
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