git.iko.soy/rowtype-yoga/purescript-native
on 235edea help sign in
rowtype-yoga/purescript-native/src/Language/PureScript/Renamer.hs
197 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 | name == C.__unused -> return ident
70 GenIdent name _ -> go ident $ Ident (fromMaybe "v" name)
71 _ -> go ident ident
72 where
73 go :: Ident -> Ident -> Rename Ident
74 go keyName baseName = do
75 scope <- get
76 let usedNames = rsUsedNames scope
77 name' =
78 if baseName `S.member` usedNames
79 then getNewName usedNames baseName
80 else baseName
81 modify $ \s -> s { rsBoundNames = M.insert keyName name' (rsBoundNames s)
82 , rsUsedNames = S.insert name' (rsUsedNames s)
83 }
84 return name'
85 getNewName :: S.Set Ident -> Ident -> Ident
86 getNewName usedNames name =
87 fromJust $ find
88 (`S.notMember` usedNames)
89 [ Ident (runIdent name ++ show (i :: Int)) | i <- [1..] ]
91-- |
92-- Finds the new name to use for an ident.
93--
94lookupIdent :: Ident -> Rename Ident
95lookupIdent i@(Ident name) | name == C.__unused = return i
96lookupIdent name = do
97 name' <- gets $ M.lookup name . rsBoundNames
98 case name' of
99 Just name'' -> return name''
100 Nothing -> error $ "Rename scope is missing ident '" ++ showIdent name ++ "'"
102-- |
103-- Finds idents introduced by declarations.
104--
105findDeclIdents :: [Bind Ann] -> [Ident]
106findDeclIdents = concatMap go
107 where
108 go (NonRec _ ident _) = [ident]
109 go (Rec ds) = map (snd . fst) ds
111-- |
112-- Renames within each declaration in a module.
113--
114renameInModules :: [Module Ann] -> [Module Ann]
115renameInModules = map go
116 where
117 go :: Module Ann -> Module Ann
118 go m@(Module _ _ _ _ _ decls) = m { moduleDecls = map (renameInDecl' (findDeclIdents decls)) decls }
120 renameInDecl' :: [Ident] -> Bind Ann -> Bind Ann
121 renameInDecl' scope = runRename scope . renameInDecl True
123-- |
124-- Renames within a declaration. isTopLevel is used to determine whether the
125-- declaration is a module member or appearing within a Let. At the top level
126-- declarations are not renamed or added to the scope (they should already have
127-- been added), whereas in a Let declarations are renamed if their name shadows
128-- another in the current scope.
129--
130renameInDecl :: Bool -> Bind Ann -> Rename (Bind Ann)
131renameInDecl isTopLevel (NonRec a name val) = do
132 name' <- if isTopLevel then return name else updateScope name
133 NonRec a name' <$> renameInValue val
134renameInDecl isTopLevel (Rec ds) = do
135 ds' <- traverse updateNames ds
136 Rec <$> traverse updateValues ds'
137 where
138 updateNames :: ((Ann, Ident), Expr Ann) -> Rename ((Ann, Ident), Expr Ann)
139 updateNames ((a, name), val) = do
140 name' <- if isTopLevel then return name else updateScope name
141 return ((a, name'), val)
142 updateValues :: ((Ann, Ident), Expr Ann) -> Rename ((Ann, Ident), Expr Ann)
143 updateValues (aname, val) = (,) aname <$> renameInValue val
145-- |
146-- Renames within a value.
147--
148renameInValue :: Expr Ann -> Rename (Expr Ann)
149renameInValue (Literal ann l) =
150 Literal ann <$> renameInLiteral renameInValue l
151renameInValue c@(Constructor{}) = return c
152renameInValue (Accessor ann prop v) =
153 Accessor ann prop <$> renameInValue v
154renameInValue (ObjectUpdate ann obj vs) =
155 ObjectUpdate ann <$> renameInValue obj <*> traverse (\(name, v) -> (,) name <$> renameInValue v) vs
156renameInValue e@(Abs (_, _, _, Just IsTypeClassConstructor) _ _) = return e
157renameInValue (Abs ann name v) =
158 newScope $ Abs ann <$> updateScope name <*> renameInValue v
159renameInValue (App ann v1 v2) =
160 App ann <$> renameInValue v1 <*> renameInValue v2
161renameInValue (Var ann (Qualified Nothing name)) =
162 Var ann . Qualified Nothing <$> lookupIdent name
163renameInValue v@(Var{}) = return v
164renameInValue (Case ann vs alts) =
165 newScope $ Case ann <$> traverse renameInValue vs <*> traverse renameInCaseAlternative alts
166renameInValue (Let ann ds v) =
167 newScope $ Let ann <$> traverse (renameInDecl False) ds <*> renameInValue v
169-- |
170-- Renames within literals.
171--
172renameInLiteral :: (a -> Rename a) -> Literal a -> Rename (Literal a)
173renameInLiteral rename (ArrayLiteral bs) = ArrayLiteral <$> traverse rename bs
174renameInLiteral rename (ObjectLiteral bs) = ObjectLiteral <$> traverse (sndM rename) bs
175renameInLiteral _ l = return l
177-- |
178-- Renames within case alternatives.
179--
180renameInCaseAlternative :: CaseAlternative Ann -> Rename (CaseAlternative Ann)
181renameInCaseAlternative (CaseAlternative bs v) = newScope $
182 CaseAlternative <$> traverse renameInBinder bs
183 <*> eitherM (traverse (pairM renameInValue renameInValue)) renameInValue v
185-- |
186-- Renames within binders.
187--
188renameInBinder :: Binder a -> Rename (Binder a)
189renameInBinder n@(NullBinder{}) = return n
190renameInBinder (LiteralBinder ann b) =
191 LiteralBinder ann <$> renameInLiteral renameInBinder b
192renameInBinder (VarBinder ann name) =
193 VarBinder ann <$> updateScope name
194renameInBinder (ConstructorBinder ann tctor dctor bs) =
195 ConstructorBinder ann tctor dctor <$> traverse renameInBinder bs
196renameInBinder (NamedBinder ann name b) =
197 NamedBinder ann <$> updateScope name <*> renameInBinder b