git.iko.soy/rowtype-yoga/purescript-native
on 22df771 help sign in
rowtype-yoga/purescript-native/src/Language/PureScript/Renamer.hs
206 lines 7.3 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
31-- |
32-- The state object used in this module
33--
34data 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 }
45type Rename = State RenameState
47initState :: [Ident] -> RenameState
48initState scope = RenameState (M.fromList (zip scope scope)) (S.fromList scope)
50-- |
51-- Runs renaming starting with a list of idents for the initial scope.
52--
53runRename :: [Ident] -> Rename a -> a
54runRename scope = flip evalState (initState scope)
56-- |
57-- Creates a new renaming scope using the current as a basis. Used to backtrack
58-- when leaving an Abs.
59--
60newScope :: Rename a -> Rename a
61newScope x = do
62 scope <- get
63 a <- x
64 put scope
65 return a
67-- |
68-- Adds a new scope entry for an ident. If the ident is already present, a new
69-- unique name is generated and stored.
70--
71updateScope :: Ident -> Rename Ident
72updateScope name = do
73 scope <- get
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 }
84 return name'
86-- |
87-- Finds the new name to use for an ident.
88--
89lookupIdent :: Ident -> Rename Ident
90lookupIdent name = do
91 name' <- gets $ M.lookup name . rsBoundNames
92 case name' of
93 Just name'' -> return name''
94 Nothing -> error $ "Rename scope is missing ident '" ++ show name ++ "'"
96-- |
97-- Finds idents introduced by declarations.
98--
99findDeclIdents :: [Declaration] -> [Ident]
100findDeclIdents = concatMap go
101 where
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
107 go _ = []
109-- |
110-- Renames within each declaration in a module.
111--
112renameInModules :: [Module] -> [Module]
113renameInModules = map go
114 where
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
120-- |
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.
126--
127renameInDecl :: Bool -> Declaration -> Rename Declaration
128renameInDecl isTopLevel (ValueDeclaration name nameKind [] Nothing val) = do
129 name' <- if isTopLevel then return name else updateScope name
130 ValueDeclaration name' nameKind [] Nothing <$> renameInValue val
131renameInDecl isTopLevel (BindingGroupDeclaration ds) = do
132 ds' <- mapM updateNames ds
133 BindingGroupDeclaration <$> mapM updateValues ds'
134 where
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
142renameInDecl _ (TypeInstanceDeclaration name cs className args ds) =
143 TypeInstanceDeclaration name cs className args <$> mapM (renameInDecl True) ds
144renameInDecl isTopLevel (PositionedDeclaration pos d) =
145 PositionedDeclaration pos <$> renameInDecl isTopLevel d
146renameInDecl _ other = return other
148-- |
149-- Renames within a value.
150--
151renameInValue :: Value -> Rename Value
152renameInValue (UnaryMinus v) =
153 UnaryMinus <$> renameInValue v
154renameInValue (ArrayLiteral vs) =
155 ArrayLiteral <$> mapM renameInValue vs
156renameInValue (ObjectLiteral vs) =
157 ObjectLiteral <$> mapM (\(name, v) -> (,) name <$> renameInValue v) vs
158renameInValue (Accessor prop v) =
159 Accessor prop <$> renameInValue v
160renameInValue (ObjectUpdate obj vs) =
161 ObjectUpdate <$> renameInValue obj <*> mapM (\(name, v) -> (,) name <$> renameInValue v) vs
162renameInValue (Abs (Left name) v) =
163 newScope $ Abs . Left <$> updateScope name <*> renameInValue v
164renameInValue (App v1 v2) =
165 App <$> renameInValue v1 <*> renameInValue v2
166renameInValue (Var (Qualified Nothing name)) =
167 Var . Qualified Nothing <$> lookupIdent name
168renameInValue (IfThenElse v1 v2 v3) =
169 IfThenElse <$> renameInValue v1 <*> renameInValue v2 <*> renameInValue v3
170renameInValue (Case vs alts) =
171 newScope $ Case <$> mapM renameInValue vs <*> mapM renameInCaseAlternative alts
172renameInValue (TypedValue check v ty) =
173 TypedValue check <$> renameInValue v <*> pure ty
174renameInValue (Let ds v) =
175 newScope $ Let <$> mapM (renameInDecl False) ds <*> renameInValue v
176renameInValue (TypeClassDictionaryConstructorApp name v) =
177 TypeClassDictionaryConstructorApp name <$> renameInValue v
178renameInValue (PositionedValue pos v) =
179 PositionedValue pos <$> renameInValue v
180renameInValue v = return v
182-- |
183-- Renames within case alternatives.
184--
185renameInCaseAlternative :: CaseAlternative -> Rename CaseAlternative
186renameInCaseAlternative (CaseAlternative bs g v) =
187 CaseAlternative <$> mapM renameInBinder bs <*> maybeM renameInValue g <*> renameInValue v
189-- |
190-- Renames within binders.
191--
192renameInBinder :: Binder -> Rename Binder
193renameInBinder (VarBinder name) =
194 VarBinder <$> updateScope name
195renameInBinder (ConstructorBinder name bs) =
196 ConstructorBinder name <$> mapM renameInBinder bs
197renameInBinder (ObjectBinder bs) =
198 ObjectBinder <$> mapM (sndM renameInBinder) bs
199renameInBinder (ArrayBinder bs) =
200 ArrayBinder <$> mapM renameInBinder bs
201renameInBinder (ConsBinder b1 b2) =
202 ConsBinder <$> renameInBinder b1 <*> renameInBinder b2
203renameInBinder (NamedBinder name b) =
204 NamedBinder <$> updateScope name <*> renameInBinder b
205renameInBinder (PositionedBinder _ b) = renameInBinder b
206renameInBinder other = return other