git.iko.soy/rowtype-yoga/purescript-native
on 0c87efe help sign in
rowtype-yoga/purescript-native/src/Language/PureScript/Renamer.hs
199 lines 6.6 kB history raw
1{-# LANGUAGE FlexibleContexts #-}
2{-# LANGUAGE ScopedTypeVariables #-}
4-- |
5-- Renaming pass that prevents shadowing of local identifiers.
6--
7module Language.PureScript.Renamer (renameInModules) where
9import Prelude ()
10import Prelude.Compat
12import Control.Monad.State
14import Data.List (find)
15import Data.Maybe (fromJust, fromMaybe)
17import qualified Data.Map as M
18import qualified Data.Set as S
20import Language.PureScript.CoreFn
21import Language.PureScript.Names
22import Language.PureScript.Traversals
24import qualified Language.PureScript.Constants as C
26-- |
27-- The state object used in this module
28--
29data RenameState = RenameState {
30 -- |
31 -- A map from names bound (in the input) to their names (in the output)
32 --
33 rsBoundNames :: M.Map Ident Ident
34 -- |
35 -- The set of names which have been used and are in scope in the output
36 --
37 , rsUsedNames :: S.Set Ident
38 }
40type Rename = State RenameState
42initState :: [Ident] -> RenameState
43initState scope = RenameState (M.fromList (zip scope scope)) (S.fromList scope)
45-- |
46-- Runs renaming starting with a list of idents for the initial scope.
47--
48runRename :: [Ident] -> Rename a -> a
49runRename scope = flip evalState (initState scope)
51-- |
52-- Creates a new renaming scope using the current as a basis. Used to backtrack
53-- when leaving an Abs.
54--
55newScope :: Rename a -> Rename a
56newScope x = do
57 scope <- get
58 a <- x
59 put scope
60 return a
62-- |
63-- Adds a new scope entry for an ident. If the ident is already present, a new
64-- unique name is generated and stored.
65--
66updateScope :: Ident -> Rename Ident
67updateScope ident =
68 case ident of
69 Ident name
70 | name == C.__unused -> return ident
71 | last name == '\'' -> go ident $ Ident $ init name ++ "ʹ" -- '\x02b9'
72 GenIdent name _ -> go ident $ Ident (fromMaybe "v" name)
73 _ -> go ident ident
74 where
75 go :: Ident -> Ident -> Rename Ident
76 go keyName baseName = do
77 scope <- get
78 let usedNames = rsUsedNames scope
79 name' =
80 if baseName `S.member` usedNames
81 then getNewName usedNames baseName
82 else baseName
83 modify $ \s -> s { rsBoundNames = M.insert keyName name' (rsBoundNames s)
84 , rsUsedNames = S.insert name' (rsUsedNames s)
85 }
86 return name'
87 getNewName :: S.Set Ident -> Ident -> Ident
88 getNewName usedNames name =
89 fromJust $ find
90 (`S.notMember` usedNames)
91 [ Ident (runIdent name ++ show (i :: Int)) | i <- [1..] ]
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