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