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

module Camfort.Transformation.DeadCode
  ( deadCode
  ) where

import Camfort.Analysis
import Camfort.Analysis.Annotations
import qualified Language.Fortran.Analysis.DataFlow as FAD
import qualified Language.Fortran.Analysis.Renaming as FAR
import qualified Language.Fortran.Analysis.BBlocks as FAB
import qualified Language.Fortran.AST as F
import qualified Language.Fortran.Util.Position as FU
import qualified Language.Fortran.Analysis as FA
import Camfort.Helpers.Syntax

import qualified Data.IntMap as IM
import qualified Data.Set as S
import Data.Generics.Uniplate.Operations
import Control.Monad (guard)
import Control.Monad.Trans.Writer (WriterT, runWriterT, tell)
import Data.Monoid (Any(..), (<>))
import Data.Void (Void)

type DeadCodeAnalysis = PureAnalysis Void Void


-- Eliminate dead code from a program, based on the fortran-src
-- live-variable analysis

-- Currently only strips out dead code through simple variable assignments
-- but not through array-subscript assignmernts
deadCode :: Bool -> F.ProgramFile A -> DeadCodeAnalysis (F.ProgramFile A)
deadCode :: Bool -> ProgramFile A -> DeadCodeAnalysis (ProgramFile A)
deadCode Bool
flag ProgramFile A
pf = do
  let
    -- initialise analysis
    pf' :: ProgramFile (Analysis A)
pf'   = ProgramFile (Analysis A) -> ProgramFile (Analysis A)
forall a.
Data a =>
ProgramFile (Analysis a) -> ProgramFile (Analysis a)
FAB.analyseBBlocks (ProgramFile (Analysis A) -> ProgramFile (Analysis A))
-> (ProgramFile A -> ProgramFile (Analysis A))
-> ProgramFile A
-> ProgramFile (Analysis A)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProgramFile (Analysis A) -> ProgramFile (Analysis A)
forall a.
Data a =>
ProgramFile (Analysis a) -> ProgramFile (Analysis a)
FAR.analyseRenames (ProgramFile (Analysis A) -> ProgramFile (Analysis A))
-> (ProgramFile A -> ProgramFile (Analysis A))
-> ProgramFile A
-> ProgramFile (Analysis A)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProgramFile A -> ProgramFile (Analysis A)
forall (b :: * -> *) a. Functor b => b a -> b (Analysis a)
FA.initAnalysis (ProgramFile A -> ProgramFile (Analysis A))
-> ProgramFile A -> ProgramFile (Analysis A)
forall a b. (a -> b) -> a -> b
$ ProgramFile A
pf
    -- get map of program unit ==> basic block graph
    bbm :: BBlockMap (Analysis A)
bbm   = ProgramFile (Analysis A) -> BBlockMap (Analysis A)
forall a.
Data a =>
ProgramFile (Analysis a) -> BBlockMap (Analysis a)
FAB.genBBlockMap ProgramFile (Analysis A)
pf'
    -- build the supergraph of global dependency
    sgr :: SuperBBGr (Analysis A)
sgr   = BBlockMap (Analysis A) -> SuperBBGr (Analysis A)
forall a.
Data a =>
BBlockMap (Analysis a) -> SuperBBGr (Analysis a)
FAB.genSuperBBGr BBlockMap (Analysis A)
bbm
    -- extract the supergraph itself
    gr :: BBGr (Analysis A)
gr    = SuperBBGr (Analysis A) -> BBGr (Analysis A)
forall a. SuperBBGr a -> BBGr a
FAB.superBBGrGraph SuperBBGr (Analysis A)
sgr
    -- live variables
    lva :: InOutMap (Set Name)
lva   = BBGr (Analysis A) -> InOutMap (Set Name)
forall a. Data a => BBGr (Analysis a) -> InOutMap (Set Name)
FAD.liveVariableAnalysis BBGr (Analysis A)
gr

  ProgramFile (Analysis A)
