summaryrefslogtreecommitdiff
path: root/bf.hs
diff options
context:
space:
mode:
authorDaniel Silverstone (parasomnia chroot) <dsilvers@digital-scurf.org>2013-04-02 20:53:24 +0100
committerDaniel Silverstone (parasomnia chroot) <dsilvers@digital-scurf.org>2013-04-02 20:53:24 +0100
commit45ff45e0d10fe8f8cae8a781004aa868ec651635 (patch)
tree3b667290edeb4da550323dad9abdb67ca6483e23 /bf.hs
parent93b0fb2d1d0b7126b72aadeed977b042b8ded288 (diff)
downloadbf-45ff45e0d10fe8f8cae8a781004aa868ec651635.tar.bz2
Add LLVM CompilerHEADmaster
Remember, now you have to run this by first doing: $ ghc --make bf Then you can run bf with: $ ./bf -c examples/hello.bf Then you can link the bitcode with: $ llvm-ld -o hello examples/hello.bc And you can run ./hello
Diffstat (limited to 'bf.hs')
-rw-r--r--bf.hs107
1 files changed, 103 insertions, 4 deletions
diff --git a/bf.hs b/bf.hs
index 619707b..d369a87 100644
--- a/bf.hs
+++ b/bf.hs
@@ -7,6 +7,9 @@ import System.Environment
import System.Console.GetOpt
import System.Exit
import Data.Maybe
+import System.FilePath
+import LLVM.Core
+import LLVM.Util.Optimize
data BFInstruction = GoBack | GoForward | Increment | Decrement | Input
| Output | Loop [BFInstruction]
@@ -83,7 +86,7 @@ runInstructions :: [BFInstruction] -> BFRunner
runInstructions = mapM_ runInstruction
--------------------- Options --------------------------------
-data Action = ParseOnly | Interpret deriving (Show, Eq)
+data Action = ParseOnly | Interpret | Bitcode deriving (Show, Eq)
data Options = Options
{ optHelp :: Bool
@@ -112,6 +115,9 @@ options = [ Option ['v'] ["version"]
, Option ['i'] ["interpret"]
(NoArg (\ opts -> opts { optAction = Interpret }))
"parse the input and interpret it"
+ , Option ['c'] ["bitcode"]
+ (NoArg (\ opts -> opts { optAction = Bitcode }))
+ "parse the input and outputs a bitcode file"
]
usage :: String
@@ -126,6 +132,98 @@ bfOptions argv =
(o, _, [] ) -> return (foldl (flip id) defaultOptions o, Nothing)
(_, _, errs) -> ioError $ userError $ concat errs ++ usage
+---------- Compiler ------------
+
+compileBody :: [BFInstruction] -> CodeGenModule (Function (IO Word32))
+compileBody insn = do
+ getc <- newNamedFunction ExternalLinkage "getchar" :: TFunction (IO Word8)
+ putc <- newNamedFunction ExternalLinkage "putchar" :: TFunction (Word8 -> IO ())
+ bzero <- newNamedFunction ExternalLinkage "bzero" :: TFunction (Ptr Word8 -> Word32 -> IO ())
+
+ createNamedFunction ExternalLinkage "main" $ do
+ headp <- alloca
+ tape <- (arrayAlloca (65536 :: Word32)) :: CodeGenFunction r0 (Value (Ptr Word8))
+ store (value zero) headp
+
+ call bzero tape $ valueOf 65536
+
+ let compileInstruction :: BFInstruction -> CodeGenFunction r0 Terminate
+ compileInstruction GoBack = do
+ head' <- load (headp :: Value (Ptr Word16))
+ head'' <- isub head' (1 :: Word16)
+ store head'' headp
+
+ compileInstruction GoForward = do
+ head' <- load (headp :: Value (Ptr Word16))
+ head'' <- iadd head' (1 :: Word16)
+ store head'' headp
+
+ compileInstruction Increment = do
+ head' <- load (headp :: Value (Ptr Word16))
+ head'' <- zext head'
+ vp <- getElementPtr tape ((head'' :: Value Word32), ())
+ val <- load vp
+ val' <- iadd val (1 :: Word8)
+ store val' vp
+
+ compileInstruction Decrement = do
+ head' <- load (headp :: Value (Ptr Word16))
+ head'' <- zext head'
+ vp <- getElementPtr tape ((head'' :: Value Word32), ())
+ val <- load vp
+ val' <- isub val (1 :: Word8)
+ store val' vp
+
+ compileInstruction Input = do
+ head' <- load (headp :: Value (Ptr Word16))
+ head'' <- zext head'
+ vp <- getElementPtr tape ((head'' :: Value Word32), ())
+ c <- call getc
+ store c vp
+
+ compileInstruction Output = do
+ head' <- load (headp :: Value (Ptr Word16))
+ head'' <- zext head'
+ vp <- getElementPtr tape ((head'' :: Value Word32), ())
+ c <- load vp
+ call putc c
+ return ()
+
+ compileInstruction (Loop is') = do
+ loop <- newBasicBlock
+ body <- newBasicBlock
+ exit <- newBasicBlock
+
+ br loop
+
+ defineBasicBlock loop
+
+ head' <- load (headp :: Value (Ptr Word16))
+ head'' <- zext head'
+ vp <- getElementPtr tape ((head'' :: Value Word32), ())
+ c <- load vp
+ t <- cmp CmpNE c (0::Word8)
+ condBr t body exit
+
+ defineBasicBlock body
+ compileInstructions is'
+ br loop
+
+ defineBasicBlock exit
+
+ compileInstructions = mapM_ compileInstruction
+
+ compileInstructions insn
+ ret (0 :: Word32)
+
+
+writeBitcodeFile :: [BFInstruction] -> FilePath -> IO ()
+writeBitcodeFile insns fname = do
+ m <- newModule
+ defineModule m (compileBody insns)
+ optimizeModule 100 m
+ writeBitcodeToFile fname m
+
main :: IO ()
main = do
argv <- getArgs
@@ -147,6 +245,7 @@ main = do
case parse parseInstructions fname' cont of
Left e -> print e
Right insns -> do
- if action == ParseOnly
- then print insns
- else evalStateT (runInstructions insns) (0, M.empty)
+ case action of
+ ParseOnly -> print insns
+ Interpret -> evalStateT (runInstructions insns) (0, M.empty)
+ Bitcode -> writeBitcodeFile insns (replaceExtension fname' ".bc")