From f8fe23fda7b97d5301bfb2ec1d89ce9967c5b200 Mon Sep 17 00:00:00 2001
From: "kr.angelov" <kr.angelov@gmail.com>
Date: Wed, 29 Aug 2012 11:43:02 +0000
Subject: A basic infrastructure for generating Teyjus bytecode from the GF
 abstract syntax

---
 src/compiler/GFC.hs | 28 +++++++++++++++++++++++++++-
 1 file changed, 27 insertions(+), 1 deletion(-)

(limited to 'src/compiler/GFC.hs')

diff --git a/src/compiler/GFC.hs b/src/compiler/GFC.hs
index 3fff0701c..72a986303 100644
--- a/src/compiler/GFC.hs
+++ b/src/compiler/GFC.hs
@@ -18,6 +18,9 @@ import GF.Data.ErrM
 
 import Data.Maybe
 import Data.Binary
+import qualified Data.Map as Map
+import qualified Data.ByteString as BSS
+import qualified Data.ByteString.Lazy as BSL
 import qualified Data.ByteString.Char8 as BS
 import System.FilePath
 import System.IO
@@ -48,6 +51,7 @@ compileSourceFiles opts fs =
          then return ()
          else do pgf <- link opts (identC (BS.pack cnc)) gr
                  writePGF opts pgf
+                 writeByteCode opts pgf
                  writeOutputs opts pgf
 
 compileCFFiles :: Options -> [FilePath] -> IOE ()
@@ -78,9 +82,31 @@ unionPGFFiles opts fs =
 writeOutputs :: Options -> PGF -> IOE ()
 writeOutputs opts pgf = do
   sequence_ [writeOutput opts name str 
-                 | fmt <- flag optOutputFormats opts, 
+                 | fmt <- flag optOutputFormats opts,
+                   fmt /= FmtByteCode,
                    (name,str) <- exportPGF opts fmt pgf]
 
+writeByteCode :: Options -> PGF -> IOE ()
+writeByteCode opts pgf
+  | elem FmtByteCode (flag optOutputFormats opts) =
+             let name = fromMaybe (showCId (abstractName pgf)) (flag optName opts)
+                 file = name <.> "bc"
+                 path = case flag optOutputDir opts of
+                          Nothing  -> file
+                          Just dir -> dir </> file
+             in putPointE Normal opts ("Writing " ++ path ++ "...") $ ioeIO $
+                   bracket
+                      (openFile path WriteMode)
+                      (hClose)
+                      (\h -> do hSetBinaryMode h True
+                                BSL.hPut h (encode addrs)
+                                BSS.hPut h (code (abstract pgf)))
+  | otherwise = return ()
+  where
+    addrs = 
+      [(id,addr) | (id,(_,_,_,_,addr)) <- Map.toList (funs (abstract pgf))] ++
+      [(id,addr) | (id,(_,_,addr))     <- Map.toList (cats (abstract pgf))]
+
 writePGF :: Options -> PGF -> IOE ()
 writePGF opts pgf = do
   let outfile = grammarName opts pgf <.> "pgf"
-- 
cgit v1.2.3