git.iko.soy/elk
on ea05fbe help sign in
elk/src/Rename.hs
88 lines 2.7 kB history raw
1{-# LANGUAGE GeneralizedNewtypeDeriving #-}
2module Rename (rename) where
4import Ast
5import Control.Arrow (first)
6import Control.Monad (ap, liftM, foldM, mapM, Monad)
7import Control.Monad.State (evalState, State, get, put)
8import Data.Char (isLower)
9import Guid
11rename :: Expr -> Expr
12rename = run . rename' id
14rename' :: (String -> String) -> Expr -> GuidCounter Expr
15rename' env expr =
16 case expr of
18 Range e1 e2 -> Range `liftM` rnm e1
19 `ap` rnm e2
21 Access e x -> Access `liftM` rnm e
22 `ap` return x
24 Binop op@(h:_) e1 e2 ->
25 let rop = if isLower h || '_' == h
26 then env op
27 else op
28 in Binop rop `liftM` rnm e1
29 `ap` rnm e2
31 Lambda x e -> do
32 (rx, env') <- extend env x
33 Lambda rx `liftM` rename' env' e
35 App e1 e2 -> App `liftM` rnm e1
36 `ap` rnm e2
38 If e1 e2 e3 -> If `liftM` rnm e1
39 `ap` rnm e2
40 `ap` rnm e3
42 Lift e es -> Lift `liftM` rnm e
43 `ap` mapM rnm es
45 Fold e1 e2 e3 -> Fold `liftM` rnm e1
46 `ap` rnm e2
47 `ap` rnm e3
49 Async e -> Async `liftM` rnm e
51 Let defs e -> do
52 let (vs,es) = unzip defs
53 env' <- foldM (\acc x -> snd `liftM` extend acc x) env vs
54 es' <- mapM (rename' env') es; re <- rename' env' e
55 return $ Let (zip (map env' vs) es') re
57 Var x -> return . Var $ env x
59 Data name es -> Data name `liftM` mapM rnm es
61 Case e cases -> Case `liftM` rnm e
62 `ap` mapM (patternRename env) cases
64 _ -> return expr
66 where rnm = rename' env
68extend :: (String -> String) -> String -> GuidCounter (String, String -> String)
69extend env x = do
70 n <- guid
71 let rx = x ++ "_" ++ show n
72 return (rx, \y -> if y == x then rx else env y)
74patternExtend :: Pattern -> (String -> String) -> GuidCounter (Pattern, String -> String)
75patternExtend pattern env =
76 case pattern of
77 PAnything -> return (PAnything, env)
78 PVar x -> first PVar `liftM` extend env x
79 PData name ps ->
80 first (PData name . reverse) `liftM` foldM f ([], env) ps
81 where f (rps,env') p = do (rp,env'') <- patternExtend p env'
82 return (rp:rps, env'')
84patternRename :: (String -> String) -> (Pattern, Expr) -> GuidCounter (Pattern, Expr)
85patternRename env (p,e) = do
86 (rp,env') <- patternExtend p env
87 re <- rename' env' e
88 return (rp,re)