git.iko.soy/rowtype-yoga/purescript-native
on 756407e help sign in
rowtype-yoga/purescript-native/src/Language/PureScript/Renamer.hs
185 lines 6.6 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 Data.List (find)
22import qualified Data.Map as M
24import Language.PureScript.Declarations
25import Language.PureScript.Environment
26import Language.PureScript.Names
27import Language.PureScript.Traversals
29type Rename = State (M.Map Ident Ident)
31-- |
32-- Runs renaming starting with a list of idents for the initial scope.
33--
34runRename :: [Ident] -> Rename a -> a
35runRename scope = flip evalState (M.fromList $ zip scope scope)
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 = do
43 scope <- get
44 a <- x
45 put scope
46 return a
48-- |
49-- Adds a new scope entry for an ident. If the ident is already present, a new
50-- unique name is generated and stored.
51--
52updateScope :: Ident -> Rename Ident
53updateScope name = do
54 scope <- get
55 name' <- case M.lookup name scope of
56 Just _ -> do
57 let newNames = map (\i -> Ident (runIdent name ++ "_" ++ show (i :: Int))) [1..]
58 let (Just newName) = find (\nn -> M.lookup nn scope == Nothing) newNames
59 modify $ M.insert newName newName
60 return newName
61 Nothing -> return name
62 modify $ M.insert name name'
63 return name'
65-- |
66-- Finds the new name to use for an ident.
67--
68lookupIdent :: Ident -> Rename Ident
69lookupIdent name = do
70 name' <- gets $ M.lookup name
71 case name' of
72 Just name'' -> return name''
73 Nothing -> error $ "Rename scope is missing ident '" ++ show name ++ "'"
75-- |
76-- Finds idents introduced by declarations.
77--
78findDeclIdents :: [Declaration] -> [Ident]
79findDeclIdents = concatMap go
80 where
81 go (ValueDeclaration ident _ _ _ _) = [ident]
82 go (BindingGroupDeclaration ds) = map (\(name, _, _) -> name) ds
83 go (ExternDeclaration _ ident _ _) = [ident]
84 go (TypeClassDeclaration _ _ _ ds) = findDeclIdents ds
85 go (PositionedDeclaration _ d) = go d
86 go _ = []
88-- |
89-- Renames within each declaration in a module.
90--
91renameInModules :: [Module] -> [Module]
92renameInModules = map go
93 where
94 go :: Module -> Module
95 go (Module mn decls exps) = Module mn (renameInDecl' (findDeclIdents decls) `map` decls) exps
96 renameInDecl' :: [Ident] -> Declaration -> Declaration
97 renameInDecl' scope = runRename scope . renameInDecl True
99-- |
100-- Renames within a declaration. isTopLevel is used to determine whether the
101-- declaration is a module member or appearing within a Let. At the top level
102-- declarations are not renamed or added to the scope (they should already have
103-- been added), whereas in a Let declarations are renamed if their name shadows
104-- another in the current scope.
105--
106renameInDecl :: Bool -> Declaration -> Rename Declaration
107renameInDecl isTopLevel (ValueDeclaration name nameKind [] Nothing val) = do
108 name' <- if isTopLevel then return name else updateScope name
109 ValueDeclaration name' nameKind [] Nothing <$> renameInValue val
110renameInDecl isTopLevel (BindingGroupDeclaration ds) = do
111 ds' <- mapM updateNames ds
112 BindingGroupDeclaration <$> mapM updateValues ds'
113 where
114 updateNames :: (Ident, NameKind, Value) -> Rename (Ident, NameKind, Value)
115 updateNames (name, nameKind, val) = do
116 name' <- if isTopLevel then return name else updateScope name
117 return (name', nameKind, val)
118 updateValues :: (Ident, NameKind, Value) -> Rename (Ident, NameKind, Value)
119 updateValues (name, nameKind, val) =
120 (,,) name nameKind <$> renameInValue val
121renameInDecl _ (TypeInstanceDeclaration name cs className args ds) =
122 TypeInstanceDeclaration name cs className args <$> mapM (renameInDecl True) ds
123renameInDecl isTopLevel (PositionedDeclaration pos d) =
124 PositionedDeclaration pos <$> renameInDecl isTopLevel d
125renameInDecl _ other = return other
127-- |
128-- Renames within a value.
129--
130renameInValue :: Value -> Rename Value
131renameInValue (UnaryMinus v) =
132 UnaryMinus <$> renameInValue v
133renameInValue (ArrayLiteral vs) =
134 ArrayLiteral <$> mapM renameInValue vs
135renameInValue (ObjectLiteral vs) =
136 ObjectLiteral <$> mapM (\(name, v) -> (,) name <$> renameInValue v) vs
137renameInValue (Accessor prop v) =
138 Accessor prop <$> renameInValue v
139renameInValue (ObjectUpdate obj vs) =
140 ObjectUpdate obj <$> mapM (\(name, v) -> (,) name <$> renameInValue v) vs
141renameInValue (Abs (Left name) v) =
142 newScope $ Abs . Left <$> updateScope name <*> renameInValue v
143renameInValue (App v1 v2) =
144 App <$> renameInValue v1 <*> renameInValue v2
145renameInValue (Var (Qualified Nothing name)) =
146 Var . Qualified Nothing <$> lookupIdent name
147renameInValue (IfThenElse v1 v2 v3) =
148 IfThenElse <$> renameInValue v1 <*> renameInValue v2 <*> renameInValue v3
149renameInValue (Case vs alts) =
150 Case <$> mapM renameInValue vs <*> mapM renameInCaseAlternative alts
151renameInValue (TypedValue check v ty) =
152 TypedValue check <$> renameInValue v <*> pure ty
153renameInValue (Let ds v) =
154 Let <$> mapM (renameInDecl False) ds <*> renameInValue v
155renameInValue (TypeClassDictionaryConstructorApp name v) =
156 TypeClassDictionaryConstructorApp name <$> renameInValue v
157renameInValue (PositionedValue pos v) =
158 PositionedValue pos <$> renameInValue v
159renameInValue v = return v
161-- |
162-- Renames within case alternatives.
163--
164renameInCaseAlternative :: CaseAlternative -> Rename CaseAlternative
165renameInCaseAlternative (CaseAlternative bs g v) =
166 newScope $ CaseAlternative <$> mapM renameInBinder bs <*> maybeM renameInValue g <*> renameInValue v
168-- |
169-- Renames within binders.
170--
171renameInBinder :: Binder -> Rename Binder
172renameInBinder (VarBinder name) =
173 VarBinder <$> updateScope name
174renameInBinder (ConstructorBinder name bs) =
175 ConstructorBinder name <$> mapM renameInBinder bs
176renameInBinder (ObjectBinder bs) =
177 ObjectBinder <$> mapM (sndM renameInBinder) bs
178renameInBinder (ArrayBinder bs) =
179 ArrayBinder <$> mapM renameInBinder bs
180renameInBinder (ConsBinder b1 b2) =
181 ConsBinder <$> renameInBinder b1 <*> renameInBinder b2
182renameInBinder (NamedBinder name b) =
183 NamedBinder <$> updateScope name <*> renameInBinder b
184renameInBinder (PositionedBinder _ b) = renameInBinder b
185renameInBinder other = return other