-- |
-- Analyse variables/function names and produce unique names that can
-- be used to replace the original names while maintaining program
-- equivalence (a.k.a. alpha-conversion). The advantage of the unique
-- names is that scoping issues can be ignored when doing further
-- analysis.

module Language.Fortran.Analysis.Renaming
  ( analyseRenames, analyseRenamesWithModuleMap, rename, unrename, ModuleMap )
where

import Language.Fortran.AST hiding (fromList)
import Language.Fortran.Intrinsics
import Language.Fortran.Analysis
import Language.Fortran.Version

import Prelude hiding (lookup)
import Data.Maybe (mapMaybe, fromMaybe)
import qualified Data.List as L
import Data.Map (insert, empty, lookup, Map)
import qualified Data.Map.Strict as M
import Control.Monad.State.Strict
import Data.Generics.Uniplate.Data
import Data.Data
import Data.Functor.Identity (Identity)

--------------------------------------------------

type ModuleMap     = Map ProgramUnitName ModEnv

type Renamer a     = State RenameState a -- the monad.
data RenameState   = RenameState { RenameState -> FortranVersion
langVersion :: FortranVersion
                                 , RenameState -> IntrinsicsTable
intrinsics  :: IntrinsicsTable
                                 , RenameState -> [String]
scopeStack  :: [String]
                                 , RenameState -> [Int]
uniqNums    :: [Int]
                                 , RenameState -> [ModEnv]
environ     :: [ModEnv]
                                 , RenameState -> ModuleMap
moduleMap   :: ModuleMap }
  deriving (Int -> RenameState -> ShowS
[RenameState] -> ShowS
RenameState -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RenameState] -> ShowS
$cshowList :: [RenameState] -> ShowS
show :: RenameState -> String
$cshow :: RenameState -> String
showsPrec :: Int -> RenameState -> ShowS
$cshowsPrec :: Int -> RenameState -> ShowS
Show, RenameState -> RenameState -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RenameState -> RenameState -> Bool
$c/= :: RenameState -> RenameState -> Bool
== :: RenameState -> RenameState -> Bool
$c== :: RenameState -> RenameState -> Bool
Eq)
type RenamerFunc t = t -> Renamer t

--------------------------------------------------
-- Main interface functions.

-- | Annotate unique names for variable and function declarations and uses.
analyseRenames :: Data a => ProgramFile (Analysis a) -> ProgramFile (Analysis a)
analyseRenames :: forall a.
Data a =>
ProgramFile (Analysis a) -> ProgramFile (Analysis a)
analyseRenames (ProgramFile MetaInfo
mi [ProgramUnit (Analysis a)]
pus) = forall a.
Data a =>
ProgramFile (Analysis a) -> ProgramFile (Analysis a)
cleanupUseRenames forall a b. (a -> b) -> a -> b
$ forall a. MetaInfo -> [ProgramUnit a] -> ProgramFile a
ProgramFile MetaInfo
mi [ProgramUnit (Analysis a)]
pus'
  where
    (Just [ProgramUnit (Analysis a)]
pus', RenameState
_) = forall a b. State a b -> a -> (b, a)
runRenamer (forall a. Data a => RenamerFunc (Maybe [ProgramUnit (Analysis a)])
renameSubPUs (forall a. a -> Maybe a
Just [ProgramUnit (Analysis a)]
pus)) (FortranVersion -> RenameState
renameState0 (MetaInfo -> FortranVersion
miVersion MetaInfo
mi))

-- | Annotate unique names for variable and function declarations and uses. With external module map.
analyseRenamesWithModuleMap :: Data a => ModuleMap -> ProgramFile (Analysis a) -> ProgramFile (Analysis a)
analyseRenamesWithModuleMap :: forall a.
Data a =>
ModuleMap -> ProgramFile (Analysis a) -> ProgramFile (Analysis a)
analyseRenamesWithModuleMap ModuleMap
mmap (ProgramFile MetaInfo
mi [ProgramUnit (Analysis a)]
pus) = forall a.
Data a =>
ProgramFile (Analysis a) -> ProgramFile (Analysis a)
cleanupUseRenames forall a b. (a -> b) -> a -> b
$ forall a. MetaInfo -> [ProgramUnit a] -> ProgramFile a
ProgramFile MetaInfo
mi [ProgramUnit (Analysis a)]
pus'
  where
    (Just [ProgramUnit (Analysis a)]
pus', RenameState
_) = forall a b. State a b -> a -> (b, a)
runRenamer (forall a. Data a => RenamerFunc (Maybe [ProgramUnit (Analysis a)])
renameSubPUs (forall a. a -> Maybe a
Just [ProgramUnit (Analysis a)]
pus)) (FortranVersion -> RenameState
renameState0 (MetaInfo -> FortranVersion
miVersion MetaInfo
mi)) { moduleMap :: ModuleMap
moduleMap = ModuleMap
mmap }

-- | Take the unique name annotations and substitute them into the actual AST.
rename :: Data a => ProgramFile (Analysis a) -> ProgramFile (Analysis a)
rename :: forall a.
Data a =>
ProgramFile (Analysis a) -> ProgramFile (Analysis a)
rename ProgramFile (Analysis a)
pf = forall a.
Data a =>
(ProgramUnit a -> ProgramUnit a) -> ProgramFile a -> ProgramFile a
trPU forall a.
Data a =>
ProgramUnit (Analysis a) -> ProgramUnit (Analysis a)
fPU (forall a.
Data a =>
(Expression a -> Expression a) -> ProgramFile a -> ProgramFile a
trE forall a.
Data a =>
Expression (Analysis a) -> Expression (Analysis a)
fE ProgramFile (Analysis a)
pf)
  where
    trE :: Data a => (Expression a -> Expression a) -> ProgramFile a -> ProgramFile a
    trE :: forall a.
Data a =>
(Expression a -> Expression a) -> ProgramFile a -> ProgramFile a
trE = forall from to. Biplate from to => (to -> to) -> from -> from
transformBi
    fE :: Data a => Expression (Analysis a) -> Expression (Analysis a)
    fE :: forall a.
Data a =>
Expression (Analysis a) -> Expression (Analysis a)
fE (ExpValue Analysis a
a SrcSpan
s (ValVariable String
v))  = forall a. a -> SrcSpan -> Value a -> Expression a
ExpValue Analysis a
a SrcSpan
s forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. String -> Value a
ValVariable forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe String
v (forall a. Analysis a -> Maybe String
uniqueName Analysis a
a)
    fE (ExpValue Analysis a
a SrcSpan
s (ValIntrinsic String
v)) = forall a. a -> SrcSpan -> Value a -> Expression a
ExpValue Analysis a
a SrcSpan
s forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. String -> Value a
ValIntrinsic forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe String
v (forall a. Analysis a -> Maybe String
uniqueName Analysis a
a)
    fE Expression (Analysis a)
x                               = Expression (Analysis a)
x

    trPU :: Data a => (ProgramUnit a -> ProgramUnit a) -> ProgramFile a -> ProgramFile a
    trPU :: forall a.
Data a =>
(ProgramUnit a -> ProgramUnit a) -> ProgramFile a -> ProgramFile a
trPU = forall from to. Biplate from to => (to -> to) -> from -> from
transformBi
    fPU :: Data a => ProgramUnit (Analysis a) -> ProgramUnit (Analysis a)
    fPU :: forall a.
Data a =>
ProgramUnit (Analysis a) -> ProgramUnit (Analysis a)
fPU (PUFunction Analysis a
a SrcSpan
s Maybe (TypeSpec (Analysis a))
ty PrefixSuffix (Analysis a)
r String
n Maybe (AList Expression (Analysis a))
args Maybe (Expression (Analysis a))
res [Block (Analysis a)]
b Maybe [ProgramUnit (Analysis a)]
subs) =
      forall a.
