From 584d589041f63fdd3ea777019679275657902c2d Mon Sep 17 00:00:00 2001
From: "kr.angelov" <kr.angelov@gmail.com>
Date: Mon, 11 Aug 2014 10:59:10 +0000
Subject: a partial support for def rules in the C runtime

The def rules are now compiled to byte code by the compiler and then to
native code by the JIT compiler in the runtime. Not all constructions
are implemented yet. The partial implementation is now in the repository
but it is not activated by default since this requires changes in the
PGF format. I will enable it only after it is complete.
---
 src/runtime/haskell/PGF/Binary.hs | 32 +++++++++++++++++++++++++-------
 1 file changed, 25 insertions(+), 7 deletions(-)

(limited to 'src/runtime/haskell/PGF/Binary.hs')

diff --git a/src/runtime/haskell/PGF/Binary.hs b/src/runtime/haskell/PGF/Binary.hs
index 4d4c53102..b2bfda069 100644
--- a/src/runtime/haskell/PGF/Binary.hs
+++ b/src/runtime/haskell/PGF/Binary.hs
@@ -3,12 +3,12 @@ module PGF.Binary(putSplitAbs) where
 import PGF.CId
 import PGF.Data
 import PGF.Optimize
+import PGF.ByteCode
 import qualified PGF.OldBinary as Old
 import Data.Binary
 import Data.Binary.Put
 import Data.Binary.Get
 import Data.Array.IArray
-import qualified Data.ByteString as BS
 import qualified Data.Map as Map
 import qualified Data.IntMap as IntMap
 --import qualified Data.Set as Set
@@ -43,16 +43,15 @@ instance Binary CId where
   get    = liftM CId get
 
 instance Binary Abstr where
-  put abs = put (aflags abs, 
-                 fmap (\(w,x,y,z,_) -> (w,x,y,z)) (funs abs),
-                 fmap (\(x,y,z,_) -> (x,y,z)) (cats abs))
+  put abs = do put (aflags abs)
+               put (Map.map (\(ty,arity,mb_eq,prob) -> (ty,arity,fmap fst mb_eq,prob)) (funs abs))
+               put (cats abs)
   get = do aflags <- get
            funs <- get
            cats <- get
            return (Abstr{ aflags=aflags
-                        , funs=fmap (\(w,x,y,z) -> (w,x,y,z,0)) funs
-                        , cats=fmap (\(x,y,z) -> (x,y,z,0)) cats
-                        , code=BS.empty                        
+                        , funs=Map.map (\(ty,arity,mb_eq,prob) -> (ty,arity,fmap (\eq -> (eq,[])) mb_eq,prob)) funs
+                        , cats=cats
                         })
 
 putSplitAbs :: PGF -> Put
@@ -136,6 +135,25 @@ instance Binary Equation where
   put (Equ ps e) = put (ps,e)
   get = liftM2 Equ get get
 
+instance Binary Instr where
+  put (EVAL         n) = putWord8 0  >> put n
+  put (CASE id l     ) = putWord8 1  >> put (id,l)
+  put (CASE_INT n l  ) = putWord8 2  >> put (n,l)
+  put (CASE_STR s l  ) = putWord8 3  >> put (s,l)
+  put (CASE_FLT d l  ) = putWord8 4  >> put (d,l)
+  put (ALLOC        n) = putWord8 5  >> put n
+  put (PUT_CONSTR  id) = putWord8 6  >> put id
+  put (PUT_CLOSURE  l) = putWord8 7  >> put l
+  put (PUT_INT      n) = putWord8 8  >> put n
+  put (PUT_STR      s) = putWord8 9  >> put s
+  put (PUT_FLT      d) = putWord8 10 >> put d
+  put (SET_VALUE    n) = putWord8 11 >> put n
+  put (SET_VARIABLE n) = putWord8 12 >> put n
+  put (TAIL_CALL   id) = putWord8 13 >> put id
+  put (FAIL          ) = putWord8 14
+  put (RET          n) = putWord8 15 >> put n
+
+
 instance Binary Type where
   put (DTyp hypos cat exps) = put (hypos,cat,exps)
   get = liftM3 DTyp get get get
-- 
cgit v1.2.3