@@ -0,0 +1,206 @@
1+-----------------------------------------------------------------------------
3+-- Module : Language.PureScript.Renamer
4+-- Copyright : (c) 2013-14 Phil Freeman, (c) 2014 Gary Burgess, and other contributors
7+-- Maintainer : Phil Freeman <paf31@cantab.net>
8+-- Stability : experimental
12+-- Renaming pass that prevents shadowing of local identifiers.
14+-----------------------------------------------------------------------------
16+module Language.PureScript.Renamer (renameInModules) where
18+import Control.Applicative
19+import Control.Monad.State
21+import Data.List (find)
23+import qualified Data.Map as M
24+import qualified Data.Set as S
26+import Language.PureScript.Declarations
27+import Language.PureScript.Environment
28+import Language.PureScript.Names
29+import 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
45+type Rename = State RenameState
47+initState :: [Ident] -> RenameState
48+initState scope = RenameState (M.fromList (zip scope scope)) (S.fromList scope)
51+-- Runs renaming starting with a list of idents for the initial scope.
53+runRename :: [Ident] -> Rename a -> a
54+runRename scope = flip evalState (initState scope)
57+-- Creates a new renaming scope using the current as a basis. Used to backtrack
58+-- when leaving an Abs.
60+newScope :: Rename a -> Rename a
68+-- Adds a new scope entry for an ident. If the ident is already present, a new
69+-- unique name is generated and stored.
71+updateScope :: Ident -> Rename Ident
74+ let name' = case name `S.member` rsUsedNames scope of
77+ newNames = [ Ident (runIdent name ++ "_" ++ show (i :: Int)) | i <- [1..] ]
78+ Just newName = find (`S.notMember` rsUsedNames scope) newNames
81+ modify $ \s -> s { rsBoundNames = M.insert name name' (rsBoundNames s)
82+ , rsUsedNames = S.insert name' (rsUsedNames s)
87+-- Finds the new name to use for an ident.
89+lookupIdent :: Ident -> Rename Ident
91+ name' <- gets $ M.lookup name . rsBoundNames
93+ Just name'' -> return name''
94+ Nothing -> error $ "Rename scope is missing ident '" ++ show name ++ "'"
97+-- Finds idents introduced by declarations.
99+findDeclIdents :: [Declaration] -> [Ident]
100+findDeclIdents = concatMap go
102+ go (ValueDeclaration ident _ _ _ _) = [ident]
103+ go (BindingGroupDeclaration ds) = map (\(name, _, _) -> name) ds
104+ go (ExternDeclaration _ ident _ _) = [ident]
105+ go (TypeClassDeclaration _ _ _ ds) = findDeclIdents ds
106+ go (PositionedDeclaration _ d) = go d
110+-- Renames within each declaration in a module.
112+renameInModules :: [Module] -> [Module]
113+renameInModules = map go
115+ go :: Module -> Module
116+ go (Module mn decls exps) = Module mn (renameInDecl' (findDeclIdents decls) `map` decls) exps
117+ renameInDecl' :: [Ident] -> Declaration -> Declaration
118+ renameInDecl' scope = runRename scope . renameInDecl True
121+-- Renames within a declaration. isTopLevel is used to determine whether the
122+-- declaration is a module member or appearing within a Let. At the top level
123+-- declarations are not renamed or added to the scope (they should already have
124+-- been added), whereas in a Let declarations are renamed if their name shadows
125+-- another in the current scope.
127+renameInDecl :: Bool -> Declaration -> Rename Declaration
128+renameInDecl isTopLevel (ValueDeclaration name nameKind [] Nothing val) = do
129+ name' <- if isTopLevel then return name else updateScope name
130+ ValueDeclaration name' nameKind [] Nothing <$> renameInValue val
131+renameInDecl isTopLevel (BindingGroupDeclaration ds) = do
132+ ds' <- mapM updateNames ds
133+ BindingGroupDeclaration <$> mapM updateValues ds'
135+ updateNames :: (Ident, NameKind, Value) -> Rename (Ident, NameKind, Value)
136+ updateNames (name, nameKind, val) = do
137+ name' <- if isTopLevel then return name else updateScope name
138+ return (name', nameKind, val)
139+ updateValues :: (Ident, NameKind, Value) -> Rename (Ident, NameKind, Value)
140+ updateValues (name, nameKind, val) =
141+ (,,) name nameKind <$> renameInValue val
142+renameInDecl _ (TypeInstanceDeclaration name cs className args ds) =
143+ TypeInstanceDeclaration name cs className args <$> mapM (renameInDecl True) ds
144+renameInDecl isTopLevel (PositionedDeclaration pos d) =
145+ PositionedDeclaration pos <$> renameInDecl isTopLevel d
146+renameInDecl _ other = return other
149+-- Renames within a value.
151+renameInValue :: Value -> Rename Value
152+renameInValue (UnaryMinus v) =
153+ UnaryMinus <$> renameInValue v
154+renameInValue (ArrayLiteral vs) =
155+ ArrayLiteral <$> mapM renameInValue vs
156+renameInValue (ObjectLiteral vs) =
157+ ObjectLiteral <$> mapM (\(name, v) -> (,) name <$> renameInValue v) vs
158+renameInValue (Accessor prop v) =
159+ Accessor prop <$> renameInValue v
160+renameInValue (ObjectUpdate obj vs) =
161+ ObjectUpdate <$> renameInValue obj <*> mapM (\(name, v) -> (,) name <$> renameInValue v) vs
162+renameInValue (Abs (Left name) v) =
163+ newScope $ Abs . Left <$> updateScope name <*> renameInValue v
164+renameInValue (App v1 v2) =
165+ App <$> renameInValue v1 <*> renameInValue v2
166+renameInValue (Var (Qualified Nothing name)) =
167+ Var . Qualified Nothing <$> lookupIdent name
168+renameInValue (IfThenElse v1 v2 v3) =
169+ IfThenElse <$> renameInValue v1 <*> renameInValue v2 <*> renameInValue v3
170+renameInValue (Case vs alts) =
171+ newScope $ Case <$> mapM renameInValue vs <*> mapM renameInCaseAlternative alts
172+renameInValue (TypedValue check v ty) =
173+ TypedValue check <$> renameInValue v <*> pure ty
174+renameInValue (Let ds v) =
175+ newScope $ Let <$> mapM (renameInDecl False) ds <*> renameInValue v
176+renameInValue (TypeClassDictionaryConstructorApp name v) =
177+ TypeClassDictionaryConstructorApp name <$> renameInValue v
178+renameInValue (PositionedValue pos v) =
179+ PositionedValue pos <$> renameInValue v
180+renameInValue v = return v
183+-- Renames within case alternatives.
185+renameInCaseAlternative :: CaseAlternative -> Rename CaseAlternative
186+renameInCaseAlternative (CaseAlternative bs g v) =
187+ CaseAlternative <$> mapM renameInBinder bs <*> maybeM renameInValue g <*> renameInValue v
190+-- Renames within binders.
192+renameInBinder :: Binder -> Rename Binder
193+renameInBinder (VarBinder name) =
194+ VarBinder <$> updateScope name
195+renameInBinder (ConstructorBinder name bs) =
196+ ConstructorBinder name <$> mapM renameInBinder bs
197+renameInBinder (ObjectBinder bs) =
198+ ObjectBinder <$> mapM (sndM renameInBinder) bs
199+renameInBinder (ArrayBinder bs) =
200+ ArrayBinder <$> mapM renameInBinder bs
201+renameInBinder (ConsBinder b1 b2) =
202+ ConsBinder <$> renameInBinder b1 <*> renameInBinder b2
203+renameInBinder (NamedBinder name b) =
204+ NamedBinder <$> updateScope name <*> renameInBinder b
205+renameInBinder (PositionedBinder _ b) = renameInBinder b
206+renameInBinder other = return other