_ <- Bool
-> InOutMap (Set Name)
-> ProgramFile (Analysis A)
-> DeadCodeAnalysis (ProgramFile (Analysis A))
deadCode' Bool
flag InOutMap (Set Name)
lva ProgramFile (Analysis A)
pf'
  ProgramFile A -> DeadCodeAnalysis (ProgramFile A)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ProgramFile A -> DeadCodeAnalysis (ProgramFile A))
-> ProgramFile A -> DeadCodeAnalysis (ProgramFile A)
forall a b. (a -> b) -> a -> b
$ (Analysis A -> A) -> ProgramFile (Analysis A) -> ProgramFile A
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Analysis A -> A
forall a. Analysis a -> a
FA.prevAnnotation ProgramFile (Analysis A)
pf'

deadCode' :: Bool -> FAD.InOutMap (S.Set F.Name)
                  -> F.ProgramFile (FA.Analysis A)
                  -> DeadCodeAnalysis (F.ProgramFile (FA.Analysis A))
deadCode' :: Bool
-> InOutMap (Set Name)
-> ProgramFile (Analysis A)
-> DeadCodeAnalysis (ProgramFile (Analysis A))
deadCode' Bool
flag InOutMap (Set Name)
lva ProgramFile (Analysis A)
pf = do
  (ProgramFile (Analysis A)
pf', Any Bool
eliminated) <- WriterT Any DeadCodeAnalysis (ProgramFile (Analysis A))
-> DeadCodeAnalysis (ProgramFile (Analysis A), Any)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT (WriterT Any DeadCodeAnalysis (ProgramFile (Analysis A))
 -> DeadCodeAnalysis (ProgramFile (Analysis A), Any))
-> WriterT Any DeadCodeAnalysis (ProgramFile (Analysis A))
-> DeadCodeAnalysis (ProgramFile (Analysis A), Any)
forall a b. (a -> b) -> a -> b
$ (Statement (Analysis A)
 -> WriterT Any DeadCodeAnalysis (Statement (Analysis A)))
-> ProgramFile (Analysis A)
-> WriterT Any DeadCodeAnalysis (ProgramFile (Analysis A))
forall (m :: * -> *) from to.
(Monad m, Applicative m, Biplate from to) =>
(to -> m to) -> from -> m from
transformBiM (Bool
-> InOutMap (Set Name)
-> Statement (Analysis A)
-> WriterT Any DeadCodeAnalysis (Statement (Analysis A))
perStmt Bool
flag InOutMap (Set Name)
lva) ProgramFile (Analysis A)
pf
  if Bool
eliminated
    then Bool
-> InOutMap (Set Name)
-> ProgramFile (Analysis A)
-> DeadCodeAnalysis (ProgramFile (Analysis A))
deadCode' Bool
flag InOutMap (Set Name)
lva ProgramFile (Analysis A)
pf'
    else ProgramFile (Analysis A)
-> DeadCodeAnalysis (ProgramFile (Analysis A))
forall (m :: * -> *) a. Monad m => a -> m a
return ProgramFile (Analysis A)
pf'

-- Core of the transformation happens here on assignment statements
perStmt :: Bool
        -> FAD.InOutMap (S.Set F.Name)
        -> F.Statement (FA.Analysis A) -> WriterT Any DeadCodeAnalysis (F.Statement (FA.Analysis A))
perStmt :: Bool
-> InOutMap (Set Name)
-> Statement (Analysis A)
-> WriterT Any DeadCodeAnalysis (Statement (Analysis A))
perStmt Bool
flag InOutMap (Set Name)
lva x :: Statement (Analysis A)
x@(F.StExpressionAssign Analysis A
a sp :: SrcSpan
sp@(FU.SrcSpan Position
s1 Position
_) Expression (Analysis A)
e1 Expression (Analysis A)
e2)
     | A -> Bool
pRefactored (Analysis A -> A
forall a. Analysis a -> a
FA.prevAnnotation Analysis A
a) Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool
flag =
       let output :: WriterT Any DeadCodeAnalysis (Statement (Analysis A))
