summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorkr.angelov <kr.angelov@gmail.com>2014-10-31 14:16:11 +0000
committerkr.angelov <kr.angelov@gmail.com>2014-10-31 14:16:11 +0000
commitb1e6a21c56c5aef62716c35546d4596e11bbbf94 (patch)
tree2436602f1eb48f198ebab5ad389a4ea027415f8d
parent9b0f354c7cef175c172edae582dcfa48817db7ba (diff)
now (+) in the abstract syntax works, i.e. it knows how to deal with partial sums
-rw-r--r--src/compiler/GF/Compile/GenerateBC.hs45
-rw-r--r--src/runtime/c/pgf/data.h4
-rw-r--r--src/runtime/c/pgf/evaluator.c157
-rw-r--r--src/runtime/c/pgf/evaluator.h34
-rw-r--r--src/runtime/c/pgf/jit.c98
-rw-r--r--src/runtime/haskell/PGF/Binary.hs6
-rw-r--r--src/runtime/haskell/PGF/ByteCode.hs4
7 files changed, 322 insertions, 26 deletions
diff --git a/src/compiler/GF/Compile/GenerateBC.hs b/src/compiler/GF/Compile/GenerateBC.hs
index 44e28ec1c..35ae11f02 100644
--- a/src/compiler/GF/Compile/GenerateBC.hs
+++ b/src/compiler/GF/Compile/GenerateBC.hs
@@ -86,7 +86,7 @@ mkFail arity st1 (Just (st0,l))
| otherwise = [JUMP l]
compileBody gr arity st vs e bs =
- let eval fun args
+ let eval st fun args
| arity == 0 = let (st1,is) = pushArgs (st+2) (reverse args)
fun' = shiftIVal st1 fun
in [PUSH_FRAME]++is++[EVAL fun' UpdateCall]
@@ -97,7 +97,7 @@ compileBody gr arity st vs e bs =
compileFun gr eval st vs (Abs _ x e) h0 bs args =
let (h1,bs1,arg,is1) = compileLambda gr st vs [x] e h0 bs
- in (h1,bs1,is1++eval arg args)
+ in (h1,bs1,is1++eval st arg args)
compileFun gr eval st vs (App e1 e2) h0 bs args =
let (h1,bs1,arg,is1) = compileArg gr st vs e2 h0 bs
(h2,bs2,is2) = compileFun gr eval st vs e1 h1 bs1 (arg:args)
@@ -105,7 +105,7 @@ compileFun gr eval st vs (App e1 e2) h0 bs args =
compileFun gr eval st vs (Q (m,id)) h0 bs args =
case lookupAbsDef gr m id of
Ok (_,Just _)
- -> (h0,bs,eval (GLOBAL (i2i id)) args)
+ -> (h0,bs,eval st (GLOBAL (i2i id)) args)
_ -> let Ok ty = lookupFunType gr m id
(ctxt,_,_) = typeForm ty
c_arity = length ctxt
@@ -114,9 +114,9 @@ compileFun gr eval st vs (Q (m,id)) h0 bs args =
diff = c_arity-n_args
in if diff <= 0
then if n_args == 0
- then (h0,bs,eval (GLOBAL (i2i id)) [])
+ then (h0,bs,eval st (GLOBAL (i2i id)) [])
else let h1 = h0 + 2 + n_args
- in (h1,bs,PUT_CONSTR (i2i id):is1++eval (HEAP h0) [])
+ in (h1,bs,PUT_CONSTR (i2i id):is1++eval st (HEAP h0) [])
else let h1 = h0 + 1 + n_args
is2 = [SET (FREE_VAR i) | i <- [0..n_args-1]] ++ [SET (ARG_VAR (i+1)) | i <- [0..diff-1]]
b = CHECK_ARGS diff :
@@ -126,34 +126,43 @@ compileFun gr eval st vs (Q (m,id)) h0 bs args =
TUCK (ARG_VAR 0) diff :
EVAL (HEAP h0) (TailCall diff) :
[]
- in (h1,b:bs,PUT_CLOSURE (length bs):is1++eval (HEAP h0) [])
+ in (h1,b:bs,PUT_CLOSURE (length bs):is1++eval st (HEAP h0) [])
compileFun gr eval st vs (QC qid) h0 bs args =
compileFun gr eval st vs (Q qid) h0 bs args
compileFun gr eval st vs (Vr x) h0 bs args =
- (h0,bs,eval (getVar vs x) args)
+ (h0,bs,eval st (getVar vs x) args)
compileFun gr eval st vs (EInt n) h0 bs _ =
let h1 = h0 + 2
- in (h1,bs,PUT_LIT (LInt n) : eval (HEAP h0) [])
+ in (h1,bs,PUT_LIT (LInt n) : eval st (HEAP h0) [])
compileFun gr eval st vs (K s) h0 bs _ =
let h1 = h0 + 2
- in (h1,bs,PUT_LIT (LStr s) : eval (HEAP h0) [])
+ in (h1,bs,PUT_LIT (LStr s) : eval st (HEAP h0) [])
compileFun gr eval st vs (EFloat d) h0 bs _ =
let h1 = h0 + 2
- in (h1,bs,PUT_LIT (LFlt d) : eval (HEAP h0) [])
+ in (h1,bs,PUT_LIT (LFlt d) : eval st (HEAP h0) [])
compileFun gr eval st vs (Typed e _) h0 bs args =
compileFun gr eval st vs e h0 bs args
compileFun gr eval st vs (Let (x, (_, e1)) e2) h0 bs args =
let (h1,bs1,arg,is1) = compileLambda gr st vs [] e1 h0 bs
(h2,bs2,is2) = compileFun gr eval st ((x,arg):vs) e2 h1 bs1 args
in (h2,bs2,is1++is2)
-compileFun gr eval st vs (Glue e1 e2) h0 bs args =
- let eval' fun args = [PUSH_FRAME]++is++[EVAL fun' RecCall]
- where
- (st1,is) = pushArgs (st+2) (reverse args)
- fun' = shiftIVal st fun
- (h1,bs1,is1) = compileFun gr eval' st vs e1 h0 bs args
- (h2,bs2,is2) = compileFun gr eval' st vs e2 h1 bs1 args
- in (h2,bs2,is1++is2++[ADD])
+compileFun gr eval st vs e@(Glue e1 e2) h0 bs args =
+ let eval' st fun args = [PUSH_FRAME]++is++[EVAL fun' RecCall]
+ where
+ (st1,is) = pushArgs (st+2) (reverse args)
+ fun' = shiftIVal st fun
+
+ flatten (Glue e1 e2) h0 bs =
+ let (h1,bs1,is1) = flatten e1 h0 bs
+ (h2,bs2,is2) = flatten e2 h1 bs1
+ in (h2,bs2,is1++is2)
+ flatten e h0 bs =
+ let (h1,bs1,is1) = compileFun gr eval' (st+3) vs e h0 bs args
+ in (h1,bs1,is1++[ADD])
+
+ (h1,bs1,is) = flatten e h0 bs
+
+ in (h1,bs1,[PUSH_ACCUM (LFlt 0)]++is++[POP_ACCUM]++eval (st+1) (ARG_VAR st) [])
compileFun gr eval st vs e _ _ _ = error (show e)
compileArg gr st vs (Q(m,id)) h0 bs =
diff --git a/src/runtime/c/pgf/data.h b/src/runtime/c/pgf/data.h
index 79c8dcc31..a3554ef45 100644
--- a/src/runtime/c/pgf/data.h
+++ b/src/runtime/c/pgf/data.h
@@ -141,7 +141,9 @@ typedef enum {
PGF_INSTR_DROP = 16,
PGF_INSTR_JUMP = 17,
PGF_INSTR_FAIL = 18,
- PGF_INSTR_ADD = 19,
+ PGF_INSTR_PUSH_ACCUM = 19,
+ PGF_INSTR_POP_ACCUM = 20,
+ PGF_INSTR_ADD = 21,
} PgfInstruction;
typedef GuSeq PgfConcrs;
diff --git a/src/runtime/c/pgf/evaluator.c b/src/runtime/c/pgf/evaluator.c
index 62fe0bdd5..dcff1e854 100644
--- a/src/runtime/c/pgf/evaluator.c
+++ b/src/runtime/c/pgf/evaluator.c
@@ -313,6 +313,48 @@ pgf_value2expr(PgfEvalState* state, int level, PgfClosure* clos, GuPool* pool)
PgfExprVar,
&expr, pool);
evar->var = level - fun->level - 1;
+ } else if (val->fun->code == state->eval_gates->evaluate_sum) {
+ PgfValueSum* sum = (PgfValueSum*) val->fun;
+
+ PgfExpr e1,e2;
+ PgfExprFun *efun =
+ gu_new_flex_variant(PGF_EXPR_FUN,
+ PgfExprFun,
+ fun, 2,
+ &e1, pool);
+ strcpy(efun->fun, "+");
+
+ PgfExprLit *elit =
+ gu_new_variant(PGF_EXPR_LIT,
+ PgfExprLit,
+ &e2, pool);
+ elit->lit = sum->lit;
+
+ PgfExprApp* eapp =
+ gu_new_variant(PGF_EXPR_APP,
+ PgfExprApp,
+ &expr, pool);
+ eapp->fun = e1;
+ eapp->arg = e2;
+
+ size_t n_consts = gu_buf_length(sum->consts);
+ for (size_t i = 0; i < n_consts; i++) {
+ PgfClosure* con =
+ gu_buf_get(sum->consts, PgfClosure*, i);
+
+ PgfExpr fun = expr;
+ PgfExpr arg =
+ pgf_value2expr(state, level, con, pool);
+ if (gu_variant_is_null(arg))
+ return gu_null_variant;
+
+ PgfExprApp* e =
+ gu_new_variant(PGF_EXPR_APP,
+ PgfExprApp,
+ &expr, pool);
+ e->fun = fun;
+ e->arg = arg;
+ }
} else {
PgfAbsFun* absfun = gu_container(val->fun, PgfAbsFun, closure);
expr = absfun->ep.expr;
@@ -370,3 +412,118 @@ pgf_compute(PgfPGF* pgf, PgfExpr expr, GuExn* err, GuPool* pool, GuPool* out_poo
return pgf_value2expr(state, 0, &thunk->header, out_pool);
}
+
+void
+pgf_evaluate_accum_init_int(PgfEvalState* state,
+ PgfEvalAccum* accum, int val)
+{
+ PgfLiteralInt *lit_int =
+ gu_new_variant(PGF_LITERAL_INT,
+ PgfLiteralInt,
+ &accum->lit,
+ state->pool);
+ lit_int->val = val;
+ accum->consts = NULL;
+}
+
+void
+pgf_evaluate_accum_init_str(PgfEvalState* state,
+ PgfEvalAccum* accum, GuString val)
+{
+ if (val == NULL)
+ val = "";
+
+ PgfLiteralStr *lit_str =
+ gu_new_flex_variant(PGF_LITERAL_STR,
+ PgfLiteralStr,
+ val, strlen(val)+1,
+ &accum->lit, state->pool);
+ strcpy((char*) lit_str->val, (char*) val);
+ accum->consts = NULL;
+}
+
+void
+pgf_evaluate_accum_init_flt(PgfEvalState* state,
+ PgfEvalAccum* accum, float val)
+{
+ PgfLiteralFlt *lit_flt =
+ gu_new_variant(PGF_LITERAL_FLT,
+ PgfLiteralFlt,
+ &accum->lit,
+ state->pool);
+ lit_flt->val = val;
+ accum->enter_stack_ptr = state->enter_stack_ptr;
+ state->enter_stack_ptr = ((void*)accum)-sizeof(void*)*2;
+ accum->consts = NULL;
+}
+
+static void
+pgf_evaluate_accum_add_helper(PgfEvalAccum* accum, PgfLiteral lit)
+{
+ GuVariantInfo ei = gu_variant_open(lit);
+ switch (ei.tag) {
+ case PGF_LITERAL_INT: {
+ PgfLiteralInt* lint = ei.data;
+ ((PgfLiteralInt*)gu_variant_data(accum->lit))->val += lint->val;
+ break;
+ }
+ case PGF_LITERAL_STR: {
+ PgfLiteralStr* lstr = ei.data;
+ break;
+ }
+ case PGF_LITERAL_FLT: {
+ PgfLiteralFlt* lflt = ei.data;
+ ((PgfLiteralFlt*)gu_variant_data(accum->lit))->val += lflt->val;
+ break;
+ }
+ }
+}
+
+void
+pgf_evaluate_accum_add(PgfEvalState* state,
+ PgfEvalAccum* accum, PgfClosure* closure)
+{
+ if (closure->code == state->eval_gates->evaluate_value_lit) {
+ PgfValueLit* val = (PgfValueLit*) closure;
+ pgf_evaluate_accum_add_helper(accum, val->lit);
+ } else if (closure->code == state->eval_gates->evaluate_value_const) {
+ if (accum->consts == NULL)
+ accum->consts = gu_new_buf(PgfClosure*, state->pool);
+
+ PgfValuePAP* pap = (PgfValuePAP*) closure;
+
+ if (pap->fun->code == state->eval_gates->evaluate_sum) {
+ PgfValueSum* val = (PgfValueSum*) ((PgfValuePAP*) closure)->fun;
+ pgf_evaluate_accum_add_helper(accum, val->lit);
+
+ size_t n_consts = gu_buf_length(val->consts);
+ for (size_t i = 0; i < n_consts; i++) {
+ PgfClosure* clos = gu_buf_get(val->consts, PgfClosure*, i);
+ gu_buf_push(accum->consts, PgfClosure*, clos);
+ }
+ } else {
+ gu_buf_push(accum->consts, PgfClosure*, closure);
+ }
+ } else {
+ gu_impossible();
+ }
+}
+
+PgfClosure*
+pgf_evaluate_accum_done(PgfEvalState* state, PgfEvalAccum* accum)
+{
+ state->enter_stack_ptr = accum->enter_stack_ptr;
+
+ if (accum->consts == NULL) {
+ PgfValueLit* val = gu_new(PgfValueLit, state->pool);
+ val->header.code = state->eval_gates->evaluate_value_lit;
+ val->lit = accum->lit;
+ return &val->header;
+ } else {
+ PgfValueSum* val = gu_new(PgfValueSum, state->pool);
+ val->header.code = state->eval_gates->evaluate_sum;
+ val->lit = accum->lit;
+ val->consts = accum->consts;
+ return &val->header;
+ }
+}
diff --git a/src/runtime/c/pgf/evaluator.h b/src/runtime/c/pgf/evaluator.h
index 1f56d61a9..39d43559d 100644
--- a/src/runtime/c/pgf/evaluator.h
+++ b/src/runtime/c/pgf/evaluator.h
@@ -15,9 +15,17 @@ typedef struct {
PgfEvalGates* eval_gates; // cached from pgf->abstr->eval_gates
GuPool* pool;
GuExn* err;
+ void* enter_stack_ptr;
+ void* tmp; // for temporary register spills
PgfIndirection cafs[]; // derived from gu_seq_data(pgf->abstr->eval_gates->cafs)
} PgfEvalState;
+typedef struct {
+ PgfLiteral lit;
+ GuBuf* consts;
+ void* enter_stack_ptr;
+} PgfEvalAccum;
+
typedef struct PgfEnv PgfEnv;
struct PgfEnv {
@@ -55,6 +63,12 @@ typedef struct {
typedef struct {
PgfClosure header;
+ PgfLiteral lit;
+ GuBuf* consts;
+} PgfValueSum;
+
+typedef struct {
+ PgfClosure header;
PgfClosure* fun;
size_t n_args;
PgfClosure* args[];
@@ -70,6 +84,7 @@ struct PgfEvalGates {
PgfFunction evaluate_value_const;
PgfFunction evaluate_meta;
PgfFunction evaluate_gen;
+ PgfFunction evaluate_sum;
PgfFunction evaluate_caf;
PgfFunction update_closure;
@@ -90,4 +105,23 @@ PgfClosure*
pgf_evaluate_lambda_application(PgfEvalState* state, PgfExprThunk* lambda,
PgfClosure* arg);
+void
+pgf_evaluate_accum_init_int(PgfEvalState* state,
+ PgfEvalAccum* accum, int val);
+
+void
+pgf_evaluate_accum_init_str(PgfEvalState* state,
+ PgfEvalAccum* accum, GuString val);
+
+void
+pgf_evaluate_accum_init_flt(PgfEvalState* state,
+ PgfEvalAccum* accum, float val);
+
+void
+pgf_evaluate_accum_add(PgfEvalState* state,
+ PgfEvalAccum* accum, PgfClosure* closure);
+
+PgfClosure*
+pgf_evaluate_accum_done(PgfEvalState* state, PgfEvalAccum* accum);
+
#endif
diff --git a/src/runtime/c/pgf/jit.c b/src/runtime/c/pgf/jit.c
index 60f8d28f6..33f14501a 100644
--- a/src/runtime/c/pgf/jit.c
+++ b/src/runtime/c/pgf/jit.c
@@ -371,9 +371,9 @@ pgf_jit_gates(PgfReader* rdr)
int closure_arg = jit_arg_p();
jit_getarg_p(JIT_VSTATE, es_arg);
jit_getarg_p(JIT_VCLOS, closure_arg);
+ jit_stxi_p(offsetof(PgfEvalState, enter_stack_ptr), JIT_VSTATE, JIT_SP);
jit_ldr_p(JIT_R0, JIT_VCLOS);
jit_callr(JIT_R0);
- jit_insn* enter_ret = (void*) jit_get_ip().ptr;
jit_movr_p(JIT_RET, JIT_VHEAP);
jit_ret();
@@ -547,7 +547,9 @@ pgf_jit_gates(PgfReader* rdr)
jit_pushr_p(JIT_R0);
jit_jmpi(gates->mk_const);
jit_patch(ref2);
- ref2 = jit_bnei_i(jit_forward(), JIT_R0, (int)enter_ret);
+ jit_ldxi_p(JIT_R1, JIT_VSTATE, offsetof(PgfEvalState,enter_stack_ptr));
+ ref2 = jit_bner_p(jit_forward(), JIT_FP, JIT_R1);
+ jit_stxi_p(offsetof(PgfEvalState,tmp), JIT_VSTATE, JIT_R0);
jit_subr_p(JIT_R0, JIT_FP, JIT_SP);
jit_pushr_i(JIT_R0);
jit_prepare(2);
@@ -556,8 +558,8 @@ pgf_jit_gates(PgfReader* rdr)
jit_ldxi_p(JIT_R0, JIT_VSTATE, offsetof(PgfEvalState,pool));
jit_pusharg_p(JIT_R0);
jit_finish(gu_malloc);
- jit_popr_i(JIT_R1);
jit_movr_p(JIT_VHEAP, JIT_RET);
+ jit_popr_i(JIT_R1);
jit_movi_p(JIT_R2, gates->evaluate_value_const);
jit_str_p(JIT_VHEAP, JIT_R2);
jit_stxi_p(offsetof(PgfValuePAP,fun), JIT_VHEAP, JIT_VCLOS);
@@ -570,7 +572,8 @@ pgf_jit_gates(PgfReader* rdr)
jit_subi_i(JIT_R1, JIT_R1, sizeof(void*));
jit_jmpi(next);
jit_patch(ref);
- jit_jmpi(enter_ret);
+ jit_ldxi_p(JIT_R0, JIT_VSTATE, offsetof(PgfEvalState,tmp));
+ jit_jmpr(JIT_R0);
jit_patch(ref2);
jit_ldxi_p(JIT_VCLOS, JIT_FP, sizeof(void*));
jit_ldr_p(JIT_FP, JIT_FP);
@@ -581,16 +584,21 @@ pgf_jit_gates(PgfReader* rdr)
jit_movr_p(JIT_SP, JIT_R0);
jit_jmpi(gates->mk_const);
- pgf_jit_make_space(rdr, JIT_CODE_WINDOW*2);
+ pgf_jit_make_space(rdr, JIT_CODE_WINDOW);
gates->evaluate_gen = jit_get_ip().ptr;
jit_jmpi(gates->mk_const);
- pgf_jit_make_space(rdr, JIT_CODE_WINDOW*2);
+ pgf_jit_make_space(rdr, JIT_CODE_WINDOW);
gates->evaluate_meta = jit_get_ip().ptr;
jit_jmpi(gates->mk_const);
+ pgf_jit_make_space(rdr, JIT_CODE_WINDOW);
+
+ gates->evaluate_sum = jit_get_ip().ptr;
+ jit_jmpi(gates->mk_const);
+
gates->fin.fn = pgf_jit_finalize_cafs;
gates->cafs = NULL;
gu_pool_finally(rdr->opool, &gates->fin);
@@ -1167,10 +1175,88 @@ pgf_jit_function(PgfReader* rdr, PgfAbstr* abstr,
#endif
jit_jmpi(abstr->eval_gates->mk_const);
break;
+ case PGF_INSTR_PUSH_ACCUM:
+ jit_subi_p(JIT_SP, JIT_SP, sizeof(PgfEvalAccum));
+
+ switch (mod) {
+ case 0: {
+ int val = pgf_read_int(rdr);
+#ifdef PGF_JIT_DEBUG
+ gu_printf(out, err, "PUSH_ACCUM %d\n", val);
+#endif
+ jit_prepare(3);
+ jit_movi_i(JIT_R0, val);
+ jit_movr_p(JIT_R1, JIT_SP);
+ jit_pusharg_p(JIT_R0);
+ jit_pusharg_p(JIT_R1);
+ jit_pusharg_p(JIT_VSTATE);
+ jit_finish(pgf_evaluate_accum_init_int);
+ break;
+ }
+ case 1: {
+ size_t len = pgf_read_len(rdr);
+ uint8_t* buf = alloca(len*6+1);
+ uint8_t* p = buf;
+ for (size_t i = 0; i < len; i++) {
+ gu_in_utf8_buf(&p, rdr->in, rdr->err);
+ }
+ *p++ = 0;
+
+ GuString val =
+ *buf ? gu_string_copy((GuString) buf, rdr->opool)
+ : NULL;
+#ifdef PGF_JIT_DEBUG
+ gu_printf(out, err, "PUSH_ACCUM \"%s\"\n", buf);
+#endif
+ jit_prepare(3);
+ jit_movi_p(JIT_R0, val);
+ jit_movr_p(JIT_R1, JIT_SP);
+ jit_pusharg_p(JIT_R0);
+ jit_pusharg_p(JIT_R1);
+ jit_pusharg_p(JIT_VSTATE);
+ jit_finish(pgf_evaluate_accum_init_str);
+ break;
+ }
+ case 2: {
+ double val = pgf_read_double(rdr);
+#ifdef PGF_JIT_DEBUG
+ gu_printf(out, err, "PUSH_ACCUM %f\n", val);
+#endif
+ jit_prepare_d(1);
+ jit_prepare_i(2);
+ jit_movi_d(JIT_FPR0, val);
+ jit_movr_p(JIT_R1, JIT_SP);
+ jit_pusharg_d(JIT_FPR0);
+ jit_pusharg_p(JIT_R1);
+ jit_pusharg_p(JIT_VSTATE);
+ jit_finish(pgf_evaluate_accum_init_flt);
+ break;
+ }
+ default:
+ gu_impossible();
+ }
+ break;
+ case PGF_INSTR_POP_ACCUM:
+#ifdef PGF_JIT_DEBUG
+ gu_printf(out, err, "POP_ACCUM\n");
+#endif
+ jit_prepare(2);
+ jit_pusharg_p(JIT_SP);
+ jit_pusharg_p(JIT_VSTATE);
+ jit_finish(pgf_evaluate_accum_done);
+ jit_addi_p(JIT_SP, JIT_SP, sizeof(PgfEvalAccum));
+ jit_pushr_p(JIT_RET);
+ break;
case PGF_INSTR_ADD:
#ifdef PGF_JIT_DEBUG
gu_printf(out, err, "ADD\n");
#endif
+ jit_prepare(3);
+ jit_movr_p(JIT_R1, JIT_SP);
+ jit_pusharg_p(JIT_VHEAP);
+ jit_pusharg_p(JIT_R1);
+ jit_pusharg_p(JIT_VSTATE);
+ jit_finish(pgf_evaluate_accum_add);
break;
default:
gu_impossible();
diff --git a/src/runtime/haskell/PGF/Binary.hs b/src/runtime/haskell/PGF/Binary.hs
index 6f63e63c0..b2695acbb 100644
--- a/src/runtime/haskell/PGF/Binary.hs
+++ b/src/runtime/haskell/PGF/Binary.hs
@@ -177,7 +177,11 @@ instance Binary Instr where
put (DROP n ) = putWord8 64 >> put n
put (JUMP l ) = putWord8 68 >> put l
put (FAIL ) = putWord8 72
- put (ADD ) = putWord8 76
+ put (PUSH_ACCUM (LInt n)) = putWord8 76 >> put n
+ put (PUSH_ACCUM (LStr s)) = putWord8 77 >> put s
+ put (PUSH_ACCUM (LFlt d)) = putWord8 78 >> put d
+ put (POP_ACCUM ) = putWord8 80
+ put (ADD ) = putWord8 84
instance Binary Type where
put (DTyp hypos cat exps) = put (hypos,cat,exps)
diff --git a/src/runtime/haskell/PGF/ByteCode.hs b/src/runtime/haskell/PGF/ByteCode.hs
index 9ac072378..579d6b3bb 100644
--- a/src/runtime/haskell/PGF/ByteCode.hs
+++ b/src/runtime/haskell/PGF/ByteCode.hs
@@ -32,6 +32,8 @@ data Instr
| DROP {-# UNPACK #-} !Int
| JUMP {-# UNPACK #-} !CodeLabel
| FAIL
+ | PUSH_ACCUM Literal
+ | POP_ACCUM
| ADD
data IVal
@@ -71,6 +73,8 @@ ppInstr (TUCK v n ) = text "TUCK " <+> ppIVal v <+> int n
ppInstr (DROP n ) = text "DROP " <+> int n
ppInstr (JUMP l ) = text "JUMP " <+> ppLabel l
ppInstr (FAIL ) = text "FAIL"
+ppInstr (PUSH_ACCUM lit) = text "PUSH_ACCUM " <+> ppLit lit
+ppInstr (POP_ACCUM ) = text "POP_ACCUM"
ppInstr (ADD ) = text "ADD"
ppIVal (HEAP n) = text "hp" <> parens (int n)