a
-> SrcSpan
-> Maybe (TypeSpec a)
-> PrefixSuffix a
-> String
-> Maybe (AList Expression a)
-> Maybe (Expression a)
-> [Block a]
-> Maybe [ProgramUnit a]
-> ProgramUnit a
PUFunction Analysis a
a SrcSpan
s Maybe (TypeSpec (Analysis a))
ty PrefixSuffix (Analysis a)
r (forall a. a -> Maybe a -> a
fromMaybe String
n (forall a. Analysis a -> Maybe String
uniqueName Analysis a
a)) Maybe (AList Expression (Analysis a))
args Maybe (Expression (Analysis a))
res [Block (Analysis a)]
b Maybe [ProgramUnit (Analysis a)]
subs
    fPU (PUSubroutine Analysis a
a SrcSpan
s PrefixSuffix (Analysis a)
r String
n Maybe (AList Expression (Analysis a))
args [Block (Analysis a)]
b Maybe [ProgramUnit (Analysis a)]
subs) =
      forall a.
a
-> SrcSpan
-> PrefixSuffix a
-> String
-> Maybe (AList Expression a)
-> [Block a]
-> Maybe [ProgramUnit a]
-> ProgramUnit a
PUSubroutine Analysis a
a SrcSpan
s PrefixSuffix (Analysis a)
r (forall a. a -> Maybe a -> a
fromMaybe String
n (forall a. Analysis a -> Maybe String
uniqueName Analysis a
a)) Maybe (AList Expression (Analysis a))
args [Block (Analysis a)]
b Maybe [ProgramUnit (Analysis a)]
subs
    fPU ProgramUnit (Analysis a)
x = ProgramUnit (Analysis a)
x

-- | Take a renamed program and undo the renames.
unrename :: Data a => ProgramFile (Analysis a) -> ProgramFile (Analysis a)
unrename :: forall a.
Data a =>
ProgramFile (Analysis a) -> ProgramFile (Analysis a)
unrename = forall a.
Data a =>
(ProgramUnit (Analysis a) -> ProgramUnit (Analysis a))
-> ProgramFile (Analysis a) -> ProgramFile (Analysis a)
trPU forall a.
Data a =>
ProgramUnit (Analysis a) -> ProgramUnit (Analysis a)
fPU forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
Data a =>
(Expression (Analysis a) -> Expression (Analysis a))
-> ProgramFile (Analysis a) -> ProgramFile (Analysis a)
trE forall a.
Data a =>
Expression (Analysis a) -> Expression (Analysis a)
fE
  where
    trE :: Data a => (Expression (Analysis a) -> Expression (Analysis a)) -> ProgramFile (Analysis a) -> ProgramFile (Analysis a)
    trE :: forall a.
Data a =>
(Expression (Analysis a) -> Expression (Analysis a))
-> ProgramFile (Analysis a) -> ProgramFile (Analysis a)
trE = forall from to. Biplate from to => (to -> to) -> from -> from
transformBi
    fE :: Data a => Expression (Analysis a) -> Expression (Analysis a)
    fE :: forall a.
Data a =>
Expression (Analysis a) -> Expression (Analysis a)
fE e :: Expression (Analysis a)
e@(ExpValue Analysis a
a SrcSpan
s (ValVariable String
_))  = forall a. a -> SrcSpan -> Value a -> Expression a
ExpValue Analysis a
a SrcSpan
s (forall a. String -> Value a
ValVariable (forall a. Expression (Analysis a) -> String
srcName Expression (Analysis a)
e))
    fE e :: Expression (Analysis a)
e@(ExpValue Analysis a
a SrcSpan
s (ValIntrinsic String
_)) = forall a. a -> SrcSpan -> Value a -> Expression a
ExpValue Analysis a
a SrcSpan
s (forall a. String -> Value a
ValIntrinsic (forall a. Expression (Analysis a) -> String
srcName Expression (Analysis a)
e))
    fE Expression (Analysis a)
e                                 = Expression (Analysis a)
e

    trPU :: Data a => (ProgramUnit (Analysis a) -> ProgramUnit (Analysis a)) -> ProgramFile (Analysis a) -> ProgramFile (Analysis a)
    trPU :: forall a.
Data a =>
(ProgramUnit (Analysis a) -> ProgramUnit (Analysis a))
-> ProgramFile (Analysis a) -> ProgramFile (Analysis a)
trPU = forall from to. Biplate from to => (to -> to) -> from -> from
transformBi
    fPU :: Data a => ProgramUnit (Analysis a) -> ProgramUnit (Analysis a)
    fPU :: forall a.
Data a =>
ProgramUnit (Analysis a) -> ProgramUnit (Analysis a)
fPU (PUFunction Analysis a
a SrcSpan
s Maybe (TypeSpec (Analysis a))
ty PrefixSuffix (Analysis a)
r String
_ Maybe (AList Expression (Analysis a))
args Maybe (Expression (Analysis a))
res [Block (Analysis a)]
b Maybe [ProgramUnit (Analysis a)]
subs)
      | Just String
srcN <- forall a. Analysis a -> Maybe String
sourceName Analysis a
a = forall a.
a
-> SrcSpan
-> Maybe (TypeSpec a)
-> PrefixSuffix a
-> String
-> Maybe (AList Expression a)
-> Maybe (Expression a)
-> [Block a]
-> Maybe [ProgramUnit a]
-> ProgramUnit a
PUFunction Analysis a
a SrcSpan
s Maybe (TypeSpec (Analysis a))
ty PrefixSuffix (Analysis a)
r String
srcN Maybe (AList Expression (Analysis a))
args Maybe (Expression (Analysis a))
res [Block (Analysis a)]
b Maybe [ProgramUnit (Analysis a)]
subs
    fPU (PUSubroutine Analysis a
a SrcSpan
s PrefixSuffix (Analysis a)
r String
_ Maybe (AList Expression (Analysis a))
args [Block (Analysis a)]
b Maybe [ProgramUnit (Analysis a)]
subs)
      | Just String
srcN <- forall a. Analysis a -> Maybe String
sourceName Analysis a
a = forall a.
a
-> SrcSpan
-> PrefixSuffix a
-> String
-> Maybe (AList Expression a)
-> [Block a]
-> Maybe [ProgramUnit a]
-> ProgramUnit a
PUSubroutine Analysis a
a SrcSpan
s PrefixSuffix (Analysis a)
r String
srcN Maybe (AList Expression (Analysis a))
args [Block (Analysis a)]
b Maybe [ProgramUnit (Analysis a)]
subs
    fPU           ProgramUnit (Analysis a)
pu              = ProgramUnit (Analysis a)
pu

--------------------------------------------------
-- Renaming transformations for pieces of the AST. Uses a language of
-- monadic combinators defined below.

programUnit :: Data a => RenamerFunc (ProgramUnit (Analysis a))
programUnit :: forall a. Data a => RenamerFunc (ProgramUnit (Analysis a))
programUnit (PUModule Analysis a
a SrcSpan
s String
name [Block (Analysis a)]
blocks Maybe [ProgramUnit (Analysis a)]
m_contains) = do
  ModEnv
env0        <- forall a. Data a => [Block (Analysis a)] -> Renamer ModEnv
initialEnv [Block (Analysis a)]
blocks
  String -> ModEnv -> Renamer ()
pushScope String
name ModEnv
env0
  [Block (Analysis a)]
blocks1     <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a (f :: * -> *).
(Data a, Data (f (Analysis a))) =>
RenamerFunc (f (Analysis a))
renameModDecls [Block (Analysis a)]
blocks  -- handle declarations
  [Block (Analysis a)]
blocks2     <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a. Data a => RenamerFunc (Block (Analysis a))
renameUseSt [Block (Analysis a)]
blocks1    -- handle use statements
  Maybe [ProgramUnit (Analysis a)]
m_contains' <- forall a. Data a => RenamerFunc (Maybe [ProgramUnit (Analysis a)])
renameSubPUs Maybe [ProgramUnit (Analysis a)]
m_contains     -- handle contained program units
  [Block (Analysis a)]
blocks3     <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a. Data a => RenamerFunc (Block (Analysis a))
renameBlock [Block (Analysis a)]
blocks2    -- process all uses of functions/subroutine names
  ModEnv
