@@ -19,20 +19,39 @@ import Control.Applicative
1919import Control.Monad.State
2020
2121import Data.List (find)
22+
2223import qualified Data.Map as M
24+import qualified Data.Set as S
2325
2426import Language.PureScript.Declarations
2527import Language.PureScript.Environment
2628import Language.PureScript.Names
2729import Language.PureScript.Traversals
2830
29−type Rename = State (M.Map Ident Ident)
31+-- |
32+-- The state object used in this module
33+--
34+data RenameState = RenameState {
35+ -- |
36+ -- A map from names bound (in the input) to their names (in the output)
37+ --
38+ rsBoundNames :: M.Map Ident Ident
39+ -- |
40+ -- The set of names which have been used and are in scope in the output
41+ --
42+ , rsUsedNames :: S.Set Ident
43+ }
44+
45+type Rename = State RenameState
46+
47+initState :: [Ident] -> RenameState
48+initState scope = RenameState (M.fromList (zip scope scope)) (S.fromList scope)
3049
3150-- |
3251-- Runs renaming starting with a list of idents for the initial scope.
3352--
3453runRename :: [Ident] -> Rename a -> a
35−runRename scope = flip evalState (M.fromList $ zip scope scope)
54+runRename scope = flip evalState (initState scope)
3655
3756-- |
3857-- Creates a new renaming scope using the current as a basis. Used to backtrack
@@ -52,14 +71,16 @@ newScope x = do
5271updateScope :: Ident -> Rename Ident
5372updateScope name = do
5473 scope <- get
55− name' <- case M.lookup name scope of
56− Just _ -> do
57− let newNames = map (\i -> Ident (runIdent name ++ "_" ++ show (i :: Int))) [1..]
58− let (Just newName) = find (\nn -> M.lookup nn scope == Nothing) newNames
59− modify $ M.insert newName newName
60− return newName
61− Nothing -> return name
62− modify $ M.insert name name'
74+ let name' = case name `S.member` rsUsedNames scope of
75+ True ->
76+ let
77+ newNames = [ Ident (runIdent name ++ "_" ++ show (i :: Int)) | i <- [1..] ]
78+ Just newName = find (`S.notMember` rsUsedNames scope) newNames
79+ in newName
80+ False -> name
81+ modify $ \s -> s { rsBoundNames = M.insert name name' (rsBoundNames s)
82+ , rsUsedNames = S.insert name' (rsUsedNames s)
83+ }
6384 return name'
6485
6586-- |
@@ -67,7 +88,7 @@ updateScope name = do
6788--
6889lookupIdent :: Ident -> Rename Ident
6990lookupIdent name = do
70− name' <- gets $ M.lookup name
91+ name' <- gets $ M.lookup name . rsBoundNames
7192 case name' of
7293 Just name'' -> return name''
7394 Nothing -> error $ "Rename scope is missing ident '" ++ show name ++ "'"
@@ -162,7 +183,7 @@ renameInValue v = return v
162183-- Renames within case alternatives.
163184--
164185renameInCaseAlternative :: CaseAlternative -> Rename CaseAlternative
165−renameInCaseAlternative (CaseAlternative bs g v) =
186+renameInCaseAlternative (CaseAlternative bs g v) =
166187 newScope $ CaseAlternative <$> mapM renameInBinder bs <*> maybeM renameInValue g <*> renameInValue v
167188
168189-- |