Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

+ Alpha Conversion

  • Loading branch information...
commit 3ed5ad94c4d9c886b717e410412b0cea715e0ce5 1 parent 4f704f5
@Averethel authored
View
10 AlphaConvert.hs
@@ -0,0 +1,10 @@
+module AlphaConvert (alphaConvert) where
+ import qualified AlphaConvert.AlphaConvert as AC
+ import AlphaConvert.Counter
+ import AlphaConvert.Env
+ import KNormal.KSyntax
+
+ import Control.Monad.State
+
+ alphaConvert :: KExpr -> KExpr
+ alphaConvert e = fst $ runState (AC.alphaConvert emptyEnv e) emptyState
View
85 AlphaConvert/AlphaConvert.hs
@@ -0,0 +1,85 @@
+{-# LANGUAGE
+ FlexibleContexts
+ #-}
+
+module AlphaConvert.AlphaConvert (alphaConvert) where
+ import AlphaConvert.Env
+ import AlphaConvert.Counter
+
+ import KNormal.KSyntax
+
+ import Control.Monad.State
+
+ convertLet :: MonadState Counter m =>
+ Env -> (String -> String -> String -> KExpr -> KExpr) ->
+ String -> String -> String -> KExpr -> m KExpr
+ convertLet env letC s1 s2 s3 e = do
+ x1' <- freshVar s1
+ x2' <- freshVar s2
+ e' <- alphaConvert (extend (extend env s1 x1') s2 x2') e
+ return $ letC x1' x2' (env `find` s3) e'
+
+ alphaConvert :: MonadState Counter m => Env -> KExpr -> m KExpr
+ alphaConvert env (KEneg s) =
+ return $ KEneg $ env `find` s
+ alphaConvert env (KEload s) =
+ return $ KEload $ env `find` s
+ alphaConvert env (KEadd s1 s2) =
+ return $ KEadd (env `find` s1) $ env `find` s2
+ alphaConvert env (KEsub s1 s2) =
+ return $ KEsub (env `find` s1) $ env `find` s2
+ alphaConvert env (KEmult s1 s2) =
+ return $ KEmult (env `find` s1) $ env `find` s2
+ alphaConvert env (KEdiv s1 s2) =
+ return $ KEdiv (env `find` s1) $ env `find` s2
+ alphaConvert env (KEmod s1 s2) =
+ return $ KEmod (env `find` s1) $ env `find` s2
+ alphaConvert env (KEstore s1 s2) =
+ return $ KEstore (env `find` s1) $ env `find` s2
+ alphaConvert env (KEvar s) =
+ return $ KEvar $ env `find` s
+ alphaConvert env (KEifEq s1 s2 e1 e2) = do
+ e1' <- alphaConvert env e1
+ e2' <- alphaConvert env e2
+ return $ KEifEq (env `find` s1) (env `find` s2) e1' e2'
+ alphaConvert env (KEifLE s1 s2 e1 e2) = do
+ e1' <- alphaConvert env e1
+ e2' <- alphaConvert env e2
+ return $ KEifLE (env `find` s1) (env `find` s2) e1' e2'
+ alphaConvert env (KElet s e1 e2) = do
+ x' <- freshVar s
+ e1' <- alphaConvert env e1
+ e2' <- alphaConvert (extend env s x') e2
+ return $ KElet x' e1' e2'
+ alphaConvert env (KEletRec fd e) = do
+ x' <- freshVar $ name fd
+ mps <- mapM (\x -> do { i <- freshVar x; return (x, i) }) $ args fd
+ let env' = extend env (name fd) x'
+ let env'' = addList env' mps
+ b' <- alphaConvert env'' $ body fd
+ e' <- alphaConvert env' e
+ return $ KEletRec FD{ name = env' `find` name fd,
+ args = map (find env'') $ args fd,
+ body = b' } e'
+ alphaConvert env (KEapply s ss) =
+ return $ KEapply (env `find` s) $ map (find env) ss
+ alphaConvert env (KEpair s1 s2) =
+ return $ KEpair (env `find` s1) $ env `find` s2
+ alphaConvert env (KEcons s1 s2) =
+ return $ KEcons (env `find` s1) $ env `find` s2
+ alphaConvert env (KEletPair s1 s2 s3 e) =
+ convertLet env KEletPair s1 s2 s3 e
+ alphaConvert env (KEletList s1 s2 s3 e) =
+ convertLet env KEletList s1 s2 s3 e
+ alphaConvert env (KEhandle e1 e2) = do
+ e1' <- alphaConvert env e1
+ e2' <- alphaConvert env e2
+ return $ KEhandle e1' e2'
+ alphaConvert env (KEseq e1 e2) = do
+ e1' <- alphaConvert env e1
+ e2' <- alphaConvert env e2
+ return $ KEseq e1' e2'
+ alphaConvert env (KEextFunApp es ss) =
+ return $ KEextFunApp es $ map (find env) ss
+ alphaConvert _ e =
+ return e
View
17 AlphaConvert/Counter.hs
@@ -0,0 +1,17 @@
+{-# LANGUAGE
+ FlexibleContexts
+ #-}
+
+module AlphaConvert.Counter where
+ import Control.Monad.State
+
+ type Counter = Integer
+
+ emptyState :: Counter
+ emptyState = 0
+
+ freshVar :: MonadState Counter m => String -> m String
+ freshVar x = do
+ s <- get
+ put $ s + 1
+ return $ x ++ '_' : show s
View
16 AlphaConvert/Env.hs
@@ -0,0 +1,16 @@
+module AlphaConvert.Env where
+ import Data.Maybe
+
+ type Env = [(String, String)]
+
+ emptyEnv :: Env
+ emptyEnv = []
+
+ find :: Env -> String -> String
+ find e x = fromMaybe x $ x `lookup` e
+
+ extend :: Env -> String -> String -> Env
+ extend env x s = (x, s) : env
+
+ addList :: Env -> [(String, String)] -> Env
+ addList = flip (++)
View
6 Compiler.hs
@@ -1,4 +1,5 @@
module Compiler (compile) where
+ import AlphaConvert
import KNormal
import PatternMatching
import Syntax
@@ -7,4 +8,7 @@ module Compiler (compile) where
compile :: Expr -> Either String KExpr
compile expr = case typeOfExpression emptyEnv expr of
Left er -> Left er
- Right _ -> Right . convertToKNormal . compilePatternMatching $ expr
+ Right _ -> Right .
+ alphaConvert .
+ convertToKNormal .
+ compilePatternMatching $ expr
Please sign in to comment.
Something went wrong with that request. Please try again.