{- |
Module      :  Camfort.Specification.Stencils.Annotation
Description :  Annotation with stencil information.
Copyright   :  (c) 2017, Dominic Orchard, Andrew Rice, Mistral Contrastin, Matthew Danish
License     :  Apache-2.0

Maintainer  :  dom.orchard@gmail.com
Stability   :  experimental

Defines the 'StencilAnnotation' datatype, which is used for annotating a
'ProgramFile' with stencil information.
-}

{-# LANGUAGE DeriveDataTypeable    #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}

module Camfort.Specification.Stencils.Annotation
  (
    StencilAnnotation
  , SA
  , mkStencilAnnotation
  -- ** Specification Annotation Helpers
  , getAstSpec
  , getParseSpec
  , getRegionSpec
  , getStencilBlock
  , giveAstSpec
  , giveParseSpec
  , giveRegionSpec
    -- ** Base Annotation
  , getBaseAnnotation
  , modifyBaseAnnotation
  ) where

import Data.Data (Data)

import qualified Language.Fortran.AST      as F
import qualified Language.Fortran.Analysis as FA

import qualified Camfort.Analysis.Annotations                as Ann
import           Camfort.Analysis.CommentAnnotator
import qualified Camfort.Specification.Stencils.Parser.Types as Gram
import qualified Camfort.Specification.Stencils.Syntax       as Syn

-- | Specification annotation.
data SpecAnnotation
  -- | Unprocessed syntax tree.
  = ParserSpec Gram.Specification
  -- | Region definition.
  | RegionDecl Syn.RegionDecl
  -- | Normalised AST specification.
  | ASTSpec Syn.SpecDecls
  deriving (SpecAnnotation -> SpecAnnotation -> Bool
(SpecAnnotation -> SpecAnnotation -> Bool)
-> (SpecAnnotation -> SpecAnnotation -> Bool) -> Eq SpecAnnotation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SpecAnnotation -> SpecAnnotation -> Bool
$c/= :: SpecAnnotation -> SpecAnnotation -> Bool
== :: SpecAnnotation -> SpecAnnotation -> Bool
$c== :: SpecAnnotation -> SpecAnnotation -> Bool
Eq, Int -> SpecAnnotation -> ShowS
[SpecAnnotation] -> ShowS
SpecAnnotation -> String
(Int -> SpecAnnotation -> ShowS)
-> (SpecAnnotation -> String)
-> ([SpecAnnotation] -> ShowS)
-> Show SpecAnnotation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SpecAnnotation] -> ShowS
$cshowList :: [SpecAnnotation] -> ShowS
show :: SpecAnnotation -> String
$cshow :: SpecAnnotation -> String
showsPrec :: Int -> SpecAnnotation -> ShowS
$cshowsPrec :: Int -> SpecAnnotation -> ShowS
Show, Typeable SpecAnnotation
DataType
Constr
Typeable SpecAnnotation
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> SpecAnnotation -> c SpecAnnotation)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c SpecAnnotation)
-> (SpecAnnotation -> Constr)
-> (SpecAnnotation -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c SpecAnnotation))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c SpecAnnotation))
-> ((forall b. Data b => b -> b)
    -> SpecAnnotation -> SpecAnnotation)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> SpecAnnotation -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> SpecAnnotation -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> SpecAnnotation -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> SpecAnnotation -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> SpecAnnotation -> m SpecAnnotation)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> SpecAnnotation -> m SpecAnnotation)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> SpecAnnotation -> m SpecAnnotation)
