static PgfCncFun*
pgf_read_cncfun(PgfReader* rdr, PgfAbstr* abstr, PgfConcr* concr, int funid)
{
PgfCId name = pgf_read_cid(rdr, rdr->tmp_pool);
gu_return_on_exn(rdr->err, NULL);
size_t len = pgf_read_len(rdr);
gu_return_on_exn(rdr->err, NULL);
PgfAbsFun* absfun =
gu_seq_binsearch(abstr->funs, pgf_absfun_order, PgfAbsFun, name);
PgfCncFun* cncfun = gu_new_flex(rdr->opool, PgfCncFun, lins, len);
cncfun->absfun = absfun;
cncfun->ep = (absfun == NULL) ? NULL : &absfun->ep;
cncfun->funid = funid;
cncfun->n_lins = len;
for (size_t i = 0; i < len; i++) {
size_t seqid = pgf_read_int(rdr);
gu_return_on_exn(rdr->err, NULL);
if (seqid >= gu_seq_length(concr->sequences)) {
gu_raise(rdr->err, PgfReadExn);
return NULL;
}
cncfun->lins[i] = gu_seq_index(concr->sequences, PgfSequence, seqid);
}
return cncfun;
}
void
gu_raise_errno(GuExn* err)
{
GuExnData* err_data = gu_raise(err, GuErrno);
if (err_data) {
GuErrno* gu_errno = gu_new(GuErrno, err_data->pool);
*gu_errno = errno;
err_data->data = gu_errno;
}
}
char
gu_ucs_char(GuUCS uc, GuExn* err)
{
if (0 <= uc && uc <= 127) {
char c = (char) uc;
if (gu_char_is_valid(c)) {
return c;
}
}
gu_raise(err, GuUCSExn);
return 0;
}
static const uint8_t*
jpgf_jstream_begin_buffer(GuInStream* self, size_t* sz_out, GuExn* err)
{
*sz_out = 0;
JInStream* jstream = (JInStream*) self;
int sz = (*jstream->env)->CallIntMethod(jstream->env, jstream->java_stream, jstream->read_method, jstream->buf_array);
if ((*jstream->env)->ExceptionOccurred(jstream->env)) {
gu_raise(err, PgfExn);
return NULL;
}
jboolean isCopy;
jstream->buf = (*jstream->env)->GetByteArrayElements(jstream->env, jstream->buf_array, &isCopy);
if ((*jstream->env)->ExceptionOccurred(jstream->env)) {
gu_raise(err, PgfExn);
return NULL;
}
*sz_out = (size_t) sz;
return ((uint8_t*) jstream->buf);
}
char
gu_ucs_char(GuUCS uc, GuExn* err)
{
if (uc == 0) {
return '\0';
} else if (0 < uc && uc <= 127) {
char c = gu_ucs_ascii[uc];
if (c != '\0') {
return (unsigned char) c;
}
}
gu_raise(err, GuUCSExn);
return 0;
}
size_t
gu_str_to_ucs(const char* cbuf, size_t len, GuUCS* ubuf, GuExn* err)
{
size_t n = 0;
while (n < len) {
char c = cbuf[n];
if (!gu_char_is_valid(c)) {
gu_raise(err, GuUCSExn);
return n;
}
ubuf[n] = gu_char_ucs(c);
n++;
}
return n;
}
size_t
pgf_read_len(PgfReader* rdr)
{
int32_t len = pgf_read_int(rdr);
// It's crucial that we return 0 on failure, so the
// caller can proceed without checking for error
// immediately.
gu_return_on_exn(rdr->err, 0);
if (GU_UNLIKELY(len < 0)) {
GuExnData* err_data = gu_raise(rdr->err, PgfReadTagExn);
if (err_data) {
PgfReadTagExn* rtag = gu_new(PgfReadTagExn, err_data->pool);
rtag->tag = len;
err_data->data = rtag;
}
return 0;
}
return len;
}
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;
}
