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