-- |
-- Renaming pass that prevents shadowing of local identifiers.
--
module Language.PureScript.Renamer (renameInModule) where

import Prelude

import Control.Monad.State

import Data.Functor ((<&>))
import Data.List (find)
import Data.Maybe (fromJust, fromMaybe)
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.Text as T

import Language.PureScript.CoreFn
import Language.PureScript.Names
import Language.PureScript.Traversals

-- |
-- The state object used in this module
--
data RenameState = RenameState {
    -- |
    -- A map from names bound (in the input) to their names (in the output)
    --
    RenameState -> Map Ident Ident
rsBoundNames :: M.Map Ident Ident
    -- |
    -- The set of names which have been used and are in scope in the output
    --
  , RenameState -> Set Ident
rsUsedNames :: S.Set Ident
  }

type Rename = State RenameState

initState :: [Ident] -> RenameState
initState :: [Ident] -> RenameState
initState [Ident]
scope = Map Ident Ident -> Set Ident -> RenameState
RenameState (forall k a. Ord k => [(k, a)] -> Map k a
M.fromList (forall a b. [a] -> [b] -> [(a, b)]
zip [Ident]
scope [Ident]
scope)) (forall a. Ord a => [a] -> Set a
S.fromList [Ident]
scope)

-- |
-- Runs renaming starting with a list of idents for the initial scope.
--
runRename :: [Ident] -> Rename a -> (a, RenameState)
runRename :: forall a. [Ident] -> Rename a -> (a, RenameState)
runRename [Ident]
scope = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall s a. State s a -> s -> (a, s)
runState ([Ident] -> RenameState
initState [Ident]
scope)

-- |
-- Creates a new renaming scope using the current as a basis. Used to backtrack
-- when leaving an Abs.
--
newScope :: Rename a -> Rename a
newScope :: forall a. Rename a -> Rename a
newScope Rename a
x = do
  RenameState
scope <- forall s (m :: * -> *). MonadState s m => m s
get
  a
a <- Rename a
x
  forall s (m :: * -> *). MonadState s m => s -> m ()
put RenameState
scope
  forall (m :: * -> *) a. Monad m => a -> m a
return a
a

-- |
-- Adds a new scope entry for an ident. If the ident is already present, a new
-- unique name is generated and stored.
--
updateScope :: Ident -> Rename Ident
updateScope :: Ident -> Rename Ident
updateScope Ident
ident =
  case Ident
ident of
    GenIdent Maybe Text
name Integer
_ -> Ident -> Ident -> Rename Ident
go Ident
ident forall a b. (a -> b) -> a -> b
$ Text -> Ident
Ident (forall a. a -> Maybe a -> a
fromMaybe Text
"v" Maybe Text
name)
    Ident
UnusedIdent -> forall (m :: * -> *) a. Monad m => a -> m a
return Ident
UnusedIdent
    Ident
_ -> Ident -> Ident -> Rename Ident
go Ident
ident Ident
ident
  where
  go :: Ident -> Ident -> Rename Ident
  go :: Ident -> Ident -> Rename Ident
go Ident
keyName Ident
baseName = do
    RenameState
scope <- forall s (m :: * -> *). MonadState s m => m s
get
    let usedNames :: Set Ident
usedNames = RenameState -> Set Ident
rsUsedNames RenameState
scope
        name' :: Ident
name' =
          if Ident
baseName forall a. Ord a => a -> Set a -> Bool
`S.member` Set Ident
usedNames
          then Set Ident -> Ident -> Ident
getNewName Set Ident
usedNames Ident
baseName
          else Ident
baseName
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ \RenameState
s -> RenameState
s { rsBoundNames :: Map Ident Ident
rsBoundNames = forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert Ident
keyName Ident
name' (RenameState -> Map Ident Ident
rsBoundNames RenameState
s)
                     , rsUsedNames :: Set Ident
rsUsedNames  = forall a. Ord a => a -> Set a -> Set a
S.insert Ident
name' (RenameState -> Set Ident
rsUsedNames RenameState
s)
                     }
    forall (m :: * -> *) a. Monad m => a -> m a
return Ident
name'
  getNewName :: S.Set Ident -> Ident -> Ident
  getNewName :: Set Ident -> Ident -> Ident
getNewName Set Ident
usedNames Ident
name =
    forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find
      (forall a. Ord a => a -> Set a -> Bool
`S.notMember` Set Ident
usedNames)
      [ Text -> Ident
Ident (Ident -> Text
runIdent Ident
name forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show (Int
i :: Int))) | Int
i <- [Int
1..] ]

-- |
-- Finds the new name to use for an ident.
--
lookupIdent :: Ident -> Rename Ident
lookupIdent :: Ident -> Rename Ident
lookupIdent Ident
UnusedIdent = forall (m :: * -> *) a. Monad m => a -> m a
return Ident
UnusedIdent
lookupIdent Ident
name = do
  Maybe Ident
