git.iko.soy/rowtype-yoga/purescript-native
on 98eaa39 help sign in
rowtype-yoga/purescript-native/src/Language/PureScript/Renamer.hs
210 lines 7.5 kB history raw
1-----------------------------------------------------------------------------
2--
3-- Module : Language.PureScript.Renamer
4-- Copyright : (c) 2013-14 Phil Freeman, (c) 2014 Gary Burgess, and other contributors
5-- License : MIT
6--
7-- Maintainer : Phil Freeman <paf31@cantab.net>
8-- Stability : experimental
9-- Portability :
10--
11-- |
12-- Renaming pass that prevents shadowing of local identifiers.
13--
14-----------------------------------------------------------------------------
16module Language.PureScript.Renamer (renameInModules) where
18import Control.Applicative
19import Control.Monad.State
21import Data.List (find)
23import qualified Data.Map as M
24import qualified Data.Set as S
26import Language.PureScript.Declarations
27import Language.PureScript.Environment
28import Language.PureScript.Names
29import Language.PureScript.Traversals
31import qualified Language.PureScript.Constants as C
33-- |
34-- The state object used in this module
35--
36data RenameState = RenameState {
37 -- |
38 -- A map from names bound (in the input) to their names (in the output)
39 --
40 rsBoundNames :: M.Map Ident Ident
41 -- |
42 -- The set of names which have been used and are in scope in the output
43 --
44 , rsUsedNames :: S.Set Ident
45 }
47type Rename = State RenameState
49initState :: [Ident] -> RenameState
50initState scope = RenameState (M.fromList (zip scope scope)) (S.fromList scope)
52-- |
53-- Runs renaming starting with a list of idents for the initial scope.
54--
55runRename :: [Ident] -> Rename a -> a
56runRename scope = flip evalState (initState scope)
58-- |
59-- Creates a new renaming scope using the current as a basis. Used to backtrack
60-- when leaving an Abs.
61--
62newScope :: Rename a -> Rename a
63newScope x = do
64 scope <- get
65 a <- x
66 put scope
67 return a
69-- |
70-- Adds a new scope entry for an ident. If the ident is already present, a new
71-- unique name is generated and stored.
72--
73updateScope :: Ident -> Rename Ident
74updateScope i@(Ident name) | name == C.__unused = return i
75updateScope name = do
76 scope <- get
77 let name' = case name `S.member` rsUsedNames scope of
78 True ->
79 let
80 newNames = [ Ident (runIdent name ++ "_" ++ show (i :: Int)) | i <- [1..] ]
81 Just newName = find (`S.notMember` rsUsedNames scope) newNames
82 in newName
83 False -> name
84 modify $ \s -> s { rsBoundNames = M.insert name name' (rsBoundNames s)
85 , rsUsedNames = S.insert name' (rsUsedNames s)
86 }
87 return name'
89-- |
90-- Finds the new name to use for an ident.
91--
92lookupIdent :: Ident -> Rename Ident
93lookupIdent i@(Ident name) | name == C.__unused = return i
94lookupIdent name = do
95 name' <- gets $ M.lookup name . rsBoundNames
96 case name' of
97 Just name'' -> return name''
98 Nothing -> error $ "Rename scope is missing ident '" ++ show name ++ "'"
100-- |
101-- Finds idents introduced by declarations.
102--
103findDeclIdents :: [Declaration] -> [Ident]
104findDeclIdents = concatMap go
105 where
106 go (ValueDeclaration ident _ _ _ _) = [ident]
107 go (BindingGroupDeclaration ds) = map (\(name, _, _) -> name) ds
108 go (ExternDeclaration _ ident _ _) = [ident]
109 go (TypeClassDeclaration _ _ _ ds) = findDeclIdents ds
110 go (PositionedDeclaration _ d) = go d
111 go _ = []
113-- |
114-- Renames within each declaration in a module.
115--
116renameInModules :: [Module] -> [Module]
117renameInModules = map go
118 where
119 go :: Module -> Module
120 go (Module mn decls exps) = Module mn (renameInDecl' (findDeclIdents decls) `map` decls) exps
121 renameInDecl' :: [Ident] -> Declaration -> Declaration
122 renameInDecl' scope = runRename scope . renameInDecl True
124-- |
125-- Renames within a declaration. isTopLevel is used to determine whether the
126-- declaration is a module member or appearing within a Let. At the top level
127-- declarations are not renamed or added to the scope (they should already have
128-- been added), whereas in a Let declarations are renamed if their name shadows
129-- another in the current scope.
130--
131renameInDecl :: Bool -> Declaration -> Rename Declaration
132renameInDecl isTopLevel (ValueDeclaration name nameKind [] Nothing val) = do
133 name' <- if isTopLevel then return name else updateScope name
134 ValueDeclaration name' nameKind [] Nothing <$> renameInValue val
135renameInDecl isTopLevel (BindingGroupDeclaration ds) = do
136 ds' <- mapM updateNames ds
137 BindingGroupDeclaration <$> mapM updateValues ds'
138 where
139 updateNames :: (Ident, NameKind, Expr) -> Rename (Ident, NameKind, Expr)
140 updateNames (name, nameKind, val) = do
141 name' <- if isTopLevel then return name else updateScope name
142 return (name', nameKind, val)
143 updateValues :: (Ident, NameKind, Expr) -> Rename (Ident, NameKind, Expr)
144 updateValues (name, nameKind, val) =
145 (,,) name nameKind <$> renameInValue val
146renameInDecl _ (TypeInstanceDeclaration name cs className args ds) =
147 TypeInstanceDeclaration name cs className args <$> mapM (renameInDecl True) ds
148renameInDecl isTopLevel (PositionedDeclaration pos d) =
149 PositionedDeclaration pos <$> renameInDecl isTopLevel d
150renameInDecl _ other = return other
152-- |
153-- Renames within a value.
154--
155renameInValue :: Expr -> Rename Expr
156renameInValue (UnaryMinus v) =
157 UnaryMinus <$> renameInValue v
158renameInValue (ArrayLiteral vs) =
159 ArrayLiteral <$> mapM renameInValue vs
160renameInValue (ObjectLiteral vs) =
161 ObjectLiteral <$> mapM (\(name, v) -> (,) name <$> renameInValue v) vs
162renameInValue (Accessor prop v) =
163 Accessor prop <$> renameInValue v
164renameInValue (ObjectUpdate obj vs) =
165 ObjectUpdate <$> renameInValue obj <*> mapM (\(name, v) -> (,) name <$> renameInValue v) vs
166renameInValue (Abs (Left name) v) =
167 newScope $ Abs . Left <$> updateScope name <*> renameInValue v
168renameInValue (App v1 v2) =
169 App <$> renameInValue v1 <*> renameInValue v2
170renameInValue (Var (Qualified Nothing name)) =
171 Var . Qualified Nothing <$> lookupIdent name
172renameInValue (IfThenElse v1 v2 v3) =
173 IfThenElse <$> renameInValue v1 <*> renameInValue v2 <*> renameInValue v3
174renameInValue (Case vs alts) =
175 newScope $ Case <$> mapM renameInValue vs <*> mapM renameInCaseAlternative alts
176renameInValue (TypedValue check v ty) =
177 TypedValue check <$> renameInValue v <*> pure ty
178renameInValue (Let ds v) =
179 newScope $ Let <$> mapM (renameInDecl False) ds <*> renameInValue v
180renameInValue (TypeClassDictionaryConstructorApp name v) =
181 TypeClassDictionaryConstructorApp name <$> renameInValue v
182renameInValue (PositionedValue pos v) =
183 PositionedValue pos <$> renameInValue v
184renameInValue v = return v
186-- |
187-- Renames within case alternatives.
188--
189renameInCaseAlternative :: CaseAlternative -> Rename CaseAlternative
190renameInCaseAlternative (CaseAlternative bs g v) =
191 CaseAlternative <$> mapM renameInBinder bs <*> maybeM renameInValue g <*> renameInValue v
193-- |
194-- Renames within binders.
195--
196renameInBinder :: Binder -> Rename Binder
197renameInBinder (VarBinder name) =
198 VarBinder <$> updateScope name
199renameInBinder (ConstructorBinder name bs) =
200 ConstructorBinder name <$> mapM renameInBinder bs
201renameInBinder (ObjectBinder bs) =
202 ObjectBinder <$> mapM (sndM renameInBinder) bs
203renameInBinder (ArrayBinder bs) =
204 ArrayBinder <$> mapM renameInBinder bs
205renameInBinder (ConsBinder b1 b2) =
206 ConsBinder <$> renameInBinder b1 <*> renameInBinder b2
207renameInBinder (NamedBinder name b) =
208 NamedBinder <$> updateScope name <*> renameInBinder b
209renameInBinder (PositionedBinder _ b) = renameInBinder b
210renameInBinder other = return other