env         <- Renamer ModEnv
getEnv
  String -> ModEnv -> Renamer ()
addModEnv String
name ModEnv
env                         -- save the module environment
  let a' :: Analysis a
a'      = Analysis a
a { moduleEnv :: Maybe ModEnv
moduleEnv = forall a. a -> Maybe a
Just ModEnv
env }   -- also annotate it on the module
  Renamer ()
popScope
  forall (m :: * -> *) a. Monad m => a -> m a
return (forall a.
a
-> SrcSpan
-> String
-> [Block a]
-> Maybe [ProgramUnit a]
-> ProgramUnit a
PUModule Analysis a
a' SrcSpan
s String
name [Block (Analysis a)]
blocks3 Maybe [ProgramUnit (Analysis a)]
m_contains')

programUnit (PUFunction Analysis a
a SrcSpan
s Maybe (TypeSpec (Analysis a))
ty PrefixSuffix (Analysis a)
rec String
name Maybe (AList Expression (Analysis a))
args Maybe (Expression (Analysis a))
res [Block (Analysis a)]
blocks Maybe [ProgramUnit (Analysis a)]
m_contains) = do
  ~(Just String
name') <- String -> Renamer (Maybe String)
getFromEnv String
name                  -- get renamed function name
  ([Block (Analysis a)]
blocks1, ModEnv
_)  <- forall a.
Data a =>
[Block (Analysis a)]
-> String
-> StateT RenameState Identity ([Block (Analysis a)], ModEnv)
returnBlocksEnv [Block (Analysis a)]
blocks String
name
  [Block (Analysis a)]
blocks2     <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a. Data a => RenamerFunc (Block (Analysis a))
renameEntryPointResultDecl [Block (Analysis a)]
blocks1 -- rename the result
  Maybe (Expression (Analysis a))
res'        <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a (f :: * -> *).
(Data a, Data (f (Analysis a))) =>
RenamerFunc (f (Analysis a))
renameGenericDecls Maybe (Expression (Analysis a))
res             -- variable(s) if needed
  Maybe (AList Expression (Analysis a))
args'       <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a (f :: * -> *).
(Data a, Data (f (Analysis a))) =>
RenamerFunc (f (Analysis a))
renameGenericDecls Maybe (AList Expression (Analysis a))
args -- rename arguments
  [Block (Analysis a)]
blocks3     <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a (f :: * -> *).
(Data a, Data (f (Analysis a))) =>
RenamerFunc (f (Analysis a))
renameDeclDecls [Block (Analysis a)]
blocks2 -- handle declarations
  Maybe [ProgramUnit (Analysis a)]
m_contains' <- forall a. Data a => RenamerFunc (Maybe [ProgramUnit (Analysis a)])
renameSubPUs Maybe [ProgramUnit (Analysis a)]
m_contains      -- handle contained program units
  [Block (Analysis a)]
blocks4     <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a. Data a => RenamerFunc (Block (Analysis a))
renameBlock [Block (Analysis a)]
blocks3     -- process all uses of variables
  let env :: ModEnv
env     = forall k a. k -> a -> Map k a
M.singleton String
name (String
name', NameType
NTSubprogram)
  let a' :: Analysis a
a'      = Analysis a
a { moduleEnv :: Maybe ModEnv
moduleEnv = forall a. a -> Maybe a
Just ModEnv
env }    -- also annotate it on the program unit
  Renamer ()
popScope
  let pu' :: ProgramUnit (Analysis a)
pu' = forall a.
a
-> SrcSpan
-> Maybe (TypeSpec a)
-> PrefixSuffix a
-> String
-> Maybe (AList Expression a)
-> Maybe (Expression a)
-> [Block a]
-> Maybe [ProgramUnit a]
-> ProgramUnit a
PUFunction Analysis a
a' SrcSpan
s Maybe (TypeSpec (Analysis a))
ty PrefixSuffix (Analysis a)
rec String
name Maybe (AList Expression (Analysis a))
args' Maybe (Expression (Analysis a))
res' [Block (Analysis a)]
blocks4 Maybe [ProgramUnit (Analysis a)]
m_contains'
  forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a.
(Annotated f, Data a) =>
String -> f (Analysis a) -> f (Analysis a)
setSourceName String
name forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a.
(Annotated f, Data a) =>
String -> f (Analysis a) -> f (Analysis a)
setUniqueName String
name' forall a b. (a -> b) -> a -> b
$ ProgramUnit (Analysis a)
pu'

programUnit (PUSubroutine Analysis a
a SrcSpan
s PrefixSuffix (Analysis a)
rec String
name Maybe (AList Expression (Analysis a))
args [Block (Analysis a)]
blocks Maybe [ProgramUnit (Analysis a)]
m_contains) = do
  ~(Just String
name') <- String -> Renamer (Maybe String)
getFromEnv String
name                  -- get renamed subroutine name
  ([Block (Analysis a)]
blocks1, ModEnv
_)  <- forall a.
Data a =>
[Block (Analysis a)]
-> String
-> StateT RenameState Identity ([Block (Analysis a)], ModEnv)
returnBlocksEnv [Block (Analysis a)]
blocks String
name
  Maybe (AList Expression (Analysis a))
args'       <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a (f :: * -> *).
(Data a, Data (f (Analysis a))) =>
RenamerFunc (f (Analysis a))
renameGenericDecls Maybe (AList Expression (Analysis a))
args -- rename arguments
  [Block (Analysis a)]
blocks2     <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a (f :: * -> *).
(Data a, Data (f (Analysis a))) =>
RenamerFunc (f (Analysis a))
renameDeclDecls [Block (Analysis a)]
blocks1 -- handle declarations
  Maybe [ProgramUnit (Analysis a)]
m_contains' <- forall a. Data a => RenamerFunc (Maybe [ProgramUnit (Analysis a)])
renameSubPUs Maybe [ProgramUnit (Analysis a)]
m_contains      -- handle contained program units
  [Block (Analysis a)]
blocks3     <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a. Data a => RenamerFunc (Block (Analysis a))
renameBlock [Block (Analysis a)]
blocks2     -- process all uses of variables
  let env :: ModEnv
env     = forall k a. k -> a -> Map k a
M.singleton String
name (String
name', NameType
NTSubprogram)
  let a' :: Analysis a
a'      = Analysis a
a { moduleEnv :: Maybe ModEnv
moduleEnv = forall a. a -> Maybe a
Just ModEnv
env }    -- also annotate it on the program unit
  Renamer ()
popScope
  let pu' :: ProgramUnit (Analysis a)
pu' = forall a.
a
-> SrcSpan
-> PrefixSuffix a
-> String
-> Maybe (AList Expression a)
-> [Block a]
-> Maybe [ProgramUnit a]
-> ProgramUnit a
PUSubroutine Analysis a
a' SrcSpan
s PrefixSuffix (Analysis a)
rec String
name Maybe (AList Expression (Analysis a))
args' [Block (Analysis a)]
blocks3 Maybe [ProgramUnit (Analysis a)]
m_contains'
  forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a.
(Annotated f, Data a) =>
String -> f (Analysis a) -> f (Analysis a)
setSourceName String
name forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a.
(Annotated f, Data a) =>
String -> f (Analysis a) -> f (Analysis a)
setUniqueName String
name' forall a b. (a -> b) -> a -> b
$ ProgramUnit (Analysis a)
pu'

programUnit (PUMain Analysis a
a SrcSpan
s Maybe String
n [Block (Analysis a)]
blocks Maybe [ProgramUnit (Analysis a)]
m_contains) = do
  ModEnv
env0        <- forall a. Data a => [Block (Analysis a)] -> Renamer ModEnv
initialEnv [Block (Analysis a)]
blocks
  String -> ModEnv -> Renamer ()
pushScope (forall a. a -> Maybe a -> a
fromMaybe String
"_main" Maybe String
n) ModEnv
env0        -- assume default program name is "_main"
  [Block (Analysis a)]
blocks'     <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a (f :: * -> *).
(Data a, Data (f (Analysis a))) =>
RenamerFunc (f (Analysis a))
renameDeclDecls [Block (Analysis a)]
blocks  -- handle declarations
  Maybe [ProgramUnit (Analysis a)]
m_contains' <- forall a. Data a => RenamerFunc (Maybe [ProgramUnit (Analysis a)])
renameSubPUs Maybe [ProgramUnit (Analysis a)]
m_contains      -- handle contained program units
  [Block (Analysis a)]
blocks''    <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a. Data a => RenamerFunc (Block (Analysis a))
renameBlock [Block (Analysis a)]
blocks'     -- process all uses of variables
  Renamer ()
popScope
  forall (m :: * -> *) a. Monad m => a -> m a
return (forall a.
a
-> SrcSpan
-> Maybe String
-> [Block a]
-> Maybe [ProgramUnit a]
-> ProgramUnit a
PUMain Analysis a
a SrcSpan
s Maybe String
n [Block (Analysis a)]
blocks'' Maybe [ProgramUnit (Analysis a)]
m_contains')

programUnit ProgramUnit (Analysis a)
pu = forall (m :: * -> *) a. Monad m => a -> m a
return ProgramUnit (Analysis a)
pu

returnBlocksEnv :: Data a => [Block (Analysis a)]
                          -> String
                          -> StateT RenameState Identity ([Block (Analysis a)], ModEnv)
returnBlocksEnv :: forall a.
Data a =>
[Block (Analysis a)]
-> String
-> StateT RenameState Identity ([Block (Analysis a)], ModEnv)
returnBlocksEnv [Block (Analysis a)]
bs String
n = do
  [Block (Analysis a)]
bs1 <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a. Data a => RenamerFunc (Block (Analysis a))
renameEntryPointDecl [Block (Analysis a)]
bs
  ModEnv
e0 <- forall a. Data a => [Block (Analysis a)] -> Renamer ModEnv
initialEnv [Block (Analysis a)]
bs1
  String -> ModEnv -> Renamer ()
pushScope String
n ModEnv
e0
  forall (m :: * -> *) a. Monad m => a -> m a
return ([Block (Analysis a)]
bs1, ModEnv
e0)

declarator :: forall a. Data a => RenamerFunc (Declarator (Analysis a))
declarator :: forall a. Data a => RenamerFunc (Declarator (Analysis a))
declarator (Declarator Analysis a
a SrcSpan
s Expression (Analysis a)
e1 DeclaratorType (Analysis a)
mDdAList Maybe (Expression (Analysis a))
me2 Maybe (Expression (Analysis a))
me3) = do
  Expression (Analysis a)
e1' <- forall a. Data a => RenamerFunc (Expression (Analysis a))
renameExpDecl Expression (Analysis a)
e1
  DeclaratorType (Analysis a)
mDdAList' <- forall (m :: * -> *) from to.
(Monad m, Applicative m, Biplate from to) =>
(to -> m to) -> from -> m from
transformBiM (forall a. Data a => RenamerFunc (Expression (Analysis a))
renameExp :: RenamerFunc (Expression (Analysis a))) DeclaratorType (Analysis a)
mDdAList
  Maybe (Expression (Analysis a))
me2' <- forall (m :: * -> *) from to.
(Monad m, Applicative m, Biplate from to) =>
(to -> m to) -> from -> m from
transformBiM (forall a. Data a => RenamerFunc (Expression (Analysis a))
renameExp :: RenamerFunc (Expression (Analysis a))) Maybe (Expression (Analysis a))
me2
  Maybe (Expression (Analysis a))
me3' <- forall (m :: * -> *) from to.
(Monad m, Applicative m, Biplate from to) =>
(to -> m to) -> from -> m from
transformBiM (forall a. Data a => RenamerFunc (Expression (Analysis a))
renameExp :: RenamerFunc (Expression (Analysis a))) Maybe (Expression (Analysis a))
me3
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a.
a
-> SrcSpan
-> Expression a
-> DeclaratorType a
-> Maybe (Expression a)
-> Maybe (Expression a)
-> Declarator a
Declarator Analysis a
a SrcSpan
s Expression (Analysis a)
e1' DeclaratorType (Analysis a)
mDdAList' Maybe (Expression (Analysis a))
me2' Maybe (Expression (Analysis a))
me3'

expression :: Data a => RenamerFunc (Expression (Analysis a))
expression :: forall a. Data a => RenamerFunc (Expression (Analysis a))
expression = forall a. Data a => RenamerFunc (Expression (Analysis a))
renameExp

--------------------------------------------------
-- Helper monadic combinators for composing into renaming
-- transformations.

-- Initial monad state.
renameState0 :: FortranVersion -> RenameState
renameState0 :: FortranVersion -> RenameState
renameState0 FortranVersion
v = RenameState { langVersion :: FortranVersion
langVersion = FortranVersion
v
                             , intrinsics :: IntrinsicsTable
intrinsics  = FortranVersion -> IntrinsicsTable
getVersionIntrinsics FortranVersion
v
                             , scopeStack :: [String]
scopeStack  = []
                             , uniqNums :: [Int]
uniqNums    = [Int
1..]
                             , environ :: [ModEnv]
environ     = [forall k a. Map k a
empty]
                             , moduleMap :: ModuleMap
moduleMap   = forall k a. Map k a
empty }

-- Run the monad.
runRenamer :: State a b -> a -> (b, a)
runRenamer :: forall a b. State a b -> a -> (b, a)
runRenamer = forall a b. State a b -> a -> (b, a)
runState

-- Get a freshly generated number.
getUniqNum :: Renamer Int
getUniqNum :: Renamer Int
getUniqNum = do
  Int
uniqNum <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall a. [a] -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. RenameState -> [Int]
uniqNums)
  forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \ RenameState
s -> RenameState
s { uniqNums :: [Int]
uniqNums = forall a. Int -> [a] -> [a]
drop Int
1 (RenameState -> [Int]
uniqNums RenameState
s) }
  forall (m :: * -> *) a. Monad m => a -> m a
return Int
uniqNum

-- | Concat a scope, a variable, and a freshly generated number together to
--   generate a "unique name".
--
-- GitHub issue #190 showed it was possible to generate the same unique name for
-- two different variables, if using the following unique name schema:
--
--     scope "_" var n
--     n=3:  int1 -> func_int13
--     n=13: int  -> func_int13
--
-- Instead, we now insert another underscore between the variable and the fresh
-- number, to disambiguate where the fresh number starts.
--
--     scope "_" var "_" n
--     n=3:  int1 -> func_int1_3
--     n=13: int  -> func_int_13
uniquify :: String -> String -> Renamer String
uniquify :: String -> String -> Renamer String
uniquify String
scope String
var = do
  Int
n <- Renamer Int
getUniqNum
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String
scope forall a. [a] -> [a] -> [a]
++ String
"_" forall a. [a] -> [a] -> [a]
++ String
var forall a. [a] -> [a] -> [a]
++ String
"_" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n

--isModule :: ProgramUnit a -> Bool
--isModule (PUModule {}) = True; isModule _             = False

isUseStatement :: Block a -> Bool
isUseStatement :: forall a. Block a -> Bool
isUseStatement (BlStatement a
_ SrcSpan
_ Maybe (Expression a)
_ (StUse a
_ SrcSpan
_ (ExpValue a
_ SrcSpan
_ (ValVariable String
_)) Maybe ModuleNature
_ Only
_ Maybe (AList Use a)
_)) = Bool
True
isUseStatement Block a
_                                                                    = Bool
False

-- Generate an initial environment for a scope based upon any Use
-- statements in the blocks.
initialEnv :: forall a. Data a => [Block (Analysis a)] -> Renamer ModEnv
initialEnv :: forall a. Data a => [Block (Analysis a)] -> Renamer ModEnv
initialEnv [Block (Analysis a)]
blocks = do
  let uses :: [Block (Analysis a)]
uses = forall a. (a -> Bool) -> [a] -> [a]
filter forall a. Block a -> Bool
isUseStatement [Block (Analysis a)]
blocks
  ModuleMap
mMap <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets RenameState -> ModuleMap
moduleMap
  ModEnv
modEnv <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
M.unions forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Block (Analysis a)]
uses forall a b. (a -> b) -> a -> b
$ \ Block (Analysis a)
use -> case Block (Analysis a)
use of
    (BlStatement Analysis a
_ SrcSpan
_ Maybe (Expression (Analysis a))
_ (StUse Analysis a
_ SrcSpan
_ (ExpValue Analysis a
_ SrcSpan
_ (ValVariable String
m)) Maybe ModuleNature
_ Only
_ Maybe (AList Use (Analysis a))
Nothing)) ->
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe forall k a. Map k a
empty (String -> ProgramUnitName
Named String
m forall k a. Ord k => k -> Map k a -> Maybe a
`lookup` ModuleMap
mMap)
    (BlStatement Analysis a
_ SrcSpan
_ Maybe (Expression (Analysis a))
_ (StUse Analysis a
_ SrcSpan
_ (ExpValue Analysis a
_ SrcSpan
_ (ValVariable String
m)) Maybe ModuleNature
_ Only
_ (Just AList Use (Analysis a)
onlyAList)))
      | [Use (Analysis a)]
only <- forall (t :: * -> *) a. AList t a -> [t a]
aStrip AList Use (Analysis a)
onlyAList -> do
      let env :: ModEnv
env = forall a. a -> Maybe a -> a
fromMaybe forall k a. Map k a
empty (String -> ProgramUnitName
Named String
m forall k a. Ord k => k -> Map k a -> Maybe a
`lookup` ModuleMap
mMap)
      -- list of (local name, original name) from USE declaration:
      let localNamePairs :: [(String, String)]
localNamePairs = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe [Use (Analysis a)]
only forall a b. (a -> b) -> a -> b
$ \ Use (Analysis a)
r -> case Use (Analysis a)
r of
            UseID Analysis a
_ SrcSpan
_ v :: Expression (Analysis a)
v@(ExpValue Analysis a
_ SrcSpan
_ ValVariable{}) -> forall a. a -> Maybe a
Just (forall a. Expression (Analysis a) -> String
varName Expression (Analysis a)
v, forall a. Expression (Analysis a) -> String
varName Expression (Analysis a)
v)
            UseRename Analysis a
_ SrcSpan
_ Expression (Analysis a)
u Expression (Analysis a)
v                        -> forall a. a -> Maybe a
Just (forall a. Expression (Analysis a) -> String
varName Expression (Analysis a)
u, forall a. Expression (Analysis a) -> String
varName Expression (Analysis a)
v)
            Use (Analysis a)
_                                        -> forall a. Maybe a
Nothing
      -- create environment based on local name written in ONLY list
      -- (if applicable) and variable information found in imported
      -- mod env.
      let re :: ModEnv
re = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [ (String
local, (String, NameType)
info) | (String
local, String
orig) <- [(String, String)]
localNamePairs
                                          , Just (String, NameType)
info     <- [forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
orig ModEnv
env] ]
      forall (m :: * -> *) a. Monad m => a -> m a
return ModEnv
re
    Block (Analysis a)
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall k a. Map k a
empty

  -- Include any global names from program units defined outside of
  -- modules as well.
  let global :: ModEnv
global = forall a. a -> Maybe a -> a
fromMaybe forall k a. Map k a
M.empty forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup ProgramUnitName
NamelessMain ModuleMap
mMap

  -- Include any mappings defined by COMMON blocks: use variable
  -- source name prefixed by name of COMMON block.
  let common :: ModEnv
common = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [ (String
v, (String
v', NameType
NTVariable))
                          | CommonGroup Analysis a
_ SrcSpan
_ Maybe (Expression (Analysis a))
me1 AList Declarator (Analysis a)
alist <- forall from to. Biplate from to => from -> [to]
universeBi [Block (Analysis a)]
blocks :: [CommonGroup (Analysis a)]
                          , let prefix :: String
prefix = case Maybe (Expression (Analysis a))
me1 of Just Expression (Analysis a)
e1 -> forall a. Expression (Analysis a) -> String
srcName Expression (Analysis a)
e1; Maybe (Expression (Analysis a))
_ -> String
""
                          , e :: Expression (Analysis a)
e@(ExpValue Analysis a
_ SrcSpan
_ ValVariable{}) <- forall from to. Biplate from to => from -> [to]
universeBi (forall (t :: * -> *) a. AList t a -> [t a]
aStrip AList Declarator (Analysis a)
alist) :: [Expression (Analysis a)]
                          , let v :: String
v = forall a. Expression (Analysis a) -> String
srcName Expression (Analysis a)
e
                          , let v' :: String
v' = String
prefix forall a. [a] -> [a] -> [a]
++ String
"_" forall a. [a] -> [a] -> [a]
++ String
v forall a. [a] -> [a] -> [a]
++ String
"_common" ]

  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
f (Map k a) -> Map k a
M.unions [ModEnv
modEnv,  ModEnv
global, ModEnv
common]

-- Get the current scope name.
--getScope :: Renamer String
--getScope = gets (head . scopeStack)

-- Get the concatenated scopes.
getScopes :: Renamer String
getScopes :: Renamer String
getScopes = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall a. [a] -> [[a]] -> [a]
L.intercalate String
"_" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. RenameState -> [String]
scopeStack)

-- Push a scope onto the lexical stack.
pushScope :: String -> ModEnv -> Renamer ()
pushScope :: String -> ModEnv -> Renamer ()
pushScope String
name ModEnv
env0 = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \ RenameState
s -> RenameState
s { scopeStack :: [String]
scopeStack = String
name forall a. a -> [a] -> [a]
: RenameState -> [String]
scopeStack RenameState
s
                                        , environ :: [ModEnv]
environ    = ModEnv
env0 forall a. a -> [a] -> [a]
: RenameState -> [ModEnv]
environ RenameState
s }

-- Pop a scope from the lexical stack.
popScope :: Renamer ()
popScope :: Renamer ()
popScope = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \ RenameState
s -> RenameState
s { scopeStack :: [String]
scopeStack = forall a. Int -> [a] -> [a]
drop Int
1 forall a b. (a -> b) -> a -> b
$ RenameState -> [String]
scopeStack RenameState
s
                             , environ :: [ModEnv]
environ    = forall a. Int -> [a] -> [a]
drop Int
1 forall a b. (a -> b) -> a -> b
$ RenameState -> [ModEnv]
environ RenameState
s }


-- Add an environment for a module to the table that keeps track of
-- modules.
addModEnv :: String -> ModEnv -> Renamer ()
addModEnv :: String -> ModEnv -> Renamer ()
addModEnv String
name ModEnv
env = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \ RenameState
s -> RenameState
s { moduleMap :: ModuleMap
moduleMap = forall k a. Ord k => k -> a -> Map k a -> Map k a
insert (String -> ProgramUnitName
Named String
name) ModEnv
env (RenameState -> ModuleMap
moduleMap RenameState
s) }

-- Get the current environment.
getEnv :: Renamer ModEnv
getEnv :: Renamer ModEnv
getEnv = forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (forall a. [a] -> a
head forall b c a. (b -> c) -> (a -> b) -> a -> c
. RenameState -> [ModEnv]
environ)

-- Gets an environment composed of all nested environments.
getEnvs :: Renamer ModEnv
getEnvs :: Renamer ModEnv
getEnvs = forall (f :: * -> *) k a.
(Foldable f, Ord k) =>
(a -> a -> a) -> f (Map k a) -> Map k a
M.unionsWith (forall a b c. ((a, b) -> c) -> a -> b -> c
curry forall a b. (a, b) -> a
fst) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets RenameState -> [ModEnv]
environ

-- Get a mapping from the current environment if it exists.
getFromEnv :: String -> Renamer (Maybe String)
getFromEnv :: String -> Renamer (Maybe String)
getFromEnv String
v = ((forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap`) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => k -> Map k a -> Maybe a
lookup String
v) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Renamer ModEnv
getEnv

-- Get a mapping from the combined nested environment, if it exists.
-- If not, check if it is an intrinsic name.
getFromEnvs :: String -> Renamer (Maybe String)
getFromEnvs :: String -> Renamer (Maybe String)
getFromEnvs = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst) forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Renamer (Maybe (String, NameType))
getFromEnvsWithType

-- Get a mapping, plus name type, from the combined nested
-- environment, if it exists.
-- If not, check if it is an intrinsic name.
getFromEnvsWithType :: String -> Renamer (Maybe (String, NameType))
getFromEnvsWithType :: String -> Renamer (Maybe (String, NameType))
getFromEnvsWithType String
v = do
  ModEnv
envs <- Renamer ModEnv
getEnvs
  case forall k a. Ord k => k -> Map k a -> Maybe a
lookup String
v ModEnv
envs of
    Just (String
v', NameType
nt) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (String
v', NameType
nt)
    Maybe (String, NameType)
Nothing       -> do
      IntrinsicsTable
itab <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets RenameState -> IntrinsicsTable
intrinsics
      case String -> IntrinsicsTable -> Maybe IntrinsicType
getIntrinsicReturnType String
v IntrinsicsTable
itab of
        Maybe IntrinsicType
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
        Just IntrinsicType
_  -> (forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,NameType
NTIntrinsic)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` String -> NameType -> Renamer String
addUnique String
v NameType
NTIntrinsic


-- To conform with Fortran specification about subprogram names:
-- search for subprogram names in all containing scopes first, then
-- search for variables in the current scope.
getFromEnvsIfSubprogram :: String -> Renamer (Maybe String)
getFromEnvsIfSubprogram :: String -> Renamer (Maybe String)
getFromEnvsIfSubprogram String
v = do
  Maybe (String, NameType)
mEntry <- String -> Renamer (Maybe (String, NameType))
getFromEnvsWithType String
v
  case Maybe (String, NameType)
mEntry of
    Just (String
v', NameType
NTSubprogram) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just String
v'
    Just (String
_, NameType
NTVariable)    -> String -> Renamer (Maybe String)
getFromEnv String
v
    Maybe (String, NameType)
_                       -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

-- Add a renaming mapping to the environment.
addToEnv :: String -> String -> NameType -> Renamer ()
addToEnv :: String -> String -> NameType -> Renamer ()
addToEnv String
v String
v' NameType
nt = forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \ RenameState
s -> RenameState
s { environ :: [ModEnv]
environ = forall k a. Ord k => k -> a -> Map k a -> Map k a
insert String
v (String
v', NameType
nt) (forall a. [a] -> a
head (RenameState -> [ModEnv]
environ RenameState
s)) forall a. a -> [a] -> [a]
: forall a. Int -> [a] -> [a]
drop Int
1 (RenameState -> [ModEnv]
environ RenameState
s) }

-- Add a unique renaming to the environment.
addUnique :: String -> NameType -> Renamer String
addUnique :: String -> NameType -> Renamer String
addUnique String
v NameType
nt = do
  String
v' <- forall a b c. (a -> b -> c) -> b -> a -> c
flip String -> String -> Renamer String
uniquify String
v forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Renamer String
getScopes
  String -> String -> NameType -> Renamer ()
addToEnv String
v String
v' NameType
nt
  forall (m :: * -> *) a. Monad m => a -> m a
return String
v'

addUnique_ :: String -> NameType -> Renamer ()
addUnique_ :: String -> NameType -> Renamer ()
addUnique_ String
v NameType
nt = forall (f :: * -> *) a. Functor f => f a -> f ()
void (String -> NameType -> Renamer String
addUnique String
v NameType
nt)

-- This function will be invoked by occurrences of
-- declarations. First, search to see if v is a subprogram name that
-- exists in any containing scope; if so, use it. Then, search to see
-- if v is a variable in the current scope; if so, use it. Otherwise,
-- assume that it is either a new name or that it is shadowing a
-- variable, so generate a new unique name and add it to the current
-- environment.
maybeAddUnique :: String -> NameType -> Renamer String
maybeAddUnique :: String -> NameType -> Renamer String
maybeAddUnique String
v NameType
nt = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> NameType -> Renamer String
addUnique String
v NameType
nt) forall (m :: * -> *) a. Monad m => a -> m a
return forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> Renamer (Maybe String)
getFromEnvsIfSubprogram String
v

-- If uniqueName/sourceName property is not set, then set it.
setUniqueName, setSourceName :: (Annotated f, Data a) => String -> f (Analysis a) -> f (Analysis a)
setUniqueName :: forall (f :: * -> *) a.
(Annotated f, Data a) =>
String -> f (Analysis a) -> f (Analysis a)
setUniqueName String
un f (Analysis a)
x
  | a :: Analysis a
a@Analysis { uniqueName :: forall a. Analysis a -> Maybe String
uniqueName = Maybe String
Nothing } <- forall (f :: * -> *) a. Annotated f => f a -> a
getAnnotation f (Analysis a)
x = forall (f :: * -> *) a. Annotated f => a -> f a -> f a
setAnnotation (Analysis a
a { uniqueName :: Maybe String
uniqueName = forall a. a -> Maybe a
Just String
un }) f (Analysis a)
x
  | Bool
otherwise                                              = f (Analysis a)
x

setSourceName :: forall (f :: * -> *) a.
(Annotated f, Data a) =>
String -> f (Analysis a) -> f (Analysis a)
setSourceName String
sn f (Analysis a)
x
  | a :: Analysis a
a@Analysis { sourceName :: forall a. Analysis a -> Maybe String
sourceName = Maybe String
Nothing } <- forall (f :: * -> *) a. Annotated f => f a -> a
getAnnotation f (Analysis a)
x = forall (f :: * -> *) a. Annotated f => a -> f a -> f a
setAnnotation (Analysis a
a { sourceName :: Maybe String
sourceName = forall a. a -> Maybe a
Just String
sn }) f (Analysis a)
x
  | Bool
otherwise                                              = f (Analysis a)
x

-- Work recursively into sub-program units.
renameSubPUs :: Data a => RenamerFunc (Maybe [ProgramUnit (Analysis a)])
renameSubPUs :: forall a. Data a => RenamerFunc (Maybe [ProgramUnit (Analysis a)])
renameSubPUs Maybe [ProgramUnit (Analysis a)]
Nothing = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
renameSubPUs (Just [ProgramUnit (Analysis a)]
pus) = forall a. Data a => [ProgramUnit (Analysis a)] -> Renamer ()
skimProgramUnits [ProgramUnit (Analysis a)]
pus forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a. Data a => RenamerFunc (ProgramUnit (Analysis a))
programUnit [ProgramUnit (Analysis a)]
pus

-- Go through all program units at the same level and add their names
-- to the environment.
skimProgramUnits :: Data a => [ProgramUnit (Analysis a)] -> Renamer ()
skimProgramUnits :: forall a. Data a => [ProgramUnit (Analysis a)] -> Renamer ()
skimProgramUnits [ProgramUnit (Analysis a)]
pus = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [ProgramUnit (Analysis a)]
pus forall a b. (a -> b) -> a -> b
$ \ ProgramUnit (Analysis a)
pu -> case ProgramUnit (Analysis a)
pu of
  PUModule Analysis a
_ SrcSpan
_ String
name [Block (Analysis a)]
_ Maybe [ProgramUnit (Analysis a)]
_           -> String -> String -> NameType -> Renamer ()
addToEnv String
name String
name NameType
NTSubprogram
  PUFunction Analysis a
_ SrcSpan
_ Maybe (TypeSpec (Analysis a))
_ PrefixSuffix (Analysis a)
_ String
name Maybe (AList Expression (Analysis a))
_ Maybe (Expression (Analysis a))
_ [Block (Analysis a)]
_ Maybe [ProgramUnit (Analysis a)]
_ -> String -> NameType -> Renamer ()
addUnique_ String
name NameType
NTSubprogram
  PUSubroutine Analysis a
_ SrcSpan
_ PrefixSuffix (Analysis a)
_ String
name Maybe (AList Expression (Analysis a))
_ [Block (Analysis a)]
_ Maybe [ProgramUnit (Analysis a)]
_   -> String -> NameType -> Renamer ()
addUnique_ String
name NameType
NTSubprogram
  PUMain Analysis a
_ SrcSpan
_ (Just String
name) [Block (Analysis a)]
_ Maybe [ProgramUnit (Analysis a)]
_      -> String -> String -> NameType -> Renamer ()
addToEnv String
name String
name NameType
NTSubprogram
  ProgramUnit (Analysis a)
_                               -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

----------
-- rename*Decl[s] functions: possibly generate new unique mappings:

-- Rename any ExpValue variables within a given value by assuming that
-- they are declarations and that they possibly require the creation
-- of new unique mappings.
renameGenericDecls :: (Data a, Data (f (Analysis a))) => RenamerFunc (f (Analysis a))
renameGenericDecls :: forall a (f :: * -> *).
(Data a, Data (f (Analysis a))) =>
RenamerFunc (f (Analysis a))
renameGenericDecls = forall a (f :: * -> *).
(Data a, Data (f (Analysis a))) =>
RenamerFunc (Expression (Analysis a))
-> RenamerFunc (f (Analysis a))
trans forall a. Data a => RenamerFunc (Expression (Analysis a))
renameExpDecl
  where
    trans :: (Data a, Data (f (Analysis a))) => RenamerFunc (Expression (Analysis a)) -> RenamerFunc (f (Analysis a))
    trans :: forall a (f :: * -> *).
(Data a, Data (f (Analysis a))) =>
RenamerFunc (Expression (Analysis a))
-> RenamerFunc (f (Analysis a))
trans = forall (m :: * -> *) from to.
(Monad m, Applicative m, Biplate from to) =>
(to -> m to) -> from -> m from
transformBiM

-- Rename an ExpValue variable assuming that it is to be treated as a
-- declaration that possibly requires the creation of a new unique
-- mapping.
renameExpDecl :: Data a => RenamerFunc (Expression (Analysis a))
renameExpDecl :: forall a. Data a => RenamerFunc (Expression (Analysis a))
renameExpDecl e :: Expression (Analysis a)
e@(ExpValue Analysis a
_ SrcSpan
_ (ValVariable String
v))  = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (f :: * -> *) a.
(Annotated f, Data a) =>
String -> f (Analysis a) -> f (Analysis a)
setUniqueName (forall (f :: * -> *) a.
(Annotated f, Data a) =>
String -> f (Analysis a) -> f (Analysis a)
setSourceName String
v Expression (Analysis a)
e) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` String -> NameType -> Renamer String
maybeAddUnique String
v NameType
NTVariable
-- Intrinsics get unique names for each use.
renameExpDecl e :: Expression (Analysis a)
e@(ExpValue Analysis a
_ SrcSpan
_ (ValIntrinsic String
v)) = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (f :: * -> *) a.
(Annotated f, Data a) =>
String -> f (Analysis a) -> f (Analysis a)
setUniqueName (forall (f :: * -> *) a.
(Annotated f, Data a) =>
String -> f (Analysis a) -> f (Analysis a)
setSourceName String
v Expression (Analysis a)
e) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` String -> NameType -> Renamer String
addUnique String
v NameType
NTIntrinsic
renameExpDecl Expression (Analysis a)
e                                 = forall (m :: * -> *) a. Monad m => a -> m a
return Expression (Analysis a)
e

renameInterfaces :: (Data a, Data (f (Analysis a))) => RenamerFunc (f (Analysis a))
renameInterfaces :: forall a (f :: * -> *).
(Data a, Data (f (Analysis a))) =>
RenamerFunc (f (Analysis a))
renameInterfaces = forall a (f :: * -> *).
(Data a, Data (f (Analysis a))) =>
RenamerFunc (Block (Analysis a)) -> RenamerFunc (f (Analysis a))
trans forall a. Data a => RenamerFunc (Block (Analysis a))
interface
  where
    trans :: (Data a, Data (f (Analysis a))) => RenamerFunc (Block (Analysis a)) -> RenamerFunc (f (Analysis a))
    trans :: forall a (f :: * -> *).
(Data a, Data (f (Analysis a))) =>
RenamerFunc (Block (Analysis a)) -> RenamerFunc (f (Analysis a))
trans = forall (m :: * -> *) from to.
(Monad m, Applicative m, Biplate from to) =>
(to -> m to) -> from -> m from
transformBiM

interface :: Data a => RenamerFunc (Block (Analysis a))
interface :: forall a. Data a => RenamerFunc (Block (Analysis a))
interface (BlInterface Analysis a
a SrcSpan
s (Just e :: Expression (Analysis a)
e@(ExpValue Analysis a
_ SrcSpan
_ (ValVariable String
v))) Bool
abst [ProgramUnit (Analysis a)]
pus [Block (Analysis a)]
bs) = do
  Expression (Analysis a)
e' <- forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (f :: * -> *) a.
(Annotated f, Data a) =>
String -> f (Analysis a) -> f (Analysis a)
setUniqueName (forall (f :: * -> *) a.
(Annotated f, Data a) =>
String -> f (Analysis a) -> f (Analysis a)
setSourceName String
v Expression (Analysis a)
e) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` String -> NameType -> Renamer String
maybeAddUnique String
v NameType
NTSubprogram
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a.
a
-> SrcSpan
-> Maybe (Expression a)
-> Bool
-> [ProgramUnit a]
-> [Block a]
-> Block a
BlInterface Analysis a
a SrcSpan
s (forall a. a -> Maybe a
Just Expression (Analysis a)
e') Bool
abst [ProgramUnit (Analysis a)]
pus [Block (Analysis a)]
bs
interface Block (Analysis a)
b = forall (f :: * -> *) a. Applicative f => a -> f a
pure Block (Analysis a)
b

-- Handle generic-interfaces as if they were subprograms, then handle
-- other declarations, assuming they might possibly need the creation
-- of new unique mappings.
renameModDecls :: (Data a, Data (f (Analysis a))) => RenamerFunc (f (Analysis a))
renameModDecls :: forall a (f :: * -> *).
(Data a, Data (f (Analysis a))) =>
RenamerFunc (f (Analysis a))
renameModDecls = forall a (f :: * -> *).
(Data a, Data (f (Analysis a))) =>
RenamerFunc (f (Analysis a))
renameDeclDecls forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall a (f :: * -> *).
(Data a, Data (f (Analysis a))) =>
RenamerFunc (f (Analysis a))
renameInterfaces

-- Find all declarators within a value and then dive within those
-- declarators to rename any ExpValue variables, assuming they might
-- possibly need the creation of new unique mappings.
renameDeclDecls :: (Data a, Data (f (Analysis a))) => RenamerFunc (f (Analysis a))
renameDeclDecls :: forall a (f :: * -> *).
(Data a, Data (f (Analysis a))) =>
RenamerFunc (f (Analysis a))
renameDeclDecls = forall a (f :: * -> *).
(Data a, Data (f (Analysis a))) =>
RenamerFunc (Declarator (Analysis a))
-> RenamerFunc (f (Analysis a))
trans forall a. Data a => RenamerFunc (Declarator (Analysis a))
declarator
  where
    trans :: (Data a, Data (f (Analysis a))) => RenamerFunc (Declarator (Analysis a)) -> RenamerFunc (f (Analysis a))
    trans :: forall a (f :: * -> *).
(Data a, Data (f (Analysis a))) =>
RenamerFunc (Declarator (Analysis a))
-> RenamerFunc (f (Analysis a))
trans = forall (m :: * -> *) from to.
(Monad m, Applicative m, Biplate from to) =>
(to -> m to) -> from -> m from
transformBiM

-- Find all entry points within a block and then rename them, assuming
-- they might possibly need the creation of new unique mappings.
renameEntryPointDecl :: Data a => RenamerFunc (Block (Analysis a))
renameEntryPointDecl :: forall a. Data a => RenamerFunc (Block (Analysis a))
renameEntryPointDecl (BlStatement Analysis a
a SrcSpan
s Maybe (Expression (Analysis a))
l (StEntry Analysis a
a' SrcSpan
s' Expression (Analysis a)
v Maybe (AList Expression (Analysis a))
mArgs Maybe (Expression (Analysis a))
mRes)) = do
  Expression (Analysis a)
v' <- forall a. Data a => RenamerFunc (Expression (Analysis a))
renameExpDecl Expression (Analysis a)
v
  forall (m :: * -> *) a. Monad m => a -> m a
return (forall a.
a -> SrcSpan -> Maybe (Expression a) -> Statement a -> Block a
BlStatement Analysis a
a SrcSpan
s Maybe (Expression (Analysis a))
l (forall a.
a
-> SrcSpan
-> Expression a
-> Maybe (AList Expression a)
-> Maybe (Expression a)
-> Statement a
StEntry Analysis a
a' SrcSpan
s' Expression (Analysis a)
v' Maybe (AList Expression (Analysis a))
mArgs Maybe (Expression (Analysis a))
mRes))
renameEntryPointDecl Block (Analysis a)
b = forall (m :: * -> *) a. Monad m => a -> m a
return Block (Analysis a)
b

-- Find all entry points within a block and then rename their result
-- variables, if applicable, assuming they might possibly need the
-- creation of new unique mappings.
renameEntryPointResultDecl :: Data a => RenamerFunc (Block (Analysis a))
renameEntryPointResultDecl :: forall a. Data a => RenamerFunc (Block (Analysis a))
renameEntryPointResultDecl (BlStatement Analysis a
a SrcSpan
s Maybe (Expression (Analysis a))
l (StEntry Analysis a
a' SrcSpan
s' Expression (Analysis a)
v Maybe (AList Expression (Analysis a))
mArgs (Just Expression (Analysis a)
res))) = do
  Expression (Analysis a)
res' <- forall a. Data a => RenamerFunc (Expression (Analysis a))
renameExpDecl Expression (Analysis a)
res
  forall (m :: * -> *) a. Monad m => a -> m a
return (forall a.
a -> SrcSpan -> Maybe (Expression a) -> Statement a -> Block a
BlStatement Analysis a
a SrcSpan
s Maybe (Expression (Analysis a))
l (forall a.
a
-> SrcSpan
-> Expression a
-> Maybe (AList Expression a)
-> Maybe (Expression a)
-> Statement a
StEntry Analysis a
a' SrcSpan
s' Expression (Analysis a)
v Maybe (AList Expression (Analysis a))
mArgs (forall a. a -> Maybe a
Just Expression (Analysis a)
res')))
renameEntryPointResultDecl Block (Analysis a)
b = forall (m :: * -> *) a. Monad m => a -> m a
return Block (Analysis a)
b

----------
-- Do not generate new unique mappings, instead look in outer scopes:

-- Rename an ExpValue variable, assuming that it is to be treated as a
-- reference to a previous declaration, possibly in an outer scope.
renameExp :: Data a => RenamerFunc (Expression (Analysis a))
renameExp :: forall a. Data a => RenamerFunc (Expression (Analysis a))
renameExp e :: Expression (Analysis a)
e@(ExpValue Analysis a
_ SrcSpan
_ (ValVariable String
v))  = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Expression (Analysis a)
e (forall (f :: * -> *) a.
(Annotated f, Data a) =>
String -> f (Analysis a) -> f (Analysis a)
`setUniqueName` forall (f :: * -> *) a.
(Annotated f, Data a) =>
String -> f (Analysis a) -> f (Analysis a)
setSourceName String
v Expression (Analysis a)
e) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` String -> Renamer (Maybe String)
getFromEnvs String
v
-- Intrinsics get unique names for each use.
renameExp e :: Expression (Analysis a)
e@(ExpValue Analysis a
_ SrcSpan
_ (ValIntrinsic String
v)) = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (f :: * -> *) a.
(Annotated f, Data a) =>
String -> f (Analysis a) -> f (Analysis a)
setUniqueName (forall (f :: * -> *) a.
(Annotated f, Data a) =>
String -> f (Analysis a) -> f (Analysis a)
setSourceName String
v Expression (Analysis a)
e) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` String -> NameType -> Renamer String
addUnique String
v NameType
NTIntrinsic
renameExp Expression (Analysis a)
e                                 = forall (m :: * -> *) a. Monad m => a -> m a
return Expression (Analysis a)
e

-- Rename all ExpValue variables found within the block, assuming that
-- they are to be treated as references to previous declarations,
-- possibly in an outer scope.
renameBlock :: Data a => RenamerFunc (Block (Analysis a))
renameBlock :: forall a. Data a => RenamerFunc (Block (Analysis a))
renameBlock = forall a.
Data a =>
RenamerFunc (Expression a) -> RenamerFunc (Block a)
trans forall a. Data a => RenamerFunc (Expression (Analysis a))
expression
  where
    trans :: Data a => RenamerFunc (Expression a) -> RenamerFunc (Block a)
    trans :: forall a.
Data a =>
RenamerFunc (Expression a) -> RenamerFunc (Block a)
trans = forall (m :: * -> *) from to.
(Monad m, Applicative m, Biplate from to) =>
(to -> m to) -> from -> m from
transformBiM -- search all expressions, bottom-up

-- Rename the components of a Use statement contained in the block.
renameUseSt :: Data a => RenamerFunc (Block (Analysis a))
renameUseSt :: forall a. Data a => RenamerFunc (Block (Analysis a))
renameUseSt (BlStatement Analysis a
a SrcSpan
s Maybe (Expression (Analysis a))
l st :: Statement (Analysis a)
st@StUse{}) = forall a.
a -> SrcSpan -> Maybe (Expression a) -> Statement a -> Block a
BlStatement Analysis a
a SrcSpan
s Maybe (Expression (Analysis a))
l forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a.
Data a =>
RenamerFunc (Expression a) -> RenamerFunc (Statement a)
trans forall a. Data a => RenamerFunc (Expression (Analysis a))
expression Statement (Analysis a)
st
  where
    trans :: Data a => RenamerFunc (Expression a) -> RenamerFunc (Statement a)
    trans :: forall a.
Data a =>
RenamerFunc (Expression a) -> RenamerFunc (Statement a)
trans = forall (m :: * -> *) from to.
(Monad m, Applicative m, Biplate from to) =>
(to -> m to) -> from -> m from
transformBiM -- search all expressions, bottom-up
renameUseSt Block (Analysis a)
b = forall (m :: * -> *) a. Monad m => a -> m a
return Block (Analysis a)
b

--------------------------------------------------

-- Ensure second part of UseRename has the right uniqueName &
-- sourceName, since that name does not appear in our mod env, because
-- it has been given a different local name by the programmer.
cleanupUseRenames :: forall a. Data a => ProgramFile (Analysis a) -> ProgramFile (Analysis a)
cleanupUseRenames :: forall a.
Data a =>
ProgramFile (Analysis a) -> ProgramFile (Analysis a)
cleanupUseRenames = forall from to. Biplate from to => (to -> to) -> from -> from
transformBi (\ Use (Analysis a)
u -> case Use (Analysis a)
u :: Use (Analysis a) of
  UseRename Analysis a
a SrcSpan
s Expression (Analysis a)
e1 e2 :: Expression (Analysis a)
e2@(ExpValue Analysis a
_ SrcSpan
_ (ValVariable String
v)) -> forall a. a -> SrcSpan -> Expression a -> Expression a -> Use a
UseRename Analysis a
a SrcSpan
s Expression (Analysis a)
e1 forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a.
(Annotated f, Data a) =>
String -> f (Analysis a) -> f (Analysis a)
setUniqueName (forall a. Expression (Analysis a) -> String
varName Expression (Analysis a)
e1) (forall (f :: * -> *) a.
(Annotated f, Data a) =>
String -> f (Analysis a) -> f (Analysis a)
setSourceName String
v Expression (Analysis a)
e2)
  Use (Analysis a)
_                                                  -> Use (Analysis a)
u)




-- Local variables:
-- mode: haskell
-- haskell-program-name: "cabal repl"
-- End: