{-
   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 #-}

{-|

Provides live-variable analysis for Fortran code. One of the simpler analyses in the suite (a good
starting point for any new developers). This demonstrates the use of the "zipper" format, and 
various helpers from 'Analysis.Syntax' and 'Traverse'. 

'lva' is the top-level definition here.

-}
module Camfort.Analysis.LVA where
    
import Data.Data
import Data.List

import Data.Generics.Zipper
import Data.Generics.Uniplate.Operations

import Language.Fortran

import Camfort.Analysis.Annotations
import Camfort.Analysis.Syntax
import Camfort.Transformation.Syntax
import Camfort.Analysis.IntermediateReps
import Camfort.Traverse


{-| live-variable analysis on a program -}
-- Recall: type Program a = [ProgUnit a]
lva :: Program Annotation -> Program Annotation
lva x = map lvaOnUnit x
        
{-| live-variable analysis at the level of a unit, not whole-program,iterates @lva1@ until a fixed-point is reached -}
lvaOnUnit :: ProgUnit Annotation -> ProgUnit Annotation
lvaOnUnit x = let y = fromZipper . (everywhere lva1) . toZipper $ numberStmts . (transformBi reassociate) $ x
              in if (y == x) then y else lvaOnUnit y

{-| Single iteration of live-variable analysis over the zipper for an AST -}
lva1 :: Zipper (ProgUnit Annotation) -> Zipper (ProgUnit Annotation)

lva1 z = case (getHole z)::(Maybe (Fortran Annotation)) of
            Just f ->  let anns =  map tag ((successors z)::[Fortran Annotation]) -- annotations of the successors
                           liveOut = nub $ concat $ map (fst . lives) anns
                           killV = kill f
                           genV  = gen f
                           liveIn = nub $ union genV (liveOut \\ killV)
                           annotation = (tag f) { lives = (liveIn, liveOut), successorStmts = map number anns }
                       in setHole (refill f annotation) z
            Nothing -> z

{-| Variables killed by the current statement -}
kill :: Fortran Annotation -> [Access]
kill (Assg _ _ e1 _) = killForLhsVar e1 
                         where
                           {-| variable killed by expressions on the left-hand side -}
                           killForLhsVar :: Expr Annotation -> [Access]
                           killForLhsVar (Var a p xes) = map (\((VarName _ v), _) -> VarA v) xes
                           killForLhsVar _            = []
kill t = concatMap accesses (lhsExpr t)

{-| Variables generated (made live) by the current statement -}
gen :: Fortran Annotation -> [Access]
gen t@(Assg _ _ e1 e2) = (concatMap accesses (rhsExpr t)) ++ (genForLhsVar e1)
                          where
                            {-| variables generated on the left-hand side -}
                            genForLhsVar :: Expr Annotation -> [Access]                                 
                            genForLhsVar t@ (Var _ _  xes) = concatMap (\(_, es) -> accesses es) xes
                            genForLhsVar _            = []
gen t = concatMap accesses (rhsExpr t)  




          







{-
 successorAnnotations :: Zipper (ProgUnit Annotation) -> [Annotation]
 successorAnnotations x = goRight x ++ (case (up x) of
                                          Just ux -> case (getHole ux)::(Maybe (Fortran Annotation)) of
                                                       Just f -> map tag (successors f) ++ (goRight ux)
                                                       Nothing -> (goRight ux)
                                          Nothing -> []) 
                           where goRight :: Zipper (ProgUnit Annotation) -> [Annotation]
                                 goRight z = (case (getHole z)::(Maybe (Fortran Annotation)) of 
                                                Just f -> [tag f]
                                                Nothing -> []) ++
                                             (case (right z) of
                                                Just rz -> goRight rz
                                                Nothing -> [])
               
                 -}