output = do
             Statement (Analysis A) -> Text -> WriterT Any DeadCodeAnalysis ()
forall e w (m :: * -> *) a.
(MonadLogger e w m, Spanned a) =>
a -> Text -> m ()
logInfo' Statement (Analysis A)
x (Text -> WriterT Any DeadCodeAnalysis ())
-> Text -> WriterT Any DeadCodeAnalysis ()
forall a b. (a -> b) -> a -> b
$ Text
"o" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Name -> Text
forall a. Describe a => a -> Text
describe (Position -> Name
forall a. Show a => a -> Name
show Position
s1) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": removed dead code"
             Any -> WriterT Any DeadCodeAnalysis ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
tell (Bool -> Any
Any Bool
True)
             Statement (Analysis A)
-> WriterT Any DeadCodeAnalysis (Statement (Analysis A))
forall (m :: * -> *) a. Monad m => a -> m a
return (Statement (Analysis A)
 -> WriterT Any DeadCodeAnalysis (Statement (Analysis A)))
-> Statement (Analysis A)
-> WriterT Any DeadCodeAnalysis (Statement (Analysis A))
forall a b. (a -> b) -> a -> b
$ Analysis A
-> SrcSpan
-> Expression (Analysis A)
-> Expression (Analysis A)
-> Statement (Analysis A)
forall a.
a -> SrcSpan -> Expression a -> Expression a -> Statement a
F.StExpressionAssign Analysis A
a' (SrcSpan -> SrcSpan
dropLine SrcSpan
sp) Expression (Analysis A)
e1 Expression (Analysis A)
e2
               where a' :: Analysis A
a' = (A -> A) -> Analysis A -> Analysis A
forall a. (a -> a) -> Analysis a -> Analysis a
onPrev (\A
ap -> A
ap {refactored :: Maybe Position
refactored = Position -> Maybe Position
forall a. a -> Maybe a
Just Position
s1}) Analysis A
a
                    -- Set annotation to mark statement for elimination in
                    -- the reprinter
       in WriterT Any DeadCodeAnalysis (Statement (Analysis A))
-> (() -> WriterT Any DeadCodeAnalysis (Statement (Analysis A)))
-> Maybe ()
-> WriterT Any DeadCodeAnalysis (Statement (Analysis A))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Statement (Analysis A)
-> WriterT Any DeadCodeAnalysis (Statement (Analysis A))
forall (m :: * -> *) a. Monad m => a -> m a
return Statement (Analysis A)
x) (WriterT Any DeadCodeAnalysis (Statement (Analysis A))
-> () -> WriterT Any DeadCodeAnalysis (Statement (Analysis A))
forall a b. a -> b -> a
const WriterT Any DeadCodeAnalysis (Statement (Analysis A))
output) (Maybe () -> WriterT Any DeadCodeAnalysis (Statement (Analysis A)))
-> Maybe ()
-> WriterT Any DeadCodeAnalysis (Statement (Analysis A))
forall a b. (a -> b) -> a -> b
$ do
         Int
label <- Analysis A -> Maybe Int
forall a. Analysis a -> Maybe Int
FA.insLabel Analysis A
a
         (Set Name
_, Set Name
out) <- Int -> InOutMap (Set Name) -> Maybe (Set Name, Set Name)
forall a. Int -> IntMap a -> Maybe a
IM.lookup Int
label InOutMap (Set Name)
lva
         Name
assignedName <- Expression (Analysis A) -> Maybe Name
forall a. Expression a -> Maybe Name
extractVariable Expression (Analysis A)
e1
         Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not (Name
assignedName Name -> Set Name -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set Name
out))
perStmt Bool
_ InOutMap (Set Name)
_ Statement (Analysis A)
x = Statement (Analysis A)
-> WriterT Any DeadCodeAnalysis (Statement (Analysis A))
forall (m :: * -> *) a. Monad m => a -> m a
return Statement (Analysis A)
x