@@ -19,20 +19,39 @@ import Control.Applicative
19import Control.Monad.State
19import Control.Monad.State
21import Data.List (find)
21import Data.List (find)
22import qualified Data.Map as M
23import qualified Data.Map as M
24+import qualified Data.Set as S
24import Language.PureScript.Declarations
26import Language.PureScript.Declarations
25import Language.PureScript.Environment
27import Language.PureScript.Environment
26import Language.PureScript.Names
28import Language.PureScript.Names
27import Language.PureScript.Traversals
29import Language.PureScript.Traversals
32+-- The state object used in this module
34+data RenameState = RenameState {
36+ -- A map from names bound (in the input) to their names (in the output)
38+ rsBoundNames :: M.Map Ident Ident
40+ -- The set of names which have been used and are in scope in the output
42+ , rsUsedNames :: S.Set Ident
29−type Rename = State (M.Map Ident Ident)
45+type Rename = State RenameState
47+initState :: [Ident] -> RenameState
48+initState scope = RenameState (M.fromList (zip scope scope)) (S.fromList scope)
32-- Runs renaming starting with a list of idents for the initial scope.
51-- Runs renaming starting with a list of idents for the initial scope.
34runRename :: [Ident] -> Rename a -> a
53runRename :: [Ident] -> Rename a -> a
35−runRename scope = flip evalState (M.fromList $ zip scope scope)
54+runRename scope = flip evalState (initState scope)
38-- Creates a new renaming scope using the current as a basis. Used to backtrack
57-- Creates a new renaming scope using the current as a basis. Used to backtrack
@@ -52,14 +71,16 @@ newScope x = do
52updateScope :: Ident -> Rename Ident
71updateScope :: Ident -> Rename Ident
53updateScope name = do
72updateScope name = do
54 scope <- get
73 scope <- get
55− name' <- case M.lookup name scope of
74+ let name' = case name `S.member` rsUsedNames scope of
56− Just _ -> do
75+ True ->
57− let newNames = map (\i -> Ident (runIdent name ++ "_" ++ show (i :: Int))) [1..]
77+ newNames = [ Ident (runIdent name ++ "_" ++ show (i :: Int)) | i <- [1..] ]
58− let (Just newName) = find (\nn -> M.lookup nn scope == Nothing) newNames
78+ Just newName = find (`S.notMember` rsUsedNames scope) newNames
59− modify $ M.insert newName newName
79+ in newName
60− return newName
80+ False -> name
61− Nothing -> return name
62− modify $ M.insert name name'
81+ modify $ \s -> s { rsBoundNames = M.insert name name' (rsBoundNames s)
82+ , rsUsedNames = S.insert name' (rsUsedNames s)
63 return name'
84 return name'
@@ -67,7 +88,7 @@ updateScope name = do
68lookupIdent :: Ident -> Rename Ident
89lookupIdent :: Ident -> Rename Ident
69lookupIdent name = do
90lookupIdent name = do
70− name' <- gets $ M.lookup name
91+ name' <- gets $ M.lookup name . rsBoundNames
71 case name' of
92 case name' of
72 Just name'' -> return name''
93 Just name'' -> return name''
73 Nothing -> error $ "Rename scope is missing ident '" ++ show name ++ "'"
94 Nothing -> error $ "Rename scope is missing ident '" ++ show name ++ "'"
@@ -162,7 +183,7 @@ renameInValue v = return v
162-- Renames within case alternatives.
183-- Renames within case alternatives.
164renameInCaseAlternative :: CaseAlternative -> Rename CaseAlternative
185renameInCaseAlternative :: CaseAlternative -> Rename CaseAlternative
165−renameInCaseAlternative (CaseAlternative bs g v) =
186+renameInCaseAlternative (CaseAlternative bs g v) =
166 newScope $ CaseAlternative <$> mapM renameInBinder bs <*> maybeM renameInValue g <*> renameInValue v
187 newScope $ CaseAlternative <$> mapM renameInBinder bs <*> maybeM renameInValue g <*> renameInValue v