From 2bde418b15bbca28b036673543afef0256b15fbc Mon Sep 17 00:00:00 2001 From: "kr.angelov" Date: Fri, 31 Oct 2014 14:16:11 +0000 Subject: [PATCH] now (+) in the abstract syntax works, i.e. it knows how to deal with partial sums --- src/compiler/GF/Compile/GenerateBC.hs | 45 +++++--- src/runtime/c/pgf/data.h | 4 +- src/runtime/c/pgf/evaluator.c | 157 ++++++++++++++++++++++++++ src/runtime/c/pgf/evaluator.h | 34 ++++++ src/runtime/c/pgf/jit.c | 98 +++++++++++++++- src/runtime/haskell/PGF/Binary.hs | 6 +- src/runtime/haskell/PGF/ByteCode.hs | 4 + 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 { @@ -53,6 +61,12 @@ typedef struct { PgfLiteral lit; } PgfValueLit; +typedef struct { + PgfClosure header; + PgfLiteral lit; + GuBuf* consts; +} PgfValueSum; + typedef struct { PgfClosure header; PgfClosure* fun; @@ -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)