-> Data SpecAnnotation
SpecAnnotation -> DataType
SpecAnnotation -> Constr
(forall b. Data b => b -> b) -> SpecAnnotation -> SpecAnnotation
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SpecAnnotation -> c SpecAnnotation
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SpecAnnotation
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> SpecAnnotation -> u
forall u. (forall d. Data d => d -> u) -> SpecAnnotation -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SpecAnnotation -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SpecAnnotation -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SpecAnnotation -> m SpecAnnotation
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SpecAnnotation -> m SpecAnnotation
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SpecAnnotation
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SpecAnnotation -> c SpecAnnotation
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SpecAnnotation)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SpecAnnotation)
$cASTSpec :: Constr
$cRegionDecl :: Constr
$cParserSpec :: Constr
$tSpecAnnotation :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> SpecAnnotation -> m SpecAnnotation
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SpecAnnotation -> m SpecAnnotation
gmapMp :: (forall d. Data d => d -> m d)
-> SpecAnnotation -> m SpecAnnotation
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> SpecAnnotation -> m SpecAnnotation
gmapM :: (forall d. Data d => d -> m d)
-> SpecAnnotation -> m SpecAnnotation
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> SpecAnnotation -> m SpecAnnotation
gmapQi :: Int -> (forall d. Data d => d -> u) -> SpecAnnotation -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> SpecAnnotation -> u
gmapQ :: (forall d. Data d => d -> u) -> SpecAnnotation -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> SpecAnnotation -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SpecAnnotation -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> SpecAnnotation -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SpecAnnotation -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> SpecAnnotation -> r
gmapT :: (forall b. Data b => b -> b) -> SpecAnnotation -> SpecAnnotation
$cgmapT :: (forall b. Data b => b -> b) -> SpecAnnotation -> SpecAnnotation
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SpecAnnotation)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c SpecAnnotation)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c SpecAnnotation)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c SpecAnnotation)
dataTypeOf :: SpecAnnotation -> DataType
$cdataTypeOf :: SpecAnnotation -> DataType
toConstr :: SpecAnnotation -> Constr
$ctoConstr :: SpecAnnotation -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SpecAnnotation
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c SpecAnnotation
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SpecAnnotation -> c SpecAnnotation
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> SpecAnnotation -> c SpecAnnotation
$cp1Data :: Typeable SpecAnnotation
Data)

data StencilAnnotation a = StencilAnnotation  {
      StencilAnnotation a -> a
prevAnnotation :: a
      -- | Assocatated specification.
    , StencilAnnotation a -> Maybe SpecAnnotation
stencilSpec    :: Maybe SpecAnnotation
      -- | Associated assignment.
    , StencilAnnotation a
-> Maybe (Block (Analysis (StencilAnnotation a)))
stencilBlock   :: Maybe (F.Block (FA.Analysis (StencilAnnotation a)))
    } deriving (Int -> StencilAnnotation a -> ShowS
[StencilAnnotation a] -> ShowS
StencilAnnotation a -> String
(Int -> StencilAnnotation a -> ShowS)
-> (StencilAnnotation a -> String)
-> ([StencilAnnotation a] -> ShowS)
-> Show (StencilAnnotation a)
forall a. Show a => Int -> StencilAnnotation a -> ShowS
forall a. Show a => [StencilAnnotation a] -> ShowS
forall a. Show a => StencilAnnotation a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StencilAnnotation a] -> ShowS
$cshowList :: forall a. Show a => [StencilAnnotation a] -> ShowS
show :: StencilAnnotation a -> String
$cshow :: forall a. Show a => StencilAnnotation a -> String
showsPrec :: Int -> StencilAnnotation a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> StencilAnnotation a -> ShowS
Show, StencilAnnotation a -> StencilAnnotation a -> Bool
(StencilAnnotation a -> StencilAnnotation a -> Bool)
-> (StencilAnnotation a -> StencilAnnotation a -> Bool)
-> Eq (StencilAnnotation a)
forall a.
Eq a =>
StencilAnnotation a -> StencilAnnotation a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StencilAnnotation a -> StencilAnnotation a -> Bool
$c/= :: forall a.
Eq a =>
StencilAnnotation a -> StencilAnnotation a -> Bool
== :: StencilAnnotation a -> StencilAnnotation a -> Bool
$c== :: forall a.
Eq a =>
StencilAnnotation a -> StencilAnnotation a -> Bool
Eq, Typeable (StencilAnnotation a)
DataType
Constr
Typeable (StencilAnnotation a)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> StencilAnnotation a
    -> c (StencilAnnotation a))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (StencilAnnotation a))