name' <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Ident
name forall b c a. (b -> c) -> (a -> b) -> a -> c
. RenameState -> Map Ident Ident
rsBoundNames
  case Maybe Ident
name' of
    Just Ident
name'' -> forall (m :: * -> *) a. Monad m => a -> m a
return Ident
name''
    Maybe Ident
Nothing -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"Rename scope is missing ident '" forall a. [a] -> [a] -> [a]
++ Text -> [Char]
T.unpack (Ident -> Text
showIdent Ident
name) forall a. [a] -> [a] -> [a]
++ [Char]
"'"


-- |
-- Renames within each declaration in a module. Returns the map of renamed
-- identifiers in the top-level scope, so that they can be renamed in the
-- externs files as well.
--
renameInModule :: Module Ann -> (M.Map Ident Ident, Module Ann)
renameInModule :: Module Ann -> (Map Ident Ident, Module Ann)
renameInModule m :: Module Ann
m@(Module SourceSpan
_ [Comment]
_ ModuleName
_ [Char]
_ [(Ann, ModuleName)]
_ [Ident]
exports Map ModuleName [Ident]
_ [Ident]
foreigns [Bind Ann]
decls) = (Map Ident Ident
rsBoundNames, Module Ann
m { [Ident]
moduleExports :: [Ident]
moduleExports :: [Ident]
moduleExports, [Bind Ann]
moduleDecls :: [Bind Ann]
moduleDecls :: [Bind Ann]
moduleDecls })
  where
  (([Bind Ann]
moduleDecls, [Ident]
moduleExports), RenameState{Set Ident
Map Ident Ident
rsUsedNames :: Set Ident
rsBoundNames :: Map Ident Ident
rsUsedNames :: RenameState -> Set Ident
rsBoundNames :: RenameState -> Map Ident Ident
..}) = forall a. [Ident] -> Rename a -> (a, RenameState)
runRename [Ident]
foreigns forall a b. (a -> b) -> a -> b
$
    (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Bind Ann] -> Rename [Bind Ann]
renameInDecls [Bind Ann]
decls forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Ident -> Rename Ident
lookupIdent [Ident]
exports

-- |
-- Renames within a list of declarations. The list is processed in three
-- passes:
--
--  1) Declarations with user-provided names are added to the scope, renaming
--     them only if necessary to prevent shadowing.
--  2) Declarations with compiler-provided names are added to the scope,
--     renaming them to prevent shadowing or collision with a user-provided
--     name.
--  3) The bodies of the declarations are processed recursively.
--
-- The distinction between passes 1 and 2 is critical in the top-level module
-- scope, where declarations can be exported and named declarations must not
-- be renamed. Below the top level, this only matters for programmers looking
-- at the generated code or using a debugger; we want them to see the names
-- they used as much as possible.
--
-- The distinction between the first two passes and pass 3 is important because
-- a `GenIdent` can appear before its declaration in a depth-first traversal,
-- and we need to visit the declaration first in order to rename all of its
-- uses. Similarly, a plain `Ident` could shadow another declared in an outer
-- scope but later in a depth-first traversal, and we need to visit the
-- outer declaration first in order to know to rename the inner one.
--
renameInDecls :: [Bind Ann] -> Rename [Bind Ann]
renameInDecls :: [Bind Ann] -> Rename [Bind Ann]
renameInDecls =
      forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Bool -> Bind Ann -> Rename (Bind Ann)
renameDecl Bool
False)
  forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (Bool -> Bind Ann -> Rename (Bind Ann)
renameDecl Bool
True)
  forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Bind Ann -> Rename (Bind Ann)
renameValuesInDecl

  where

  renameDecl :: Bool -> Bind Ann -> Rename (Bind Ann)
  renameDecl :: Bool -> Bind Ann -> Rename (Bind Ann)
renameDecl Bool
isSecondPass = \case
    NonRec Ann
a Ident
name Expr Ann
val -> Ident -> Rename Ident
updateName Ident
name forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Ident
name' -> forall a. a -> Ident -> Expr a -> Bind a
NonRec Ann
a Ident
name' Expr Ann
val
    Rec [((Ann, Ident), Expr Ann)]
ds -> forall a. [((a, Ident), Expr a)] -> Bind a
Rec forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Ann, Ident), Expr Ann) -> Rename ((Ann, Ident), Expr Ann)
updateNames [((Ann, Ident), Expr Ann)]
ds
    where
    updateName :: Ident -> Rename Ident
    updateName :: Ident -> Rename Ident
