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