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