git.iko.soy/elk
on master help sign in
Switch to using (Map String String) instead of (String -> String) as the environment.
c158155Evan Czaplicki
compiler/SourceSyntax/Rename.hs+30−23
compare with master
unifiedsplit
@@ -5,6 +5,7 @@ import Control.Arrow (first)
5import Control.Monad (ap, liftM, foldM, mapM, Monad, zipWithM)
5import Control.Monad (ap, liftM, foldM, mapM, Monad, zipWithM)
6import Control.Monad.State (evalState, State, get, put)
6import Control.Monad.State (evalState, State, get, put)
7import Data.Char (isLower,isDigit)
7import Data.Char (isLower,isDigit)
8+import qualified Data.Map as Map
8import Unique
9import Unique
9import SourceSyntax.Location
10import SourceSyntax.Location
10import SourceSyntax.Pattern
11import SourceSyntax.Pattern
@@ -17,10 +18,16 @@ derename var
17 | otherwise = var
18 | otherwise = var
18
19
19renameModule :: Module t v -> Module t v
20renameModule :: Module t v -> Module t v
20−renameModule modul = run (rename deprime modul)
21+renameModule modul = run (rename Map.empty modul)
22+
23+type Env = Map.Map String String
24+
25+replace :: Env -> String -> String
26+replace env v =
27+ Map.findWithDefault (deprime v) v env
21
28
22class Rename a where
29class Rename a where
23− rename :: (String -> String) -> a -> Unique a
30+ rename :: Env -> a -> Unique a
24
31
25instance Rename (Module t v) where
32instance Rename (Module t v) where
26 rename env (Module name ex im stmts) = do stmts' <- renameStmts env stmts
33 rename env (Module name ex im stmts) = do stmts' <- renameStmts env stmts
@@ -29,11 +36,11 @@ instance Rename (Module t v) where
29instance Rename (Def t v) where
36instance Rename (Def t v) where
30 rename env (OpDef op a1 a2 e) =
37 rename env (OpDef op a1 a2 e) =
31 do env' <- extends env [a1,a2]
38 do env' <- extends env [a1,a2]
32− OpDef op (env' a1) (env' a2) `liftM` rename env' e
39+ OpDef op (replace env' a1) (replace env' a2) `liftM` rename env' e
33 rename env (FnDef f args e) =
40 rename env (FnDef f args e) =
34 do env' <- extends env args
41 do env' <- extends env args
35− FnDef (env f) (map env' args) `liftM` rename env' e
42+ FnDef (replace env f) (map (replace env') args) `liftM` rename env' e
36− rename env (TypeAnnotation n t) = return (TypeAnnotation (env n) t)
43+ rename env (TypeAnnotation n t) = return (TypeAnnotation (replace env n) t)
37
44
38
45
39instance Rename (Declaration t v) where
46instance Rename (Declaration t v) where
@@ -41,13 +48,13 @@ instance Rename (Declaration t v) where
41 case stmt of
48 case stmt of
42 Definition def -> Definition `liftM` rename env def
49 Definition def -> Definition `liftM` rename env def
43 Datatype name args tcs ->
50 Datatype name args tcs ->
44− return $ Datatype name args $ map (first env) tcs
51+ return $ Datatype name args $ map (first $ replace env) tcs
45 TypeAlias n xs t -> return (TypeAlias n xs t)
52 TypeAlias n xs t -> return (TypeAlias n xs t)
46 ImportEvent js base elm tipe ->
53 ImportEvent js base elm tipe ->
47 do base' <- rename env base
54 do base' <- rename env base
48− return $ ImportEvent js base' (env elm) tipe
55+ return $ ImportEvent js base' (replace env elm) tipe
49 ExportEvent js elm tipe ->
56 ExportEvent js elm tipe ->
50− return $ ExportEvent js (env elm) tipe
57+ return $ ExportEvent js (replace env elm) tipe
51
58
52renameStmts env stmts = do env' <- extends env $ concatMap getNames stmts
59renameStmts env stmts = do env' <- extends env $ concatMap getNames stmts
53 mapM (rename env') stmts
60 mapM (rename env') stmts
@@ -80,13 +87,14 @@ instance Rename (Expr t v) where
80 `ap` mapM (\(x,e) -> (,) x `liftM` rnm e) fs
87 `ap` mapM (\(x,e) -> (,) x `liftM` rnm e) fs
81
88
82 Record fs -> Record `liftM` mapM frnm fs
89 Record fs -> Record `liftM` mapM frnm fs
83− where frnm (f,as,e) = do env' <- extends env as
90+ where frnm (f,as,e) = do
91+ env' <- extends env as
84− e' <- rename env' e
92+ e' <- rename env' e
85− return (f, map env' as, e')
93+ return (f, map (replace env') as, e')
86
94
87 Binop op@(h:_) e1 e2 ->
95 Binop op@(h:_) e1 e2 ->
88 let rop = if isLower h || '_' == h
96 let rop = if isLower h || '_' == h
89− then env op
97+ then replace env op
90 else op
98 else op
91 in Binop rop `liftM` rnm e1
99 in Binop rop `liftM` rnm e1
92 `ap` rnm e2
100 `ap` rnm e2
@@ -104,7 +112,7 @@ instance Rename (Expr t v) where
104
112
105 Let defs e -> renameLet env defs e
113 Let defs e -> renameLet env defs e
106
114
107− Var x -> return . Var $ env x
115+ Var x -> return $ Var (replace env x)
108
116
109 Data name es -> Data name `liftM` mapM rnm es
117 Data name es -> Data name `liftM` mapM rnm es
110
118
@@ -117,20 +125,21 @@ instance Rename (Expr t v) where
117
125
118deprime = map (\c -> if c == '\'' then '$' else c)
126deprime = map (\c -> if c == '\'' then '$' else c)
119
127
120−extend :: (String -> String) -> String -> Unique (String, String -> String)
128+extend :: Env -> String -> Unique (String, Env)
121extend env x = do
129extend env x = do
122 n <- guid
130 n <- guid
123 let rx = deprime x ++ "_" ++ show n
131 let rx = deprime x ++ "_" ++ show n
124− return (rx, \y -> if y == x then rx else env y)
132+ return (rx, Map.insert x rx env)
125
133
126−extends :: (String -> String) -> [String] -> Unique (String -> String)
134+extends :: Env -> [String] -> Unique Env
127extends env xs = foldM (\e x -> liftM snd $ extend e x) env xs
135extends env xs = foldM (\e x -> liftM snd $ extend e x) env xs
128
136
129−patternExtend :: Pattern -> (String -> String) -> Unique (Pattern, String -> String)
137+patternExtend :: Pattern -> Env -> Unique (Pattern, Env)
130patternExtend pattern env =
138patternExtend pattern env =
131 case pattern of
139 case pattern of
140+ PLiteral _ -> return (pattern, env)
132− PAnything -> return (PAnything, env)
141+ PAnything -> return (pattern, env)
133− PVar x -> first PVar `liftM` extend env x
142+ PVar x -> first PVar `liftM` extend env x
134 PAlias x p -> do
143 PAlias x p -> do
135 (x', env') <- extend env x
144 (x', env') <- extend env x
136 (p', env'') <- patternExtend p env'
145 (p', env'') <- patternExtend p env'
@@ -140,11 +149,9 @@ patternExtend pattern env =
140 where f (rps,env') p = do (rp,env'') <- patternExtend p env'
149 where f (rps,env') p = do (rp,env'') <- patternExtend p env'
141 return (rp:rps, env'')
150 return (rp:rps, env'')
142 PRecord fs ->
151 PRecord fs ->
143− return (pattern, foldr (\f e n -> if n == f then f else env n) env fs)
152+ return (pattern, Map.union (Map.fromList $ map (\f -> (f,f)) fs) env)
144
153
145−patternRename :: (String -> String)
146− -> (Pattern, LExpr t v)
147− -> Unique (Pattern, LExpr t v)
154+patternRename :: Env -> (Pattern, LExpr t v) -> Unique (Pattern, LExpr t v)
148patternRename env (p,e) = do
155patternRename env (p,e) = do
149 (rp,env') <- patternExtend p env
156 (rp,env') <- patternExtend p env
150 re <- rename env' e
157 re <- rename env' e