module Tip.Rename(renameAvoiding,RenamedId(..)) where
#include "errors.h"
import Data.Char (isDigit)
import Tip.Core hiding (globals)
import Tip.Scope
import Tip.Pretty
import Tip.Utils.Rename
import Data.Traversable (Traversable)
import Data.Foldable (Foldable)
import qualified Data.Foldable as F
import qualified Data.Map as M
newtype RenamedId = RenamedId String
deriving (Eq,Ord,Show)
instance PrettyVar RenamedId where
varStr (RenamedId x) = x
data TwoStage a = Remain a | Renamed String
deriving (Eq,Ord)
instance PrettyVar a => Show (TwoStage a) where
show (Remain x) = "Remain " ++ varStr x
show (Renamed s) = "Renamed " ++ s
renameSome
:: (Traversable t,Ord a,PrettyVar a)
=> (a -> Bool) -> [String] -> (a -> [String]) -> t a -> t (TwoStage a)
renameSome p_rename kwds mk_name =
renameWithBlocks
(map Renamed kwds)
(\ v ->
if p_rename v then map Renamed (mk_name v)
else Remain v:__)
renameRest
:: (Traversable t,Ord a,PrettyVar a)
=> [String] -> (a -> [String]) -> t (TwoStage a) -> t RenamedId
renameRest kwds mk_name =
renameWithBlocks
(map RenamedId kwds)
(\ v ->
case v of
Renamed s -> RenamedId s:__
Remain a -> map RenamedId (mk_name a))
renameAvoiding :: forall a . (Ord a,PrettyVar a) =>
[String]
-> (Char -> String)
-> Theory a
-> Theory RenamedId
renameAvoiding kwds repl thy
= mapDecls (renameRest kwds (filter (`notElem` assigned_gbl_names) . disambig rn)) first_pass
where
first_pass :: Theory (TwoStage a)
first_pass = renameSome (`elem` gbls0) kwds (disambig rn) thy
where gbls0 = M.keys (globals (scope thy)) ++ M.keys (types (scope thy))
assigned_gbl_names = [ s | Renamed s <- F.toList first_pass ]
rn :: a -> String
rn = concatMap repl . varStr