-> (StencilAnnotation a -> Constr)
-> (StencilAnnotation a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (StencilAnnotation a)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (StencilAnnotation a)))
-> ((forall b. Data b => b -> b)
    -> StencilAnnotation a -> StencilAnnotation a)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> StencilAnnotation a -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> StencilAnnotation a -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> StencilAnnotation a -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> StencilAnnotation a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> StencilAnnotation a -> m (StencilAnnotation a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> StencilAnnotation a -> m (StencilAnnotation a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> StencilAnnotation a -> m (StencilAnnotation a))
-> Data (StencilAnnotation a)
StencilAnnotation a -> DataType
StencilAnnotation a -> Constr
(forall d. Data d => c (t d)) -> Maybe (c (StencilAnnotation a))
(forall b. Data b => b -> b)
-> StencilAnnotation a -> StencilAnnotation a
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> StencilAnnotation a
-> c (StencilAnnotation a)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (StencilAnnotation a)
forall a. Data a => Typeable (StencilAnnotation a)
forall a. Data a => StencilAnnotation a -> DataType
forall a. Data a => StencilAnnotation a -> Constr
forall a.
Data a =>
(forall b. Data b => b -> b)
-> StencilAnnotation a -> StencilAnnotation a
forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> StencilAnnotation a -> u
forall a u.
Data a =>
(forall d. Data d => d -> u) -> StencilAnnotation a -> [u]
forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> StencilAnnotation a -> r
forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> StencilAnnotation a -> r
forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d)
-> StencilAnnotation a -> m (StencilAnnotation a)
forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> StencilAnnotation a -> m (StencilAnnotation a)
forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (StencilAnnotation a)
forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> StencilAnnotation a
-> c (StencilAnnotation a)
forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (StencilAnnotation a))
forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (StencilAnnotation a))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> StencilAnnotation a -> u
forall u.
(forall d. Data d => d -> u) -> StencilAnnotation a -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> StencilAnnotation a -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> StencilAnnotation a -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> StencilAnnotation a -> m (StencilAnnotation a)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> StencilAnnotation a -> m (StencilAnnotation a)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (StencilAnnotation a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> StencilAnnotation a
-> c (StencilAnnotation a)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (StencilAnnotation a))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (StencilAnnotation a))
$cStencilAnnotation :: Constr
$tStencilAnnotation :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> StencilAnnotation a -> m (StencilAnnotation a)
$cgmapMo :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> StencilAnnotation a -> m (StencilAnnotation a)
gmapMp :: (forall d. Data d => d -> m d)
-> StencilAnnotation a -> m (StencilAnnotation a)
$cgmapMp :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> StencilAnnotation a -> m (StencilAnnotation a)
gmapM :: (forall d. Data d => d -> m d)
-> StencilAnnotation a -> m (StencilAnnotation a)
$cgmapM :: forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d)
-> StencilAnnotation a -> m (StencilAnnotation a)
gmapQi :: Int -> (forall d. Data d => d -> u) -> StencilAnnotation a -> u
$cgmapQi :: forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> StencilAnnotation a -> u
gmapQ :: (forall d. Data d => d -> u) -> StencilAnnotation a -> [u]
$cgmapQ :: forall a u.
Data a =>
(forall d. Data d => d -> u) -> StencilAnnotation a -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> StencilAnnotation a -> r
$cgmapQr :: forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> StencilAnnotation a -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> StencilAnnotation a -> r
$cgmapQl :: forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> StencilAnnotation a -> r
gmapT :: (forall b. Data b => b -> b)
-> StencilAnnotation a -> StencilAnnotation a
$cgmapT :: forall a.
Data a =>
(forall b. Data b => b -> b)
-> StencilAnnotation a -> StencilAnnotation a
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (StencilAnnotation a))
$cdataCast2 :: forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (StencilAnnotation a))
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (StencilAnnotation a))
$cdataCast1 :: forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (StencilAnnotation a))
dataTypeOf :: StencilAnnotation a -> DataType
$cdataTypeOf :: forall a. Data a => StencilAnnotation a -> DataType
toConstr :: StencilAnnotation a -> Constr
$ctoConstr :: forall a. Data a => StencilAnnotation a -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (StencilAnnotation a)
$cgunfold :: forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (StencilAnnotation a)
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> StencilAnnotation a
-> c (StencilAnnotation a)
$cgfoldl :: forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> StencilAnnotation a
-> c (StencilAnnotation a)
$cp1Data :: forall a. Data a => Typeable (StencilAnnotation a)
Data)

