@@ -3,7 +3,7 @@ module Rename (rename) where
5import Control.Arrow (first)
5import Control.Arrow (first)
6−import Control.Monad (ap, liftM, foldM, mapM, Monad)
6+import Control.Monad (ap, liftM, foldM, mapM, Monad, zipWithM)
7import Control.Monad.State (evalState, State, get, put)
7import Control.Monad.State (evalState, State, get, put)
8import Data.Char (isLower)
8import Data.Char (isLower)
@@ -50,9 +50,13 @@ rename' env expr =
51 Let defs e ->
51 Let defs e ->
52 let (fs,argss,es) = unzip3 $ map (\(Definition a b c) -> (a,b,c)) defs in
52 let (fs,argss,es) = unzip3 $ map (\(Definition a b c) -> (a,b,c)) defs in
53− do env' <- foldM (\acc x -> snd `liftM` extend acc x) env fs
53+ do env' <- extends env fs
54+ let combine args e = do env'' <- extends env' args
55+ re <- rename' env'' e
56+ return (map env'' args, re)
57+ defs' <- zipWith (\f -> uncurry $ Definition f) (map env' fs) `liftM` zipWithM combine argss es
54− es' <- mapM (rename' env') es; re <- rename' env' e
58+ re <- rename' env' e
55− return $ Let (zipWith3 Definition (map env' fs) argss es') re
59+ return $ Let defs' re
57 Var x -> return . Var $ env x
61 Var x -> return . Var $ env x
@@ -71,6 +75,9 @@ extend env x = do
71 let rx = map (\c -> if c == '\'' then '_' else c) $ x ++ "_" ++ show n
75 let rx = map (\c -> if c == '\'' then '_' else c) $ x ++ "_" ++ show n
72 return (rx, \y -> if y == x then rx else env y)
76 return (rx, \y -> if y == x then rx else env y)
78+extends :: (String -> String) -> [String] -> GuidCounter (String -> String)
79+extends env xs = foldM (\e x -> liftM snd $ extend e x) env xs
74patternExtend :: Pattern -> (String -> String) -> GuidCounter (Pattern, String -> String)
81patternExtend :: Pattern -> (String -> String) -> GuidCounter (Pattern, String -> String)
75patternExtend pattern env =
82patternExtend pattern env =
76 case pattern of
83 case pattern of