JNIEXPORT jlong JNICALL
Java_org_grammaticalframework_pgf_Expr_initApp(JNIEnv* env, jclass clazz, jstring jfun, jobjectArray args, jlong jpool)
{
GuPool* pool = l2p(jpool);
PgfExpr expr;
GuString fun = (*env)->GetStringUTFChars(env, jfun, 0);
PgfExprFun* e =
gu_new_flex_variant(PGF_EXPR_FUN,
PgfExprFun,
fun, strlen(fun)+1,
&expr, pool);
strcpy(e->fun, fun);
(*env)->ReleaseStringUTFChars(env, jfun, fun);
size_t n_args = (*env)->GetArrayLength(env, args);
for (size_t i = 0; i < n_args; i++) {
PgfExpr fun = expr;
PgfExpr arg = gu_variant_from_ptr(get_ref(env, (*env)->GetObjectArrayElement(env, args, i)));
PgfExprApp* e =
gu_new_variant(PGF_EXPR_APP,
PgfExprApp,
&expr, pool);
e->fun = fun;
e->arg = arg;
}
return expr;
}
static PgfLiteral
pgf_read_literal(PgfReader* rdr)
{
PgfLiteral lit = gu_null_variant;
uint8_t tag = pgf_read_tag(rdr);
switch (tag) {
case PGF_LITERAL_STR: {
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);
gu_return_on_exn(rdr->err, gu_null_variant);
}
*p++ = 0;
PgfLiteralStr *lit_str =
gu_new_flex_variant(PGF_LITERAL_STR,
PgfLiteralStr,
val, p-buf,
&lit, rdr->opool);
strcpy((char*) lit_str->val, (char*) buf);
break;
}
case PGF_LITERAL_INT: {
PgfLiteralInt *lit_int =
gu_new_variant(PGF_LITERAL_INT,
PgfLiteralInt,
&lit, rdr->opool);
lit_int->val = pgf_read_int(rdr);
break;
}
case PGF_LITERAL_FLT: {
PgfLiteralFlt *lit_flt =
gu_new_variant(PGF_LITERAL_FLT,
PgfLiteralFlt,
&lit, rdr->opool);
lit_flt->val = pgf_read_double(rdr);
break;
}
default:
pgf_read_tag_error(rdr);
}
return lit;
}
PgfExpr
pgf_expr_float(double val, GuPool* pool)
{
PgfLiteral lit;
PgfLiteralFlt* plit =
gu_new_variant(PGF_LITERAL_FLT,
PgfLiteralFlt,
&lit, pool);
plit->val = val;
return gu_new_variant_i(pool,
PGF_EXPR_LIT,
PgfExprLit,
lit);
}
PgfExpr
pgf_expr_int(int val, GuPool* pool)
{
PgfLiteral lit;
PgfLiteralInt* plit =
gu_new_variant(PGF_LITERAL_INT,
PgfLiteralInt,
&lit, pool);
plit->val = val;
return gu_new_variant_i(pool,
PGF_EXPR_LIT,
PgfExprLit,
lit);
}
JNIEXPORT jlong JNICALL
Java_org_grammaticalframework_pgf_Expr_initStringLit(JNIEnv* env, jclass clazz, jstring jstr, jlong jpool)
{
GuPool* pool = l2p(jpool);
PgfExpr expr;
PgfExprLit* e =
gu_new_variant(PGF_EXPR_LIT,
PgfExprLit,
&expr, pool);
GuString str = (*env)->GetStringUTFChars(env, jstr, 0);
PgfLiteralStr* slit =
gu_new_flex_variant(PGF_LITERAL_STR,
PgfLiteralStr,
val, strlen(str)+1,
&e->lit, pool);
strcpy(slit->val, str);
(*env)->ReleaseStringUTFChars(env, jstr, str);
return expr;
}
PgfClosure*
pgf_evaluate_expr_thunk(PgfReasoner* rs, PgfExprThunk* thunk)
{
PgfEnv* env = thunk->env;
PgfExpr expr = thunk->expr;
size_t n_args = 0;
PgfClosure** args = NULL;
PgfClosure* res = NULL;
repeat:;
GuVariantInfo ei = gu_variant_open(expr);
switch (ei.tag) {
case PGF_EXPR_ABS: {
PgfExprAbs* eabs = ei.data;
if (n_args > 0) {
PgfEnv* new_env = gu_new(PgfEnv, rs->pool);
new_env->next = env;
new_env->closure = args[--n_args];
env = new_env;
expr = eabs->body;
goto repeat;
} else {
thunk->header.code = rs->eval_gates->evaluate_value_lambda;
thunk->expr = eabs->body;
res = &thunk->header;
}
break;
}
case PGF_EXPR_APP: {
PgfExprApp* eapp = ei.data;
PgfExprThunk* thunk =
gu_new(PgfExprThunk, rs->pool);
thunk->header.code = rs->eval_gates->evaluate_expr_thunk;
thunk->env = env;
thunk->expr = eapp->arg;
if (n_args % PGF_ARGS_DELTA == 0) {
args = realloc(args, n_args + PGF_ARGS_DELTA);
}
args[n_args++] = &thunk->header;
expr = eapp->fun;
goto repeat;
}
case PGF_EXPR_LIT: {
PgfExprLit* elit = ei.data;
PgfValueLit* val = (PgfValueLit*) thunk;
val->header.code = rs->eval_gates->evaluate_value_lit;
val->lit = elit->lit;
res = &val->header;
break;
}
case PGF_EXPR_META: {
PgfExprMeta* emeta = ei.data;
PgfValueMeta* val =
gu_new(PgfValueMeta, rs->pool);
val->header.code = rs->eval_gates->evaluate_meta;
val->env = env;
val->id = emeta->id;
res = pgf_mk_pap(rs, &val->header, n_args, args);
break;
}
case PGF_EXPR_FUN: {
PgfExprFun* efun = ei.data;
PgfAbsFun* absfun =
gu_seq_binsearch(rs->abstract->funs, pgf_absfun_order, PgfAbsFun, efun->fun);
gu_assert(absfun != NULL);
if (absfun->closure.code != NULL) {
res = pgf_mk_pap(rs, (PgfClosure*) &absfun->closure, n_args, args);
} else {
size_t arity = absfun->arity;
if (n_args == arity) {
PgfValue* val = gu_new_flex(rs->pool, PgfValue, args, arity);
val->header.code = rs->eval_gates->evaluate_value;
val->con = (PgfClosure*) &absfun->closure;
for (size_t i = 0; i < arity; i++) {
val->args[i] = args[--n_args];
}
res = &val->header;
} else {
gu_assert(n_args < arity);
PgfExprThunk* lambda = gu_new(PgfExprThunk, rs->pool);
lambda->header.code = rs->eval_gates->evaluate_value_lambda;
lambda->env = NULL;
res = pgf_mk_pap(rs, &lambda->header, n_args, args);
for (size_t i = 0; i < arity; i++) {
PgfExpr new_expr, arg;
PgfExprVar *evar =
gu_new_variant(PGF_EXPR_VAR,
PgfExprVar,
&arg, rs->pool);
evar->var = arity-i-1;
PgfExprApp *eapp =
gu_new_variant(PGF_EXPR_APP,
PgfExprApp,
&new_expr, rs->pool);
eapp->fun = expr;
eapp->arg = arg;
expr = new_expr;
}
for (size_t i = 0; i < arity-1; i++) {
PgfExpr new_expr;
PgfExprAbs *eabs =
gu_new_variant(PGF_EXPR_ABS,
PgfExprAbs,
&new_expr, rs->pool);
eabs->bind_type = PGF_BIND_TYPE_EXPLICIT;
eabs->id = "_";
eabs->body = expr;
expr = new_expr;
}
lambda->expr = expr;
}
}
break;
}
case PGF_EXPR_VAR: {
PgfExprVar* evar = ei.data;
PgfEnv* tmp_env = env;
size_t i = evar->var;
while (i > 0) {
tmp_env = tmp_env->next;
if (tmp_env == NULL) {
GuExnData* err_data = gu_raise(rs->err, PgfExn);
if (err_data) {
err_data->data = "invalid de Bruijn index";
}
return NULL;
}
i--;
}
res = pgf_mk_pap(rs, tmp_env->closure, n_args, args);
break;
}
case PGF_EXPR_TYPED: {
PgfExprTyped* etyped = ei.data;
expr = etyped->expr;
goto repeat;
}
case PGF_EXPR_IMPL_ARG: {
PgfExprImplArg* eimpl = ei.data;
expr = eimpl->expr;
goto repeat;
}
default:
gu_impossible();
}
free(args);
return res;
}
static PgfExpr
pgf_value2expr(PgfReasoner* rs, int level, PgfClosure* clos)
{
clos = rs->eval_gates->enter(rs, clos);
if (clos == NULL)
return gu_null_variant;
PgfExpr expr = gu_null_variant;
size_t n_args = 0;
PgfClosure** args;
if (clos->code == rs->eval_gates->evaluate_value) {
PgfValue* val = (PgfValue*) clos;
PgfAbsFun* absfun = gu_container(val->con, PgfAbsFun, closure);
expr = absfun->ep.expr;
n_args = absfun->arity;
args = val->args;
} else if (clos->code == rs->eval_gates->evaluate_value_lit) {
PgfValueLit* val = (PgfValueLit*) clos;
PgfExprLit *elit =
gu_new_variant(PGF_EXPR_LIT,
PgfExprLit,
&expr, rs->out_pool);
GuVariantInfo i = gu_variant_open(val->lit);
switch (i.tag) {
case PGF_LITERAL_STR: {
PgfLiteralStr* lstr = i.data;
PgfLiteralStr* new_lstr =
gu_new_flex_variant(PGF_LITERAL_STR,
PgfLiteralStr,
val, strlen(lstr->val)+1,
&elit->lit, rs->out_pool);
strcpy(new_lstr->val, lstr->val);
break;
}
case PGF_LITERAL_INT: {
PgfLiteralInt* lint = i.data;
PgfLiteralInt* new_lint =
gu_new_variant(PGF_LITERAL_INT,
PgfLiteralInt,
&elit->lit, rs->out_pool);
new_lint->val = lint->val;
break;
}
case PGF_LITERAL_FLT: {
PgfLiteralFlt* lflt = i.data;
PgfLiteralFlt* new_lflt =
gu_new_variant(PGF_LITERAL_FLT,
PgfLiteralFlt,
&elit->lit, rs->out_pool);
new_lflt->val = lflt->val;
break;
}
default:
gu_impossible();
}
} else if (clos->code == rs->eval_gates->evaluate_value_pap) {
PgfValuePAP *pap = (PgfValuePAP*) clos;
PgfValueGen* gen =
gu_new(PgfValueGen, rs->pool);
gen->header.code = rs->eval_gates->evaluate_gen;
gen->level = level;
size_t n_args = pap->n_args/sizeof(PgfClosure*);
PgfValuePAP* new_pap = gu_new_flex(rs->pool, PgfValuePAP, args, n_args+1);
new_pap->header.code = rs->eval_gates->evaluate_value_pap;
new_pap->fun = pap->fun;
new_pap->n_args = pap->n_args+sizeof(PgfClosure*);
new_pap->args[0] = &gen->header;
for (size_t i = 0; i < n_args; i++) {
new_pap->args[i+1] = pap->args[i];
}
PgfExprAbs *eabs =
gu_new_variant(PGF_EXPR_ABS,
PgfExprAbs,
&expr, rs->out_pool);
eabs->bind_type = PGF_BIND_TYPE_EXPLICIT;
eabs->id = gu_format_string(rs->out_pool, "v%d", level);
eabs->body = pgf_value2expr(rs, level+1, &new_pap->header);
} else if (clos->code == rs->eval_gates->evaluate_value_const) {
PgfValuePAP* val = (PgfValuePAP*) clos;
if (val->fun->code == rs->eval_gates->evaluate_meta) {
PgfValueMeta* fun = (PgfValueMeta*) val->fun;
PgfExprMeta *emeta =
gu_new_variant(PGF_EXPR_META,
PgfExprMeta,
&expr, rs->out_pool);
emeta->id = fun->id;
} else if (val->fun->code == rs->eval_gates->evaluate_gen) {
PgfValueGen* fun = (PgfValueGen*) val->fun;
PgfExprVar *evar =
gu_new_variant(PGF_EXPR_VAR,
PgfExprVar,
&expr, rs->out_pool);
evar->var = level - fun->level - 1;
} else if (val->fun->code == rs->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, rs->out_pool);
strcpy(efun->fun, "+");
PgfExprLit *elit =
gu_new_variant(PGF_EXPR_LIT,
PgfExprLit,
&e2, rs->out_pool);
elit->lit = sum->lit;
PgfExprApp* eapp =
gu_new_variant(PGF_EXPR_APP,
PgfExprApp,
&expr, rs->out_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(rs, level, con);
if (gu_variant_is_null(arg))
return gu_null_variant;
PgfExprApp* e =
gu_new_variant(PGF_EXPR_APP,
PgfExprApp,
&expr, rs->out_pool);
e->fun = fun;
e->arg = arg;
}
} else {
static PgfSymbol
pgf_read_symbol(PgfReader* rdr)
{
PgfSymbol sym = gu_null_variant;
uint8_t tag = pgf_read_tag(rdr);
switch (tag) {
case PGF_SYMBOL_CAT: {
PgfSymbolCat *sym_cat =
gu_new_variant(PGF_SYMBOL_CAT,
PgfSymbolCat,
&sym, rdr->opool);
sym_cat->d = pgf_read_int(rdr);
gu_return_on_exn(rdr->err, gu_null_variant);
sym_cat->r = pgf_read_int(rdr);
gu_return_on_exn(rdr->err, gu_null_variant);
break;
}
case PGF_SYMBOL_LIT: {
PgfSymbolLit *sym_lit =
gu_new_variant(PGF_SYMBOL_LIT,
PgfSymbolLit,
&sym, rdr->opool);
sym_lit->d = pgf_read_int(rdr);
gu_return_on_exn(rdr->err, gu_null_variant);
sym_lit->r = pgf_read_int(rdr);
gu_return_on_exn(rdr->err, gu_null_variant);
break;
}
case PGF_SYMBOL_VAR: {
PgfSymbolVar *sym_var =
gu_new_variant(PGF_SYMBOL_VAR,
PgfSymbolVar,
&sym, rdr->opool);
sym_var->d = pgf_read_int(rdr);
gu_return_on_exn(rdr->err, gu_null_variant);
sym_var->r = pgf_read_int(rdr);
gu_return_on_exn(rdr->err, gu_null_variant);
break;
}
case PGF_SYMBOL_KS: {
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);
gu_return_on_exn(rdr->err, gu_null_variant);
}
*p++ = 0;
PgfSymbolKS *sym_ks =
gu_new_flex_variant(PGF_SYMBOL_KS,
PgfSymbolKS,
token, p-buf,
&sym, rdr->opool);
strcpy((char*) sym_ks->token, (char*) buf);
break;
}
case PGF_SYMBOL_KP: {
PgfSymbols* default_form = pgf_read_symbols(rdr);
gu_return_on_exn(rdr->err, gu_null_variant);
size_t n_forms = pgf_read_len(rdr);
gu_return_on_exn(rdr->err, gu_null_variant);
PgfSymbolKP *sym_kp =
gu_new_flex_variant(PGF_SYMBOL_KP,
PgfSymbolKP, forms, n_forms,
&sym, rdr->opool);
sym_kp->default_form = default_form;
sym_kp->n_forms = n_forms;
for (size_t i = 0; i < sym_kp->n_forms; i++) {
pgf_read_alternative(rdr, &sym_kp->forms[i]);
gu_return_on_exn(rdr->err, gu_null_variant);
}
break;
}
case PGF_SYMBOL_NE: {
gu_new_variant(PGF_SYMBOL_NE,
PgfSymbolNE,
&sym, rdr->opool);
gu_return_on_exn(rdr->err, gu_null_variant);
break;
}
case PGF_SYMBOL_BIND: {
gu_new_variant(PGF_SYMBOL_BIND,
PgfSymbolBIND,
&sym, rdr->opool);
gu_return_on_exn(rdr->err, gu_null_variant);
break;
}
case PGF_SYMBOL_SOFT_BIND: {
gu_new_variant(PGF_SYMBOL_SOFT_BIND,
PgfSymbolBIND,
&sym, rdr->opool);
gu_return_on_exn(rdr->err, gu_null_variant);
break;
}
case PGF_SYMBOL_SOFT_SPACE: {
gu_new_variant(PGF_SYMBOL_SOFT_SPACE,
PgfSymbolBIND,
&sym, rdr->opool);
gu_return_on_exn(rdr->err, gu_null_variant);
break;
}
case PGF_SYMBOL_CAPIT: {
gu_new_variant(PGF_SYMBOL_CAPIT,
PgfSymbolCAPIT,
&sym, rdr->opool);
gu_return_on_exn(rdr->err, gu_null_variant);
break;
}
case PGF_SYMBOL_ALL_CAPIT: {
gu_new_variant(PGF_SYMBOL_ALL_CAPIT,
PgfSymbolCAPIT,
&sym, rdr->opool);
gu_return_on_exn(rdr->err, gu_null_variant);
break;
}
default:
pgf_read_tag_error(rdr);
}
return sym;
}
static PgfPatt
pgf_read_patt(PgfReader* rdr)
{
PgfPatt patt = gu_null_variant;
uint8_t tag = pgf_read_tag(rdr);
switch (tag) {
case PGF_PATT_APP: {
PgfPattApp *papp =
gu_new_variant(PGF_PATT_APP,
PgfPattApp,
&patt, rdr->opool);
papp->ctor = pgf_read_cid(rdr, rdr->opool);
gu_return_on_exn(rdr->err, gu_null_variant);
papp->n_args = pgf_read_len(rdr);
gu_return_on_exn(rdr->err, gu_null_variant);
for (size_t i = 0; i < papp->n_args; i++) {
papp->args[i] = pgf_read_patt(rdr);
gu_return_on_exn(rdr->err, gu_null_variant);
}
break;
}
case PGF_PATT_VAR: {
PgfPattVar *papp =
gu_new_variant(PGF_PATT_VAR,
PgfPattVar,
&patt, rdr->opool);
papp->var = pgf_read_cid(rdr, rdr->opool);
gu_return_on_exn(rdr->err, gu_null_variant);
break;
}
case PGF_PATT_AS: {
PgfPattAs *pas =
gu_new_variant(PGF_PATT_AS,
PgfPattAs,
&patt, rdr->opool);
pas->var = pgf_read_cid(rdr, rdr->opool);
gu_return_on_exn(rdr->err, gu_null_variant);
pas->patt = pgf_read_patt(rdr);
gu_return_on_exn(rdr->err, gu_null_variant);
break;
}
case PGF_PATT_WILD: {
PgfPattWild* pwild =
gu_new_variant(PGF_PATT_WILD,
PgfPattWild,
&patt, rdr->opool);
((void) pwild);
break;
}
case PGF_PATT_LIT: {
PgfPattLit *plit =
gu_new_variant(PGF_PATT_LIT,
PgfPattLit,
&patt, rdr->opool);
plit->lit = pgf_read_literal(rdr);
gu_return_on_exn(rdr->err, gu_null_variant);
break;
}
case PGF_PATT_IMPL_ARG: {
PgfPattImplArg *pimpl =
gu_new_variant(PGF_PATT_IMPL_ARG,
PgfPattImplArg,
&patt, rdr->opool);
pimpl->patt = pgf_read_patt(rdr);
gu_return_on_exn(rdr->err, gu_null_variant);
break;
}
case PGF_PATT_TILDE: {
PgfPattTilde *ptilde =
gu_new_variant(PGF_PATT_TILDE,
PgfPattTilde,
&patt, rdr->opool);
ptilde->expr = pgf_read_expr_(rdr);
gu_return_on_exn(rdr->err, gu_null_variant);
break;
}
default:
pgf_read_tag_error(rdr);
}
return patt;
}
static PgfExpr
pgf_read_expr_(PgfReader* rdr)
{
PgfExpr expr = gu_null_variant;
uint8_t tag = pgf_read_tag(rdr);
switch (tag) {
case PGF_EXPR_ABS:{
PgfExprAbs *eabs =
gu_new_variant(PGF_EXPR_ABS,
PgfExprAbs,
&expr, rdr->opool);
eabs->bind_type = pgf_read_tag(rdr);
gu_return_on_exn(rdr->err, gu_null_variant);
eabs->id = pgf_read_cid(rdr, rdr->opool);
gu_return_on_exn(rdr->err, gu_null_variant);
eabs->body = pgf_read_expr_(rdr);
gu_return_on_exn(rdr->err, gu_null_variant);
break;
}
case PGF_EXPR_APP: {
PgfExprApp *eapp =
gu_new_variant(PGF_EXPR_APP,
PgfExprApp,
&expr, rdr->opool);
eapp->fun = pgf_read_expr_(rdr);
gu_return_on_exn(rdr->err, gu_null_variant);
eapp->arg = pgf_read_expr_(rdr);
gu_return_on_exn(rdr->err, gu_null_variant);
break;
}
case PGF_EXPR_LIT: {
PgfExprLit *elit =
gu_new_variant(PGF_EXPR_LIT,
PgfExprLit,
&expr, rdr->opool);
elit->lit = pgf_read_literal(rdr);
gu_return_on_exn(rdr->err, gu_null_variant);
break;
}
case PGF_EXPR_META: {
PgfExprMeta *emeta =
gu_new_variant(PGF_EXPR_META,
PgfExprMeta,
&expr, rdr->opool);
emeta->id = pgf_read_int(rdr);
gu_return_on_exn(rdr->err, gu_null_variant);
break;
}
case PGF_EXPR_FUN: {
size_t len = pgf_read_len(rdr);
PgfExprFun *efun =
gu_new_flex_variant(PGF_EXPR_FUN,
PgfExprFun,
fun, len+1,
&expr, rdr->opool);
gu_in_bytes(rdr->in, (uint8_t*)efun->fun, len, rdr->err);
efun->fun[len] = 0;
gu_return_on_exn(rdr->err, gu_null_variant);
break;
}
case PGF_EXPR_VAR: {
PgfExprVar *evar =
gu_new_variant(PGF_EXPR_VAR,
PgfExprVar,
&expr, rdr->opool);
evar->var = pgf_read_int(rdr);
gu_return_on_exn(rdr->err, gu_null_variant);
break;
}
case PGF_EXPR_TYPED: {
PgfExprTyped *etyped =
gu_new_variant(PGF_EXPR_TYPED,
PgfExprTyped,
&expr, rdr->opool);
etyped->expr = pgf_read_expr_(rdr);
gu_return_on_exn(rdr->err, gu_null_variant);
etyped->type = pgf_read_type_(rdr);
gu_return_on_exn(rdr->err, gu_null_variant);
break;
}
case PGF_EXPR_IMPL_ARG: {
PgfExprImplArg *eimpl =
gu_new_variant(PGF_EXPR_IMPL_ARG,
PgfExprImplArg,
&expr, rdr->opool);
eimpl->expr = pgf_read_expr_(rdr);
gu_return_on_exn(rdr->err, gu_null_variant);
break;
}
default:
pgf_read_tag_error(rdr);
}
return expr;
}