updateName Ident
name = (if Bool
isSecondPass forall a. Eq a => a -> a -> Bool
== Ident -> Bool
isPlainIdent Ident
name then forall (f :: * -> *) a. Applicative f => a -> f a
pure else Ident -> Rename Ident
updateScope) Ident
name

    updateNames :: ((Ann, Ident), Expr Ann) -> Rename ((Ann, Ident), Expr Ann)
    updateNames :: ((Ann, Ident), Expr Ann) -> Rename ((Ann, Ident), Expr Ann)
updateNames ((Ann
a, Ident
name), Expr Ann
val) = Ident -> Rename Ident
updateName Ident
name forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Ident
name' -> ((Ann
a, Ident
name'), Expr Ann
val)

  renameValuesInDecl :: Bind Ann -> Rename (Bind Ann)
  renameValuesInDecl :: Bind Ann -> Rename (Bind Ann)
renameValuesInDecl = \case
    NonRec Ann
a Ident
name Expr Ann
val -> forall a. a -> Ident -> Expr a -> Bind a
NonRec Ann
a Ident
name forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr Ann -> Rename (Expr Ann)
renameInValue Expr Ann
val
    Rec [((Ann, Ident), Expr Ann)]
ds -> forall a. [((a, Ident), Expr a)] -> Bind a
Rec forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Ann, Ident), Expr Ann) -> Rename ((Ann, Ident), Expr Ann)
updateValues [((Ann, Ident), Expr Ann)]
ds
    where
    updateValues :: ((Ann, Ident), Expr Ann) -> Rename ((Ann, Ident), Expr Ann)
    updateValues :: ((Ann, Ident), Expr Ann) -> Rename ((Ann, Ident), Expr Ann)
updateValues ((Ann, Ident)
aname, Expr Ann
val) = ((Ann, Ident)
aname, ) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr Ann -> Rename (Expr Ann)
renameInValue Expr Ann
val

-- |
-- Renames within a value.
--
renameInValue :: Expr Ann -> Rename (Expr Ann)
renameInValue :: Expr Ann -> Rename (Expr Ann)
renameInValue (Literal Ann
ann Literal (Expr Ann)
l) =
  forall a. a -> Literal (Expr a) -> Expr a
Literal Ann
ann forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. (a -> Rename a) -> Literal a -> Rename (Literal a)
renameInLiteral Expr Ann -> Rename (Expr Ann)
renameInValue Literal (Expr Ann)
l
renameInValue c :: Expr Ann
c@Constructor{} = forall (m :: * -> *) a. Monad m => a -> m a
return Expr Ann
c
renameInValue (Accessor Ann
ann PSString
prop Expr Ann
v) =
  forall a. a -> PSString -> Expr a -> Expr a
Accessor Ann
ann PSString
prop forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr Ann -> Rename (Expr Ann)
renameInValue Expr Ann
v
renameInValue (ObjectUpdate Ann
ann Expr Ann
obj [(PSString, Expr Ann)]
vs) =
  forall a. a -> Expr a -> [(PSString, Expr a)] -> Expr a
ObjectUpdate Ann
ann forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr Ann -> Rename (Expr Ann)
renameInValue Expr Ann
obj forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\(PSString
name, Expr Ann
v) -> (PSString
name, ) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr Ann -> Rename (Expr Ann)
renameInValue Expr Ann
v) [(PSString, Expr Ann)]
vs
renameInValue (Abs Ann
ann Ident
name Expr Ann
v) =
  forall a. Rename a -> Rename a
newScope forall a b. (a -> b) -> a -> b
$ forall a. a -> Ident -> Expr a -> Expr a
Abs Ann
ann forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ident -> Rename Ident
updateScope Ident
name forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr Ann -> Rename (Expr Ann)
renameInValue Expr Ann
v
renameInValue (App Ann
ann Expr Ann
v1 Expr Ann
v2) =
  forall a. a -> Expr a -> Expr a -> Expr a
App Ann
ann forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr Ann -> Rename (Expr Ann)
renameInValue Expr Ann
v1 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr Ann -> Rename (Expr Ann)
renameInValue Expr Ann
v2
renameInValue (Var Ann
ann (Qualified QualifiedBy
qb Ident
name)) | QualifiedBy -> Bool
isBySourcePos QualifiedBy
qb Bool -> Bool -> Bool
|| Bool -> Bool
not (Ident -> Bool
isPlainIdent Ident
name) =
  -- This should only rename identifiers local to the current module: either
  -- they aren't qualified, or they are but they have a name that should not
  -- have appeared in a module's externs, so they must be from this module's
  -- top-level scope.
  forall a. a -> Qualified Ident -> Expr a
Var Ann
ann forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. QualifiedBy -> a -> Qualified a
Qualified QualifiedBy
qb forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ident -> Rename Ident
lookupIdent Ident
name
renameInValue v :: Expr Ann
v@Var{} = forall (m :: * -> *) a. Monad m => a -> m a
return Expr Ann
v
renameInValue (Case Ann
ann [Expr Ann]
vs [CaseAlternative Ann]
alts) =
  forall a. Rename a -> Rename a
