Skip to content
Browse files

+ Function inlining

  • Loading branch information...
1 parent ac49579 commit 71c33365c63fa352106fc090c2ec0abade61a9b8 @Averethel committed Feb 19, 2013
Showing with 67 additions and 6 deletions.
  1. +7 −6 Compiler.hs
  2. +11 −0 Inline.hs
  3. +49 −0 Inline/Inline.hs
View
13 Compiler.hs
@@ -1,24 +1,25 @@
module Compiler (compile) where
import AlphaConvert
import BetaReduce
+ import Inline
import KNormal
import LetFlatten
import PatternMatching
import Syntax
import TypeInference
- compiler :: Expr -> IO KExpr
- compiler e0 = do
+ compiler :: Integer -> Expr -> IO KExpr
+ compiler t e0 = do
let e1 = compilePatternMatching e0
let e2 = convertToKNormal e1
let e3 = alphaConvert e2
e4 <- betaReduce e3
let e5 = letFlatten e4
- return e5
+ inline t e5
- compile :: Expr -> IO (Either String KExpr)
- compile expr = case typeOfExpression emptyEnv expr of
+ compile :: Integer -> Expr -> IO (Either String KExpr)
+ compile inlineTreshold expr = case typeOfExpression emptyEnv expr of
Left er -> return $ Left er
Right _ -> do
- c <- compiler expr
+ c <- compiler inlineTreshold expr
return $ Right c
View
11 Inline.hs
@@ -0,0 +1,11 @@
+module Inline (inline, defaultTreshold) where
+ import Inline.Env
+ import qualified Inline.Inline as I
+
+ import KNormal.KSyntax
+
+ defaultTreshold :: Integer
+ defaultTreshold = 0
+
+ inline :: Integer -> KExpr -> IO KExpr
+ inline = I.inline emptyEnv
View
49 Inline/Inline.hs
@@ -0,0 +1,49 @@
+module Inline.Inline where
+ import Inline.Env
+ import Inline.Size
+
+ import KNormal.KSyntax
+ import AlphaConvert
+
+ inline :: Env -> Integer -> KExpr -> IO KExpr
+ inline env trs (KEifEq s1 s2 e1 e2) = do
+ e1' <- inline env trs e1
+ e2' <- inline env trs e2
+ return $ KEifEq s1 s2 e1' e2'
+ inline env trs (KEifLE s1 s2 e1 e2) = do
+ e1' <- inline env trs e1
+ e2' <- inline env trs e2
+ return $ KEifLE s1 s2 e1' e2'
+ inline env trs (KElet s e1 e2) = do
+ e1' <- inline env trs e1
+ e2' <- inline env trs e2
+ return $ KElet s e1' e2'
+ inline env trs (KEletRec fd e) = do
+ b' <- inline env trs $ body fd
+ e' <- inline env' trs e
+ return $ KEletRec fd { body = b' } e'
+ where
+ env'
+ | size (body fd) > trs = env
+ | otherwise = env `extend` fd
+ inline env trs (KEapply s ss)
+ | s `member` env = do
+ putStrLn $ "Inlining " ++ show s ++ "."
+ let (fas, b) = env `find` s
+ inline env trs $ alphaConvertWithEnv (zip fas ss) b
+ inline env trs (KEletPair s1 s2 s3 e) = do
+ e' <- inline env trs e
+ return $ KEletPair s1 s2 s3 e'
+ inline env trs (KEletList s1 s2 s3 e) = do
+ e' <- inline env trs e
+ return $ KEletList s1 s2 s3 e'
+ inline env trs (KEhandle e1 e2) = do
+ e1' <- inline env trs e1
+ e2' <- inline env trs e2
+ return $ KEhandle e1' e2'
+ inline env trs (KEseq e1 e2) = do
+ e1' <- inline env trs e1
+ e2' <- inline env trs e2
+ return $ KEseq e1' e2'
+ inline _ _ e =
+ return e

0 comments on commit 71c3336

Please sign in to comment.
Something went wrong with that request. Please try again.