-- | Create a new stencil annotation.
mkStencilAnnotation :: a -> StencilAnnotation a
mkStencilAnnotation :: a -> StencilAnnotation a
mkStencilAnnotation a
a = StencilAnnotation :: forall a.
a
-> Maybe SpecAnnotation
-> Maybe (Block (Analysis (StencilAnnotation a)))
-> StencilAnnotation a
StencilAnnotation
  { prevAnnotation :: a
prevAnnotation = a
a
  , stencilSpec :: Maybe SpecAnnotation
stencilSpec    = Maybe SpecAnnotation
forall a. Maybe a
Nothing
  , stencilBlock :: Maybe (Block (Analysis (StencilAnnotation a)))
stencilBlock   = Maybe (Block (Analysis (StencilAnnotation a)))
forall a. Maybe a
Nothing
  }

-- | Convenience name for common annotation type.
type SA = FA.Analysis (StencilAnnotation Ann.A)

modifyBaseAnnotation :: (Ann.A -> Ann.A) -> SA -> SA
modifyBaseAnnotation :: (A -> A) -> SA -> SA
modifyBaseAnnotation A -> A
f = (StencilAnnotation A -> StencilAnnotation A) -> SA -> SA
forall a. (a -> a) -> Analysis a -> Analysis a
Ann.onPrev (\StencilAnnotation A
ann -> StencilAnnotation A
ann { prevAnnotation :: A
prevAnnotation = A -> A
f (StencilAnnotation A -> A
forall a. StencilAnnotation a -> a
prevAnnotation StencilAnnotation A
ann) })

-- | Retrieve the underlying (base) annotation from a stencil annotation.
getBaseAnnotation :: SA -> Ann.A
getBaseAnnotation :: SA -> A
getBaseAnnotation = StencilAnnotation A -> A
forall a. StencilAnnotation a -> a
prevAnnotation (StencilAnnotation A -> A)
-> (SA -> StencilAnnotation A) -> SA -> A
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SA -> StencilAnnotation A
forall a. Analysis a -> a
FA.prevAnnotation

setSpec :: SpecAnnotation -> SA -> SA
setSpec :: SpecAnnotation -> SA -> SA
setSpec SpecAnnotation
s = (StencilAnnotation A -> StencilAnnotation A) -> SA -> SA
forall a. (a -> a) -> Analysis a -> Analysis a
Ann.onPrev (\StencilAnnotation A
ann -> StencilAnnotation A
ann { stencilSpec :: Maybe SpecAnnotation
stencilSpec = SpecAnnotation -> Maybe SpecAnnotation
forall a. a -> Maybe a
Just SpecAnnotation
s })

-- | Set the annotation's stencil specification to a parsed specification.
giveParseSpec :: Gram.Specification -> SA -> SA
giveParseSpec :: Specification -> SA -> SA
giveParseSpec Specification
spec = SpecAnnotation -> SA -> SA
setSpec (Specification -> SpecAnnotation
ParserSpec Specification
spec)

-- | Set the annotation's stencil specification to a region alias.
giveRegionSpec :: Syn.RegionDecl -> SA -> SA
giveRegionSpec :: RegionDecl -> SA -> SA
giveRegionSpec RegionDecl
spec = SpecAnnotation -> SA -> SA
setSpec (RegionDecl -> SpecAnnotation
RegionDecl RegionDecl
spec)

-- | Set the annotation's stencil specification to a normalized specification.
giveAstSpec :: Syn.SpecDecls -> SA -> SA
giveAstSpec :: SpecDecls -> SA -> SA
giveAstSpec SpecDecls
spec = SpecAnnotation -> SA -> SA
setSpec (SpecDecls -> SpecAnnotation
ASTSpec SpecDecls
spec)

getSA :: SA -> StencilAnnotation Ann.A
getSA :: SA -> StencilAnnotation A
getSA = SA -> StencilAnnotation A
forall a. Analysis a -> a
FA.prevAnnotation

getSpec :: SA -> Maybe SpecAnnotation
getSpec :: SA -> Maybe SpecAnnotation
getSpec = StencilAnnotation A -> Maybe SpecAnnotation
forall a. StencilAnnotation a -> Maybe SpecAnnotation
stencilSpec (StencilAnnotation A -> Maybe SpecAnnotation)
-> (SA -> StencilAnnotation A) -> SA -> Maybe SpecAnnotation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SA -> StencilAnnotation A
getSA

