summaryrefslogtreecommitdiff
path: root/Main.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Main.hs')
-rw-r--r--Main.hs77
1 files changed, 31 insertions, 46 deletions
diff --git a/Main.hs b/Main.hs
index 2173653..e3ed454 100644
--- a/Main.hs
+++ b/Main.hs
@@ -1,17 +1,14 @@
module Main where
import Control.Monad
-import qualified Data.Map.Strict as Map
-import qualified Data.Set as Set
import System.Environment
import System.Exit
import Compiler
import CompilerMacros
-import Intermediate
-import Liveness
import Optimiser
import Parser
+import Stackify
import VM
@@ -20,57 +17,26 @@ usage = do
progname <- getProgName
putStrLn $ "Usage: " ++ progname ++ " [-h] [-ast] [-ir] [filename.lisp]"
putStrLn $ "When no filename is given, will read from stdin."
- putStrLn $ " -h Show this help"
- putStrLn $ " -ast Print AST after compiler macro's"
- putStrLn $ " -ir Print IR after optimisation"
+ putStrLn $ " -h Show this help"
+ putStrLn $ " -ast Print AST after compiler macro's"
+ putStrLn $ " -irpre Print IR after optimisation, before stackification"
+ putStrLn $ " -ir Print IR after optimisation and stackification"
-data Options = Options { optAST :: Bool, optIR :: Bool }
+data Options = Options { optAST :: Bool, optIRPre :: Bool, optIR :: Bool }
+-- TODO: clean this function up
parseOptions' :: (Options, Maybe FilePath) -> [String] -> IO (Options, Maybe FilePath)
parseOptions' pair [] = return pair
parseOptions' _ ("-h":_) = usage >> exitSuccess
parseOptions' (opt, fp) ("-ast":as) = parseOptions' (opt { optAST = True }, fp) as
+parseOptions' (opt, fp) ("-irpre":as) = parseOptions' (opt { optIRPre = True }, fp) as
parseOptions' (opt, fp) ("-ir":as) = parseOptions' (opt { optIR = True }, fp) as
parseOptions' _ (('-':a):_) = putStrLn ("Unknown option '" ++ a ++ "'") >> usage >> exitFailure
parseOptions' (opt, Nothing) (f:as) = parseOptions' (opt, Just f) as
parseOptions' (_, Just _) (_:_) = putStrLn "At most one filename argument expected" >> usage >> exitFailure
parseOptions :: [String] -> IO (Options, Maybe FilePath)
-parseOptions = parseOptions' (Options False False, Nothing)
-
--- TODO: Note about stackification. Temporaries need to be pushed before
--- a call if they're live after it and they could, conceivably, be wrongly
--- mutated by the called function otherwise. This has a couple of
--- interesting consequences:
--- 1. No temporaries ever need to be pushed from the global context, or
--- "main function", since they can never be wrongly mutated: that
--- requires re-entering the function in which they were defined, but one
--- can never re-enter the "main function".
--- 2. No temporaries ever need to be pushed before a tail call; since no
--- local variables are live after it (obviously). (Global variables are
--- covered by point (1.).)
-liveness :: IRProgram -> Map.Map Int [Set.Set Int]
-liveness (IRProgram bbs _ _) =
- let sets = livenessAnalysis bbs bidOf itemsOf outEdges fread fwrite
- in Map.fromList (zip (map bidOf bbs) sets)
- where
- itemsOf (BB _ inss term) = map Right inss ++ [Left term]
- fread (Right (_, IAssign r)) = collect [r]
- fread (Right (_, IParam _)) = []
- fread (Right (_, IClosure _)) = []
- fread (Right (_, IData _)) = []
- fread (Right (_, ICallC r rs)) = collect (r : rs)
- fread (Right (_, IAllocClo _ rs)) = collect rs
- fread (Right (_, IDiscard r)) = collect [r]
- fread (Left (IBr r _ _)) = collect [r]
- fread (Left (IJmp _)) = []
- fread (Left (IRet r)) = collect [r]
- fread (Left (ITailC r rs)) = collect (r : rs)
- fread (Left IExit) = []
- fread (Left IUnknown) = []
- fwrite (Right (r, _)) = collect [r]
- fwrite (Left _) = []
- collect rs = [i | RTemp i <- rs]
+parseOptions = parseOptions' (Options False False False, Nothing)
main :: IO ()
main = do
@@ -78,10 +44,29 @@ main = do
source <- maybe getContents readFile mfname
prog <- parseProgram mfname source >>= either (die . show) return
+
let prog' = compilerMacros prog
when (optAST opts) $ print prog'
+
irprog <- either die return (compileProgram prog')
+
let opt = optimise irprog
- when (optIR opts) $ print opt
- print (liveness opt)
- vmRun opt
+ when (optIRPre opts) $ print opt
+
+ let optS = stackify opt
+ when (optIR opts) $ print optS
+
+ -- TODO: do we want to run the optimiser again now? In a situation as
+ -- follows, stuff might be inlined still:
+ -- t2 <- assign t1
+ -- push [t2] ; could've been push [t1]
+ -- callc ...
+ -- pop [t2]
+ -- ... use t2 again ...
+
+ -- TODO: this raises the question of using liveness for optimisation.
+ -- In the example above, the pop instruction writes to t2, breaking up
+ -- its lifetime, so that the assignment becomes dead. The current
+ -- optimiser would not be able to catch this.
+
+ vmRun optS