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