-- | Retrieve a parsed specification from an annotation.
getParseSpec :: SA -> Maybe Gram.Specification
getParseSpec :: SA -> Maybe Specification
getParseSpec SA
s = case SA -> Maybe SpecAnnotation
getSpec SA
s of
  (Just (ParserSpec Specification
spec)) -> Specification -> Maybe Specification
forall a. a -> Maybe a
Just Specification
spec
  Maybe SpecAnnotation
_                        -> Maybe Specification
forall a. Maybe a
Nothing

-- | Retrieve a region environment from an annotation.
getRegionSpec :: SA -> Maybe Syn.RegionDecl
getRegionSpec :: SA -> Maybe RegionDecl
getRegionSpec SA
s = case SA -> Maybe SpecAnnotation
getSpec SA
s of
  (Just (RegionDecl RegionDecl
renv)) -> RegionDecl -> Maybe RegionDecl
forall a. a -> Maybe a
Just RegionDecl
renv
  Maybe SpecAnnotation
_                        -> Maybe RegionDecl
forall a. Maybe a
Nothing

-- | Retrieve a normalized specification from an annotation.
getAstSpec :: SA -> Maybe Syn.SpecDecls
getAstSpec :: SA -> Maybe SpecDecls
getAstSpec SA
s = case SA -> Maybe SpecAnnotation
getSpec SA
s of
  (Just (ASTSpec SpecDecls
ast)) -> SpecDecls -> Maybe SpecDecls
forall a. a -> Maybe a
Just SpecDecls
ast
  Maybe SpecAnnotation
_                    -> Maybe SpecDecls
forall a. Maybe a
Nothing

getStencilBlock :: SA -> Maybe (F.Block SA)
getStencilBlock :: SA -> Maybe (Block SA)
getStencilBlock = StencilAnnotation A -> Maybe (Block SA)
forall a.
StencilAnnotation a
-> Maybe (Block (Analysis (StencilAnnotation a)))
stencilBlock (StencilAnnotation A -> Maybe (Block SA))
-> (SA -> StencilAnnotation A) -> SA -> Maybe (Block SA)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SA -> StencilAnnotation A
getSA

{- *** Routines for associating annotations to ASTs -}

-- Instances for embedding parsed specifications into the AST
instance ASTEmbeddable SA Gram.Specification where
  annotateWithAST :: SA -> Specification -> SA
annotateWithAST SA
ann Specification
ast =
    (StencilAnnotation A -> StencilAnnotation A) -> SA -> SA
forall a. (a -> a) -> Analysis a -> Analysis a
Ann.onPrev (\StencilAnnotation A
ann' -> StencilAnnotation A
ann' { stencilSpec :: Maybe SpecAnnotation
stencilSpec = SpecAnnotation -> Maybe SpecAnnotation
forall a. a -> Maybe a
Just (SpecAnnotation -> Maybe SpecAnnotation)
-> SpecAnnotation -> Maybe SpecAnnotation
forall a b. (a -> b) -> a -> b
$ Specification -> SpecAnnotation
ParserSpec Specification
ast }) SA
ann

instance Linkable SA where
  link :: SA -> Block SA -> SA
link SA
ann b :: Block SA
b@F.BlDo{} =
      (StencilAnnotation A -> StencilAnnotation A) -> SA -> SA
forall a. (a -> a) -> Analysis a -> Analysis a
Ann.onPrev (\StencilAnnotation A
ann' -> StencilAnnotation A
ann' { stencilBlock :: Maybe (Block SA)
stencilBlock = Block SA -> Maybe (Block SA)
forall a. a -> Maybe a
Just Block SA
b }) SA
ann
  link SA
ann (b :: Block SA
b@(F.BlStatement SA
_ SrcSpan
_ Maybe (Expression SA)
_ F.StExpressionAssign{})) =
      (StencilAnnotation A -> StencilAnnotation A) -> SA -> SA
forall a. (a -> a) -> Analysis a -> Analysis a
Ann.onPrev (\StencilAnnotation A
ann' -> StencilAnnotation A
ann' { stencilBlock :: Maybe (Block SA)
stencilBlock = Block SA -> Maybe (Block SA)
forall a. a -> Maybe a
Just Block SA
b }) SA
ann
  link   SA
ann Block SA
_ = SA
ann
  linkPU :: SA -> ProgramUnit SA -> SA
linkPU SA
ann ProgramUnit SA
_ = SA
ann