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.

1 files changed, 47 insertions, 0 deletions

diff --git a/src/runtime/haskell/PGF/ByteCode.hs b/src/runtime/haskell/PGF/ByteCode.hs
new file mode 100644
index 000000000..b8e7d889d
--- /dev/null
+++ b/src/runtime/haskell/PGF/ByteCode.hs
@@ -0,0 +1,47 @@
+module PGF.ByteCode(CodeLabel, Instr(..), ppCode, ppInstr) where
+
+import PGF.CId
+import Text.PrettyPrint
+
+type CodeLabel = Int
+
+data Instr
+  = EVAL   {-# UNPACK #-} !Int
+  | CASE CId     {-# UNPACK #-} !CodeLabel
+  | CASE_INT Int    {-# UNPACK #-} !CodeLabel
+  | CASE_STR String {-# UNPACK #-} !CodeLabel
+  | CASE_FLT Double {-# UNPACK #-} !CodeLabel
+  | ALLOC  {-# UNPACK #-} !Int
+  | PUT_CONSTR CId
+  | PUT_CLOSURE   {-# UNPACK #-} !CodeLabel
+  | PUT_INT {-# UNPACK #-} !Int
+  | PUT_STR String
+  | PUT_FLT {-# UNPACK #-} !Double
+  | SET_VALUE {-# UNPACK #-} !Int
+  | SET_VARIABLE    {-# UNPACK #-} !Int
+  | TAIL_CALL    CId
+  | FAIL
+  | RET {-# UNPACK #-} !Int
+
+ppCode :: CodeLabel -> [Instr] -> Doc
+ppCode l []     = empty
+ppCode l (i:is) = ppLabel l <+> ppInstr l i $$ ppCode (l+1) is
+
+ppInstr l (EVAL         n) = text "EVAL        " <+> int n
+ppInstr l (CASE id o     ) = text "CASE        " <+> ppCId id <+> ppLabel (l+o+1)
+ppInstr l (CASE_INT n o  ) = text "CASE_INT    " <+> int n <+> ppLabel (l+o+1)
+ppInstr l (CASE_STR s o  ) = text "CASE_STR    " <+> text (show s) <+> ppLabel (l+o+1)
+ppInstr l (CASE_FLT d o  ) = text "CASE_FLT    " <+> double d <+> ppLabel (l+o+1)
+ppInstr l (ALLOC        n) = text "ALLOC       " <+> int n
+ppInstr l (SET_VALUE    n) = text "SET_VALUE   " <+> int n
+ppInstr l (PUT_CONSTR  id) = text "PUT_CONSTR  " <+> ppCId id
+ppInstr l (PUT_CLOSURE  c) = text "PUT_CLOSURE " <+> ppLabel c
+ppInstr l (PUT_INT n     ) = text "PUT_INT     " <+> int n
+ppInstr l (PUT_STR s     ) = text "PUT_STR     " <+> text (show s)
+ppInstr l (PUT_FLT d     ) = text "PUT_FLT     " <+> double d
+ppInstr l (SET_VARIABLE n) = text "SET_VARIABLE" <+> int n
+ppInstr l (TAIL_CALL   id) = text "TAIL_CALL   " <+> ppCId id
+ppInstr l (FAIL          ) = text "FAIL"
+ppInstr l (RET          n) = text "RET         " <+> int n
+
+ppLabel l = text (let s = show l in replicate (4-length s) '0' ++ s)