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