git.iko.soy/rowtype-yoga/purescript-native
on fd682fa help sign in
rowtype-yoga/purescript-native/src/Language/PureScript/Renamer.hs
199 lines 6.7 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-----------------------------------------------------------------------------
17{-# LANGUAGE FlexibleContexts #-}
18{-# LANGUAGE ScopedTypeVariables #-}
20module Language.PureScript.Renamer (renameInModules) where
22import Prelude ()
23import Prelude.Compat
25import Control.Monad.State
27import Data.List (find)
29import qualified Data.Map as M
30import qualified Data.Set as S
32import Language.PureScript.CoreFn
33import Language.PureScript.Names
34import Language.PureScript.Traversals
36import qualified Language.PureScript.Constants as C
38-- |
39-- The state object used in this module
40--
41data RenameState = RenameState {
42 -- |
43 -- A map from names bound (in the input) to their names (in the output)
44 --
45 rsBoundNames :: M.Map Ident Ident
46 -- |
47 -- The set of names which have been used and are in scope in the output
48 --
49 , rsUsedNames :: S.Set Ident
50 }
52type Rename = State RenameState
54initState :: [Ident] -> RenameState
55initState scope = RenameState (M.fromList (zip scope scope)) (S.fromList scope)
57-- |
58-- Runs renaming starting with a list of idents for the initial scope.
59--
60runRename :: [Ident] -> Rename a -> a
61runRename scope = flip evalState (initState scope)
63-- |
64-- Creates a new renaming scope using the current as a basis. Used to backtrack
65-- when leaving an Abs.
66--
67newScope :: Rename a -> Rename a
68newScope x = do
69 scope <- get
70 a <- x
71 put scope
72 return a
74-- |
75-- Adds a new scope entry for an ident. If the ident is already present, a new
76-- unique name is generated and stored.
77--
78updateScope :: Ident -> Rename Ident
79updateScope i@(Ident name) | name == C.__unused = return i
80updateScope name = do
81 scope <- get
82 name' <- if name `S.member` rsUsedNames scope
83 then do
84 let newNames = [ Ident (runIdent name ++ "_" ++ show (i :: Int)) | i <- [1..] ]
85 Just newName = find (`S.notMember` rsUsedNames scope) newNames
86 return newName
87 else return name
88 modify $ \s -> s { rsBoundNames = M.insert name name' (rsBoundNames s)
89 , rsUsedNames = S.insert name' (rsUsedNames s)
90 }
91 return name'
93-- |
94-- Finds the new name to use for an ident.
95--
96lookupIdent :: Ident -> Rename Ident
97lookupIdent i@(Ident name) | name == C.__unused = return i
98lookupIdent name = do
99 name' <- gets $ M.lookup name . rsBoundNames
100 case name' of
101 Just name'' -> return name''
102 Nothing -> error $ "Rename scope is missing ident '" ++ showIdent name ++ "'"
104-- |
105-- Finds idents introduced by declarations.
106--
107findDeclIdents :: [Bind Ann] -> [Ident]
108findDeclIdents = concatMap go
109 where
110 go (NonRec ident _) = [ident]
111 go (Rec ds) = map fst ds
113-- |
114-- Renames within each declaration in a module.
115--
116renameInModules :: [Module Ann] -> [Module Ann]
117renameInModules = map go
118 where
119 go :: Module Ann -> Module Ann
120 go m@(Module _ _ _ _ _ decls) = m { moduleDecls = map (renameInDecl' (findDeclIdents decls)) decls }
122 renameInDecl' :: [Ident] -> Bind Ann -> Bind Ann
123 renameInDecl' scope = runRename scope . renameInDecl True
125-- |
126-- Renames within a declaration. isTopLevel is used to determine whether the
127-- declaration is a module member or appearing within a Let. At the top level
128-- declarations are not renamed or added to the scope (they should already have
129-- been added), whereas in a Let declarations are renamed if their name shadows
130-- another in the current scope.
131--
132renameInDecl :: Bool -> Bind Ann -> Rename (Bind Ann)
133renameInDecl isTopLevel (NonRec name val) = do
134 name' <- if isTopLevel then return name else updateScope name
135 NonRec name' <$> renameInValue val
136renameInDecl isTopLevel (Rec ds) = do
137 ds' <- traverse updateNames ds
138 Rec <$> traverse updateValues ds'
139 where
140 updateNames :: (Ident, Expr Ann) -> Rename (Ident, Expr Ann)
141 updateNames (name, val) = do
142 name' <- if isTopLevel then return name else updateScope name
143 return (name', val)
144 updateValues :: (Ident, Expr Ann) -> Rename (Ident, Expr Ann)
145 updateValues (name, val) = (,) name <$> renameInValue val
147-- |
148-- Renames within a value.
149--
150renameInValue :: Expr Ann -> Rename (Expr Ann)
151renameInValue (Literal ann l) =
152 Literal ann <$> renameInLiteral renameInValue l
153renameInValue c@(Constructor{}) = return c
154renameInValue (Accessor ann prop v) =
155 Accessor ann prop <$> renameInValue v
156renameInValue (ObjectUpdate ann obj vs) =
157 ObjectUpdate ann <$> renameInValue obj <*> traverse (\(name, v) -> (,) name <$> renameInValue v) vs
158renameInValue e@(Abs (_, _, _, Just IsTypeClassConstructor) _ _) = return e
159renameInValue (Abs ann name v) =
160 newScope $ Abs ann <$> updateScope name <*> renameInValue v
161renameInValue (App ann v1 v2) =
162 App ann <$> renameInValue v1 <*> renameInValue v2
163renameInValue (Var ann (Qualified Nothing name)) =
164 Var ann . Qualified Nothing <$> lookupIdent name
165renameInValue v@(Var{}) = return v
166renameInValue (Case ann vs alts) =
167 newScope $ Case ann <$> traverse renameInValue vs <*> traverse renameInCaseAlternative alts
168renameInValue (Let ann ds v) =
169 newScope $ Let ann <$> traverse (renameInDecl False) ds <*> renameInValue v
171-- |
172-- Renames within literals.
173--
174renameInLiteral :: (a -> Rename a) -> Literal a -> Rename (Literal a)
175renameInLiteral rename (ArrayLiteral bs) = ArrayLiteral <$> traverse rename bs
176renameInLiteral rename (ObjectLiteral bs) = ObjectLiteral <$> traverse (sndM rename) bs
177renameInLiteral _ l = return l
179-- |
180-- Renames within case alternatives.
181--
182renameInCaseAlternative :: CaseAlternative Ann -> Rename (CaseAlternative Ann)
183renameInCaseAlternative (CaseAlternative bs v) = newScope $
184 CaseAlternative <$> traverse renameInBinder bs
185 <*> eitherM (traverse (pairM renameInValue renameInValue)) renameInValue v
187-- |
188-- Renames within binders.
189--
190renameInBinder :: Binder a -> Rename (Binder a)
191renameInBinder n@(NullBinder{}) = return n
192renameInBinder (LiteralBinder ann b) =
193 LiteralBinder ann <$> renameInLiteral renameInBinder b
194renameInBinder (VarBinder ann name) =
195 VarBinder ann <$> updateScope name
196renameInBinder (ConstructorBinder ann tctor dctor bs) =
197 ConstructorBinder ann tctor dctor <$> traverse renameInBinder bs
198renameInBinder (NamedBinder ann name b) =
199 NamedBinder ann <$> updateScope name <*> renameInBinder b