git.iko.soy/rowtype-yoga/purescript-native
on 1d25370 help sign in
rowtype-yoga/purescript-native/src/Language/PureScript/Renamer.hs
177 lines 6.5 kB history raw
1-----------------------------------------------------------------------------
2--
3-- Module : Language.PureScript.Renamer
4-- Copyright : (c) 2013-14 Phil Freeman, (c) 2014 Gary Burgess, and other contributors
5-- License : MIT
6--
7-- Maintainer : Phil Freeman <paf31@cantab.net>
8-- Stability : experimental
9-- Portability :
10--
11-- |
12-- Renaming pass that prevents shadowing of local identifiers.
13--
14-----------------------------------------------------------------------------
16module Language.PureScript.Renamer (renameInModules) where
18import Control.Applicative
19import Control.Monad.State
21import qualified Data.Map as M
23import Language.PureScript.Declarations
24import Language.PureScript.Environment
25import Language.PureScript.Names
26import Language.PureScript.Supply
27import Language.PureScript.Traversals
29type Rename = StateT (M.Map Ident Ident) Supply
31-- |
32-- Create a Rename state value for a scope from a list of idents.
33--
34createScope :: [Ident] -> M.Map Ident Ident
35createScope scopeNames = M.fromList (zip scopeNames scopeNames)
37-- |
38-- Creates a new renaming scope using the current as a basis. Used to backtrack
39-- when leaving an Abs.
40--
41newScope :: Rename a -> Rename a
42newScope x = get >>= lift . evalStateT x
44-- |
45-- Adds a new scope entry for an ident. If the ident is already present, a new
46-- unique name is generated and stored.
47--
48updateScope :: Ident -> Rename Ident
49updateScope name = do
50 name' <- gets $ M.lookup name
51 name'' <- case name' of
52 Just _ -> Ident . (runIdent name ++) <$> lift freshName
53 Nothing -> return name
54 modify $ M.insert name name''
55 return name''
57-- |
58-- Finds the new name to use for an ident.
59--
60lookupIdent :: Ident -> Rename Ident
61lookupIdent name = do
62 name' <- gets $ M.lookup name
63 case name' of
64 Just name'' -> return name''
65 Nothing -> error $ "Rename scope is missing ident '" ++ show name ++ "'"
67-- |
68-- Finds idents introduced by declarations.
69--
70findDeclIdents :: [Declaration] -> [Ident]
71findDeclIdents = concatMap go
72 where
73 go (ValueDeclaration ident _ _ _ _) = [ident]
74 go (BindingGroupDeclaration ds) = map (\(name, _, _) -> name) ds
75 go (ExternDeclaration _ ident _ _) = [ident]
76 go (TypeClassDeclaration _ _ _ ds) = findDeclIdents ds
77 go (PositionedDeclaration _ d) = go d
78 go _ = []
80-- |
81-- Renames within each declaration in a module.
82--
83renameInModules :: [Module] -> [Module]
84renameInModules = map go
85 where
86 go :: Module -> Module
87 go (Module mn decls exps) = Module mn (renameInDecl' (findDeclIdents decls) `map` decls) exps
88 renameInDecl' :: [Ident] -> Declaration -> Declaration
89 renameInDecl' scope = evalSupply 1 . flip evalStateT (createScope scope) . renameInDecl True
91-- |
92-- Renames within a declaration. isTopLevel is used to determine whether the
93-- declaration is a module member or appearing within a Let. At the top level
94-- declarations are not renamed or added to the scope (they should already have
95-- been added), whereas in a Let declarations are renamed if their name shadows
96-- another in the current scope.
97--
98renameInDecl :: Bool -> Declaration -> Rename Declaration
99renameInDecl isTopLevel (ValueDeclaration name nameKind [] Nothing val) = do
100 name' <- if isTopLevel then return name else updateScope name
101 ValueDeclaration name' nameKind [] Nothing <$> renameInValue val
102renameInDecl isTopLevel (BindingGroupDeclaration ds) = do
103 ds' <- mapM updateNames ds
104 BindingGroupDeclaration <$> mapM updateValues ds'
105 where
106 updateNames :: (Ident, NameKind, Value) -> Rename (Ident, NameKind, Value)
107 updateNames (name, nameKind, val) = do
108 name' <- if isTopLevel then return name else updateScope name
109 return (name', nameKind, val)
110 updateValues :: (Ident, NameKind, Value) -> Rename (Ident, NameKind, Value)
111 updateValues (name, nameKind, val) =
112 (,,) name nameKind <$> renameInValue val
113renameInDecl _ (TypeInstanceDeclaration name cs className args ds) =
114 TypeInstanceDeclaration name cs className args <$> mapM (renameInDecl True) ds
115renameInDecl isTopLevel (PositionedDeclaration pos d) =
116 PositionedDeclaration pos <$> renameInDecl isTopLevel d
117renameInDecl _ other = return other
119-- |
120-- Renames within a value.
121--
122renameInValue :: Value -> Rename Value
123renameInValue (UnaryMinus v) =
124 UnaryMinus <$> renameInValue v
125renameInValue (ArrayLiteral vs) =
126 ArrayLiteral <$> mapM renameInValue vs
127renameInValue (ObjectLiteral vs) =
128 ObjectLiteral <$> mapM (\(name, v) -> (,) name <$> renameInValue v) vs
129renameInValue (Accessor prop v) =
130 Accessor prop <$> renameInValue v
131renameInValue (ObjectUpdate obj vs) =
132 ObjectUpdate obj <$> mapM (\(name, v) -> (,) name <$> renameInValue v) vs
133renameInValue (Abs (Left name) v) =
134 newScope $ Abs . Left <$> updateScope name <*> renameInValue v
135renameInValue (App v1 v2) =
136 App <$> renameInValue v1 <*> renameInValue v2
137renameInValue (Var (Qualified Nothing name)) =
138 Var . Qualified Nothing <$> lookupIdent name
139renameInValue (IfThenElse v1 v2 v3) =
140 IfThenElse <$> renameInValue v1 <*> renameInValue v2 <*> renameInValue v3
141renameInValue (Case vs alts) =
142 Case <$> mapM renameInValue vs <*> mapM renameInCaseAlternative alts
143renameInValue (TypedValue check v ty) =
144 TypedValue check <$> renameInValue v <*> pure ty
145renameInValue (Let ds v) =
146 Let <$> mapM (renameInDecl False) ds <*> renameInValue v
147renameInValue (TypeClassDictionaryConstructorApp name v) =
148 TypeClassDictionaryConstructorApp name <$> renameInValue v
149renameInValue (PositionedValue pos v) =
150 PositionedValue pos <$> renameInValue v
151renameInValue v = return v
153-- |
154-- Renames within case alternatives.
155--
156renameInCaseAlternative :: CaseAlternative -> Rename CaseAlternative
157renameInCaseAlternative (CaseAlternative bs g v) =
158 CaseAlternative <$> mapM renameInBinder bs <*> maybeM renameInValue g <*> renameInValue v
160-- |
161-- Renames within binders.
162--
163renameInBinder :: Binder -> Rename Binder
164renameInBinder (VarBinder name) =
165 VarBinder <$> updateScope name
166renameInBinder (ConstructorBinder name bs) =
167 ConstructorBinder name <$> mapM renameInBinder bs
168renameInBinder (ObjectBinder bs) =
169 ObjectBinder <$> mapM (sndM renameInBinder) bs
170renameInBinder (ArrayBinder bs) =
171 ArrayBinder <$> mapM renameInBinder bs
172renameInBinder (ConsBinder b1 b2) =
173 ConsBinder <$> renameInBinder b1 <*> renameInBinder b2
174renameInBinder (NamedBinder name b) =
175 NamedBinder <$> updateScope name <*> renameInBinder b
176renameInBinder (PositionedBinder _ b) = renameInBinder b
177renameInBinder other = return other