newScope forall a b. (a -> b) -> a -> b
$ forall a. a -> [Expr a] -> [CaseAlternative a] -> Expr a
Case Ann
ann forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Expr Ann -> Rename (Expr Ann)
renameInValue [Expr Ann]
vs forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse CaseAlternative Ann -> Rename (CaseAlternative Ann)
renameInCaseAlternative [CaseAlternative Ann]
alts
renameInValue (Let Ann
ann [Bind Ann]
ds Expr Ann
v) =
  forall a. Rename a -> Rename a
newScope forall a b. (a -> b) -> a -> b
$ forall a. a -> [Bind a] -> Expr a -> Expr a
Let Ann
ann forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Bind Ann] -> Rename [Bind Ann]
renameInDecls [Bind Ann]
ds forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr Ann -> Rename (Expr Ann)
renameInValue Expr Ann
v

-- |
-- Renames within literals.
--
renameInLiteral :: (a -> Rename a) -> Literal a -> Rename (Literal a)
renameInLiteral :: forall a. (a -> Rename a) -> Literal a -> Rename (Literal a)
renameInLiteral a -> Rename a
rename (ArrayLiteral [a]
bs) = forall a. [a] -> Literal a
ArrayLiteral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> Rename a
rename [a]
bs
renameInLiteral a -> Rename a
rename (ObjectLiteral [(PSString, a)]
bs) = forall a. [(PSString, a)] -> Literal a
ObjectLiteral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (f :: * -> *) b c a.
Functor f =>
(b -> f c) -> (a, b) -> f (a, c)
sndM a -> Rename a
rename) [(PSString, a)]
bs
renameInLiteral a -> Rename a
_ Literal a
l = forall (m :: * -> *) a. Monad m => a -> m a
return Literal a
l

-- |
-- Renames within case alternatives.
--
renameInCaseAlternative :: CaseAlternative Ann -> Rename (CaseAlternative Ann)
renameInCaseAlternative :: CaseAlternative Ann -> Rename (CaseAlternative Ann)
renameInCaseAlternative (CaseAlternative [Binder Ann]
bs Either [(Expr Ann, Expr Ann)] (Expr Ann)
v) = forall a. Rename a -> Rename a
newScope forall a b. (a -> b) -> a -> b
$
  forall a.
[Binder a]
-> Either [(Guard a, Guard a)] (Guard a) -> CaseAlternative a
CaseAlternative forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall a. Binder a -> Rename (Binder a)
renameInBinder [Binder Ann]
bs
                  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> Either a b -> f (Either c d)
eitherM (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> (a, b) -> f (c, d)
pairM Expr Ann -> Rename (Expr Ann)
renameInValue Expr Ann -> Rename (Expr Ann)
renameInValue)) Expr Ann -> Rename (Expr Ann)
renameInValue Either [(Expr Ann, Expr Ann)] (Expr Ann)
v

-- |
-- Renames within binders.
--
renameInBinder :: Binder a -> Rename (Binder a)
renameInBinder :: forall a. Binder a -> Rename (Binder a)
renameInBinder n :: Binder a
n@NullBinder{} = forall (m :: * -> *) a. Monad m => a -> m a
return Binder a
n
renameInBinder (LiteralBinder a
ann Literal (Binder a)
b) =
  forall a. a -> Literal (Binder a) -> Binder a
LiteralBinder a
ann forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. (a -> Rename a) -> Literal a -> Rename (Literal a)
renameInLiteral forall a. Binder a -> Rename (Binder a)
renameInBinder Literal (Binder a)
b
renameInBinder (VarBinder a
ann Ident
name) =
  forall a. a -> Ident -> Binder a
VarBinder a
ann forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ident -> Rename Ident
updateScope Ident
name
renameInBinder (ConstructorBinder a
ann Qualified (ProperName 'TypeName)
tctor Qualified (ProperName 'ConstructorName)
dctor [Binder a]
bs) =
  forall a.
a
-> Qualified (ProperName 'TypeName)
-> Qualified (ProperName 'ConstructorName)
-> [Binder a]
-> Binder a
ConstructorBinder a
ann Qualified (ProperName 'TypeName)
tctor Qualified (ProperName 'ConstructorName)
dctor forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall a. Binder a -> Rename (Binder a)
renameInBinder [Binder a]
bs
renameInBinder (NamedBinder a
ann Ident
name Binder a
b) =
  forall a. a -> Ident -> Binder a -> Binder a
NamedBinder a
ann forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ident -> Rename Ident
updateScope Ident
name forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Binder a -> Rename (Binder a)
renameInBinder Binder a
b