@@ -19,27 +19,50 @@ 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
3958-- when leaving an Abs.
4059--
4160newScope :: Rename a -> Rename a
42−newScope x = get >>= lift . evalStateT x
61+newScope x = do
62+ scope <- get
63+ a <- x
64+ put scope
65+ return a
4366
4467-- |
4568-- Adds a new scope entry for an ident. If the ident is already present, a new
@@ -48,14 +71,16 @@ newScope x = get >>= lift . evalStateT x
4871updateScope :: Ident -> Rename Ident
4972updateScope name = do
5073 scope <- get
51− name' <- case M.lookup name scope of
52− Just _ -> do
53− let newNames = map (\i -> Ident (runIdent name ++ "_" ++ show (i :: Int))) [1..]
54− let (Just newName) = find (\nn -> M.lookup nn scope == Nothing) newNames
55− modify $ M.insert newName newName
56− return newName
57− Nothing -> return name
58− 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+ }
5984 return name'
6085
6186-- |
@@ -63,7 +88,7 @@ updateScope name = do
6388--
6489lookupIdent :: Ident -> Rename Ident
6590lookupIdent name = do
66− name' <- gets $ M.lookup name
91+ name' <- gets $ M.lookup name . rsBoundNames
6792 case name' of
6893 Just name'' -> return name''
6994 Nothing -> error $ "Rename scope is missing ident '" ++ show name ++ "'"
@@ -133,7 +158,7 @@ renameInValue (ObjectLiteral vs) =
133158renameInValue (Accessor prop v) =
134159 Accessor prop <$> renameInValue v
135160renameInValue (ObjectUpdate obj vs) =
136− ObjectUpdate obj <$> mapM (\(name, v) -> (,) name <$> renameInValue v) vs
161+ ObjectUpdate <$> renameInValue obj <*> mapM (\(name, v) -> (,) name <$> renameInValue v) vs
137162renameInValue (Abs (Left name) v) =
138163 newScope $ Abs . Left <$> updateScope name <*> renameInValue v
139164renameInValue (App v1 v2) =
@@ -143,11 +168,11 @@ renameInValue (Var (Qualified Nothing name)) =
143168renameInValue (IfThenElse v1 v2 v3) =
144169 IfThenElse <$> renameInValue v1 <*> renameInValue v2 <*> renameInValue v3
145170renameInValue (Case vs alts) =
146− Case <$> mapM renameInValue vs <*> mapM renameInCaseAlternative alts
171+ newScope $ Case <$> mapM renameInValue vs <*> mapM renameInCaseAlternative alts
147172renameInValue (TypedValue check v ty) =
148173 TypedValue check <$> renameInValue v <*> pure ty
149174renameInValue (Let ds v) =
150− Let <$> mapM (renameInDecl False) ds <*> renameInValue v
175+ newScope $ Let <$> mapM (renameInDecl False) ds <*> renameInValue v
151176renameInValue (TypeClassDictionaryConstructorApp name v) =
152177 TypeClassDictionaryConstructorApp name <$> renameInValue v
153178renameInValue (PositionedValue pos v) =
@@ -158,8 +183,8 @@ renameInValue v = return v
158183-- Renames within case alternatives.
159184--
160185renameInCaseAlternative :: CaseAlternative -> Rename CaseAlternative
161−renameInCaseAlternative (CaseAlternative bs g v) =
162− newScope $ CaseAlternative <$> mapM renameInBinder bs <*> maybeM renameInValue g <*> renameInValue v
186+renameInCaseAlternative (CaseAlternative bs g v) =
187+ CaseAlternative <$> mapM renameInBinder bs <*> maybeM renameInValue g <*> renameInValue v
163188
164189-- |
165190-- Renames within binders.