git.iko.soy/rowtype-yoga/purescript-native
on bbf00f2 help sign in
rowtype-yoga/purescript-native/src/Language/PureScript/Renamer.hs
194 lines 6.6 kB history raw
1-----------------------------------------------------------------------------
2-----------------------------------------------------------------------------
3--
4-- Module : Language.PureScript.Renamer
5-- Copyright : (c) 2013-14 Phil Freeman, (c) 2014 Gary Burgess, and other contributors
6-- License : MIT
7--
8-- Maintainer : Phil Freeman <paf31@cantab.net>
9-- Stability : experimental
10-- Portability :
11--
12-- |
13-- Renaming pass that prevents shadowing of local identifiers.
14--
15-----------------------------------------------------------------------------
17module Language.PureScript.Renamer (renameInModules) where
19import Control.Applicative
20import Control.Monad.State
22import Data.List (find)
24import qualified Data.Map as M
25import qualified Data.Set as S
27import Language.PureScript.CoreFn
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 :: [Bind Ann] -> [Ident]
104findDeclIdents = concatMap go
105 where
106 go (NonRec ident _) = [ident]
107 go (Rec ds) = map fst ds
109-- |
110-- Renames within each declaration in a module.
111--
112renameInModules :: [Module Ann] -> [Module Ann]
113renameInModules = map go
114 where
115 go :: Module Ann -> Module Ann
116 go m@(Module _ _ _ _ decls) = m { moduleDecls = renameInDecl' (findDeclIdents decls) `map` decls }
117 renameInDecl' :: [Ident] -> Bind Ann -> Bind Ann
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 -> Bind Ann -> Rename (Bind Ann)
128renameInDecl isTopLevel (NonRec name val) = do
129 name' <- if isTopLevel then return name else updateScope name
130 NonRec name' <$> renameInValue val
131renameInDecl isTopLevel (Rec ds) = do
132 ds' <- mapM updateNames ds
133 Rec <$> mapM updateValues ds'
134 where
135 updateNames :: (Ident, Expr Ann) -> Rename (Ident, Expr Ann)
136 updateNames (name, val) = do
137 name' <- if isTopLevel then return name else updateScope name
138 return (name', val)
139 updateValues :: (Ident, Expr Ann) -> Rename (Ident, Expr Ann)
140 updateValues (name, val) = (,) name <$> renameInValue val
142-- |
143-- Renames within a value.
144--
145renameInValue :: Expr Ann -> Rename (Expr Ann)
146renameInValue (Literal ann l) =
147 Literal ann <$> renameInLiteral renameInValue l
148renameInValue c@(Constructor{}) = return c
149renameInValue (Accessor ann prop v) =
150 Accessor ann prop <$> renameInValue v
151renameInValue (ObjectUpdate ann obj vs) =
152 ObjectUpdate ann <$> renameInValue obj <*> mapM (\(name, v) -> (,) name <$> renameInValue v) vs
153renameInValue e@(Abs (_, _, _, Just IsTypeClassConstructor) _ _) = return e
154renameInValue (Abs ann name v) =
155 newScope $ Abs ann <$> updateScope name <*> renameInValue v
156renameInValue (App ann v1 v2) =
157 App ann <$> renameInValue v1 <*> renameInValue v2
158renameInValue (Var ann (Qualified Nothing name)) =
159 Var ann . Qualified Nothing <$> lookupIdent name
160renameInValue v@(Var{}) = return v
161renameInValue (Case ann vs alts) =
162 newScope $ Case ann <$> mapM renameInValue vs <*> mapM renameInCaseAlternative alts
163renameInValue (Let ann ds v) =
164 newScope $ Let ann <$> mapM (renameInDecl False) ds <*> renameInValue v
166-- |
167-- Renames within literals.
168--
169renameInLiteral :: (a -> Rename a) -> Literal a -> Rename (Literal a)
170renameInLiteral rename (ArrayLiteral bs) = ArrayLiteral <$> mapM rename bs
171renameInLiteral rename (ObjectLiteral bs) = ObjectLiteral <$> mapM (sndM rename) bs
172renameInLiteral _ l = return l
174-- |
175-- Renames within case alternatives.
176--
177renameInCaseAlternative :: CaseAlternative Ann -> Rename (CaseAlternative Ann)
178renameInCaseAlternative (CaseAlternative bs v) =
179 CaseAlternative <$> mapM renameInBinder bs
180 <*> eitherM (mapM (pairM renameInValue renameInValue)) renameInValue v
182-- |
183-- Renames within binders.
184--
185renameInBinder :: Binder a -> Rename (Binder a)
186renameInBinder n@(NullBinder{}) = return n
187renameInBinder (LiteralBinder ann b) =
188 LiteralBinder ann <$> renameInLiteral renameInBinder b
189renameInBinder (VarBinder ann name) =
190 VarBinder ann <$> updateScope name
191renameInBinder (ConstructorBinder ann tctor dctor bs) =
192 ConstructorBinder ann tctor dctor <$> mapM renameInBinder bs
193renameInBinder (NamedBinder ann name b) =
194 NamedBinder ann <$> updateScope name <*> renameInBinder b