@@ -5,6 +5,7 @@ import Control.Arrow (first)
55import Control.Monad (ap, liftM, foldM, mapM, Monad, zipWithM)
66import Control.Monad.State (evalState, State, get, put)
77import Data.Char (isLower,isDigit)
8+import qualified Data.Map as Map
89import Unique
910import SourceSyntax.Location
1011import SourceSyntax.Pattern
@@ -17,10 +18,16 @@ derename var
1718 | otherwise = var
1819
1920renameModule :: 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
2128
2229class Rename a where
23− rename :: (String -> String) -> a -> Unique a
30+ rename :: Env -> a -> Unique a
2431
2532instance Rename (Module t v) where
2633 rename env (Module name ex im stmts) = do stmts' <- renameStmts env stmts
@@ -29,11 +36,11 @@ instance Rename (Module t v) where
2936instance Rename (Def t v) where
3037 rename env (OpDef op a1 a2 e) =
3138 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
3340 rename env (FnDef f args e) =
3441 do env' <- extends env args
35− FnDef (env f) (map env' args) `liftM` rename env' e
36− rename env (TypeAnnotation n t) = return (TypeAnnotation (env n) t)
42+ FnDef (replace env f) (map (replace env') args) `liftM` rename env' e
43+ rename env (TypeAnnotation n t) = return (TypeAnnotation (replace env n) t)
3744
3845
3946instance Rename (Declaration t v) where
@@ -41,13 +48,13 @@ instance Rename (Declaration t v) where
4148 case stmt of
4249 Definition def -> Definition `liftM` rename env def
4350 Datatype name args tcs ->
44− return $ Datatype name args $ map (first env) tcs
51+ return $ Datatype name args $ map (first $ replace env) tcs
4552 TypeAlias n xs t -> return (TypeAlias n xs t)
4653 ImportEvent js base elm tipe ->
4754 do base' <- rename env base
48− return $ ImportEvent js base' (env elm) tipe
55+ return $ ImportEvent js base' (replace env elm) tipe
4956 ExportEvent js elm tipe ->
50− return $ ExportEvent js (env elm) tipe
57+ return $ ExportEvent js (replace env elm) tipe
5158
5259renameStmts env stmts = do env' <- extends env $ concatMap getNames stmts
5360 mapM (rename env') stmts
@@ -80,13 +87,14 @@ instance Rename (Expr t v) where
8087 `ap` mapM (\(x,e) -> (,) x `liftM` rnm e) fs
8188
8289 Record fs -> Record `liftM` mapM frnm fs
83− where frnm (f,as,e) = do env' <- extends env as
84− e' <- rename env' e
85− return (f, map env' as, e')
90+ where frnm (f,as,e) = do
91+ env' <- extends env as
92+ e' <- rename env' e
93+ return (f, map (replace env') as, e')
8694
8795 Binop op@(h:_) e1 e2 ->
8896 let rop = if isLower h || '_' == h
89− then env op
97+ then replace env op
9098 else op
9199 in Binop rop `liftM` rnm e1
92100 `ap` rnm e2
@@ -104,7 +112,7 @@ instance Rename (Expr t v) where
104112
105113 Let defs e -> renameLet env defs e
106114
107− Var x -> return . Var $ env x
115+ Var x -> return $ Var (replace env x)
108116
109117 Data name es -> Data name `liftM` mapM rnm es
110118
@@ -117,20 +125,21 @@ instance Rename (Expr t v) where
117125
118126deprime = map (\c -> if c == '\'' then '$' else c)
119127
120−extend :: (String -> String) -> String -> Unique (String, String -> String)
128+extend :: Env -> String -> Unique (String, Env)
121129extend env x = do
122130 n <- guid
123131 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)
125133
126−extends :: (String -> String) -> [String] -> Unique (String -> String)
134+extends :: Env -> [String] -> Unique Env
127135extends env xs = foldM (\e x -> liftM snd $ extend e x) env xs
128136
129−patternExtend :: Pattern -> (String -> String) -> Unique (Pattern, String -> String)
137+patternExtend :: Pattern -> Env -> Unique (Pattern, Env)
130138patternExtend pattern env =
131139 case pattern of
132− PAnything -> return (PAnything, env)
133− PVar x -> first PVar `liftM` extend env x
140+ PLiteral _ -> return (pattern, env)
141+ PAnything -> return (pattern, env)
142+ PVar x -> first PVar `liftM` extend env x
134143 PAlias x p -> do
135144 (x', env') <- extend env x
136145 (p', env'') <- patternExtend p env'
@@ -140,11 +149,9 @@ patternExtend pattern env =
140149 where f (rps,env') p = do (rp,env'') <- patternExtend p env'
141150 return (rp:rps, env'')
142151 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)
144153
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)
148155patternRename env (p,e) = do
149156 (rp,env') <- patternExtend p env
150157 re <- rename env' e