diff --git a/src/runtime/c/pgf/pgf.cxx b/src/runtime/c/pgf/pgf.cxx index 532316380..32809e438 100644 --- a/src/runtime/c/pgf/pgf.cxx +++ b/src/runtime/c/pgf/pgf.cxx @@ -1155,170 +1155,424 @@ class PGF_INTERNAL PgfLinBuilder : public PgfLinBuilderIface size_t seq_index; size_t sym_index; + const char *builder_error_msg = + "Detected incorrect use of the linearization builder"; + public: - PgfLinBuilder(ref lin) { - this->lin = lin; + PgfLinBuilder(ref absfun, PgfConcr *concr, size_t n_prods) + { + ref lincat = + namespace_lookup(concr->lincats, &absfun->type->name); + if (lincat == 0) { + throw pgf_error("Missing linearization category"); + } + + lin = PgfDB::malloc(absfun->name.size+1); + memcpy(&lin->name, &absfun->name, sizeof(PgfText)+absfun->name.size+1); + lin->ref_count = 1; + lin->absfun = absfun; + lin->args = vector_new(n_prods*absfun->type->hypos->len); + lin->res = vector_new>(n_prods); + lin->seqs = vector_new>>(n_prods*lincat->fields->len); + this->arg_index = 0; this->res_index = 0; this->seq_index = 0; - this->sym_index = 0; + this->sym_index = (size_t) -1; } void start_production(PgfExn *err) { + if (err->type != PGF_EXN_NONE) + return; + + PGF_API_BEGIN { + if (res_index >= lin->res->len) + throw pgf_error(builder_error_msg); + *vector_elem(lin->res, res_index) = 0; + } PGF_API_END } void add_argument(size_t i0, size_t n_terms, size_t *terms, PgfExn *err) { - ref param = PgfDB::malloc(n_terms*2*sizeof(size_t)); - param->i0 = i0; - param->n_terms = n_terms; + if (err->type != PGF_EXN_NONE) + return; - for (size_t i = 0; i < n_terms; i++) { - param->terms[i].factor = terms[2*i]; - param->terms[i].var = terms[2*i+1]; - } + PGF_API_BEGIN { + if (arg_index >= lin->args->len) + throw pgf_error(builder_error_msg); - ref parg = vector_elem(lin->args, arg_index); - parg->param = param; + ref param = PgfDB::malloc(n_terms*2*sizeof(size_t)); + param->i0 = i0; + param->n_terms = n_terms; - arg_index++; + for (size_t i = 0; i < n_terms; i++) { + param->terms[i].factor = terms[2*i]; + param->terms[i].var = terms[2*i+1]; + } + + ref parg = vector_elem(lin->args, arg_index); + parg->param = param; + + arg_index++; + } PGF_API_END } void set_result(size_t i0, size_t n_terms, size_t *terms, PgfExn *err) { - ref param = PgfDB::malloc(n_terms*2*sizeof(size_t)); - param->i0 = i0; - param->n_terms = n_terms; + if (err->type != PGF_EXN_NONE) + return; - for (size_t i = 0; i < n_terms; i++) { - param->terms[i].factor = terms[2*i]; - param->terms[i].var = terms[2*i+1]; - } + PGF_API_BEGIN { + if (res_index >= lin->res->len) + throw pgf_error(builder_error_msg); - *vector_elem(lin->res, res_index) = param; + ref param = PgfDB::malloc(n_terms*2*sizeof(size_t)); + param->i0 = i0; + param->n_terms = n_terms; + + for (size_t i = 0; i < n_terms; i++) { + param->terms[i].factor = terms[2*i]; + param->terms[i].var = terms[2*i+1]; + } + + *vector_elem(lin->res, res_index) = param; + } PGF_API_END } void start_sequence(size_t n_syms, PgfExn *err) { - *vector_elem(lin->seqs, seq_index) = vector_new(n_syms); - sym_index = 0; + if (err->type != PGF_EXN_NONE) + return; + + PGF_API_BEGIN { + if (seq_index >= lin->seqs->len) + throw pgf_error(builder_error_msg); + + *vector_elem(lin->seqs, seq_index) = vector_new(n_syms); + sym_index = 0; + } PGF_API_END } void add_symcat(size_t d, size_t i0, size_t n_terms, size_t *terms, PgfExn *err) { - ref symcat = PgfDB::malloc(n_terms*2*sizeof(size_t)); - symcat->d = d; - symcat->r.i0 = i0; - symcat->r.n_terms = n_terms; + if (err->type != PGF_EXN_NONE) + return; - for (size_t i = 0; i < n_terms; i++) { - symcat->r.terms[i].factor = terms[2*i]; - symcat->r.terms[i].var = terms[2*i+1]; - } + PGF_API_BEGIN { + if (sym_index == (size_t) -1) + throw pgf_error(builder_error_msg); - ref> syms = *vector_elem(lin->seqs, seq_index); - *vector_elem(syms, sym_index) = ref::tagged(symcat); + if (seq_index >= lin->seqs->len) + throw pgf_error(builder_error_msg); - sym_index++; + ref> syms = *vector_elem(lin->seqs, seq_index); + + if (sym_index >= syms->len) + throw pgf_error(builder_error_msg); + + ref symcat = PgfDB::malloc(n_terms*2*sizeof(size_t)); + symcat->d = d; + symcat->r.i0 = i0; + symcat->r.n_terms = n_terms; + + for (size_t i = 0; i < n_terms; i++) { + symcat->r.terms[i].factor = terms[2*i]; + symcat->r.terms[i].var = terms[2*i+1]; + } + + *vector_elem(syms, sym_index) = ref::tagged(symcat); + sym_index++; + } PGF_API_END } void add_symlit(size_t d, size_t i0, size_t n_terms, size_t *terms, PgfExn *err) { - ref symlit = PgfDB::malloc(n_terms*2*sizeof(size_t)); - symlit->d = d; - symlit->r.i0 = i0; - symlit->r.n_terms = n_terms; + if (err->type != PGF_EXN_NONE) + return; - for (size_t i = 0; i < n_terms; i++) { - symlit->r.terms[i].factor = terms[2*i]; - symlit->r.terms[i].var = terms[2*i+1]; - } + PGF_API_BEGIN { + if (sym_index == (size_t) -1) + throw pgf_error(builder_error_msg); - ref> syms = *vector_elem(lin->seqs, seq_index); - *vector_elem(syms, sym_index) = ref::tagged(symlit); + if (seq_index >= lin->seqs->len) + throw pgf_error(builder_error_msg); - sym_index++; + ref> syms = *vector_elem(lin->seqs, seq_index); + + if (sym_index >= syms->len) + throw pgf_error(builder_error_msg); + + ref symlit = PgfDB::malloc(n_terms*2*sizeof(size_t)); + symlit->d = d; + symlit->r.i0 = i0; + symlit->r.n_terms = n_terms; + + for (size_t i = 0; i < n_terms; i++) { + symlit->r.terms[i].factor = terms[2*i]; + symlit->r.terms[i].var = terms[2*i+1]; + } + + *vector_elem(syms, sym_index) = ref::tagged(symlit); + sym_index++; + } PGF_API_END } void add_symvar(size_t d, size_t r, PgfExn *err) { - ref symvar = PgfDB::malloc(); - symvar->d = d; - symvar->r = r; + if (err->type != PGF_EXN_NONE) + return; - ref> syms = *vector_elem(lin->seqs, seq_index); - *vector_elem(syms, sym_index) = ref::tagged(symvar); + PGF_API_BEGIN { + if (sym_index == (size_t) -1) + throw pgf_error(builder_error_msg); - sym_index++; + if (seq_index >= lin->seqs->len) + throw pgf_error(builder_error_msg); + + ref> syms = *vector_elem(lin->seqs, seq_index); + + if (sym_index >= syms->len) + throw pgf_error(builder_error_msg); + + ref symvar = PgfDB::malloc(); + symvar->d = d; + symvar->r = r; + + *vector_elem(syms, sym_index) = ref::tagged(symvar); + sym_index++; + } PGF_API_END } void add_symks(PgfText *token, PgfExn *err) { - ref symtok = PgfDB::malloc(token->size+1); - memcpy(&symtok->token, token, sizeof(PgfText)+token->size+1); + if (err->type != PGF_EXN_NONE) + return; - ref> syms = *vector_elem(lin->seqs, seq_index); - *vector_elem(syms, sym_index) = ref::tagged(symtok); + PGF_API_BEGIN { + if (sym_index == (size_t) -1) + throw pgf_error(builder_error_msg); - sym_index++; + if (seq_index >= lin->seqs->len) + throw pgf_error(builder_error_msg); + + ref> syms = *vector_elem(lin->seqs, seq_index); + + if (sym_index >= syms->len) + throw pgf_error(builder_error_msg); + + ref symtok = PgfDB::malloc(token->size+1); + memcpy(&symtok->token, token, sizeof(PgfText)+token->size+1); + + *vector_elem(syms, sym_index) = ref::tagged(symtok); + sym_index++; + } PGF_API_END } void add_symbind(PgfExn *err) { - ref> syms = *vector_elem(lin->seqs, seq_index); - *vector_elem(syms, sym_index) = ref::tagged(0); + if (err->type != PGF_EXN_NONE) + return; - sym_index++; + PGF_API_BEGIN { + if (sym_index == (size_t) -1) + throw pgf_error(builder_error_msg); + + if (seq_index >= lin->seqs->len) + throw pgf_error(builder_error_msg); + + ref> syms = *vector_elem(lin->seqs, seq_index); + + if (sym_index >= syms->len) + throw pgf_error(builder_error_msg); + + *vector_elem(syms, sym_index) = ref::tagged(0); + sym_index++; + } PGF_API_END } void add_symsoftbind(PgfExn *err) { - ref> syms = *vector_elem(lin->seqs, seq_index); - *vector_elem(syms, sym_index) = ref::tagged(0); + if (err->type != PGF_EXN_NONE) + return; - sym_index++; + PGF_API_BEGIN { + if (sym_index == (size_t) -1) + throw pgf_error(builder_error_msg); + + if (seq_index >= lin->seqs->len) + throw pgf_error(builder_error_msg); + + ref> syms = *vector_elem(lin->seqs, seq_index); + + if (sym_index >= syms->len) + throw pgf_error(builder_error_msg); + + *vector_elem(syms, sym_index) = ref::tagged(0); + sym_index++; + } PGF_API_END } void add_symne(PgfExn *err) { - ref> syms = *vector_elem(lin->seqs, seq_index); - *vector_elem(syms, sym_index) = ref::tagged(0); + if (err->type != PGF_EXN_NONE) + return; - sym_index++; + PGF_API_BEGIN { + if (sym_index == (size_t) -1) + throw pgf_error(builder_error_msg); + + if (seq_index >= lin->seqs->len) + throw pgf_error(builder_error_msg); + + ref> syms = *vector_elem(lin->seqs, seq_index); + + if (sym_index >= syms->len) + throw pgf_error(builder_error_msg); + + *vector_elem(syms, sym_index) = ref::tagged(0); + sym_index++; + } PGF_API_END } void add_symsoftspace(PgfExn *err) { - ref> syms = *vector_elem(lin->seqs, seq_index); - *vector_elem(syms, sym_index) = ref::tagged(0); + if (err->type != PGF_EXN_NONE) + return; - sym_index++; + PGF_API_BEGIN { + if (sym_index == (size_t) -1) + throw pgf_error(builder_error_msg); + + if (seq_index >= lin->seqs->len) + throw pgf_error(builder_error_msg); + + ref> syms = *vector_elem(lin->seqs, seq_index); + + if (sym_index >= syms->len) + throw pgf_error(builder_error_msg); + + *vector_elem(syms, sym_index) = ref::tagged(0); + sym_index++; + } PGF_API_END } void add_symcapit(PgfExn *err) { - ref> syms = *vector_elem(lin->seqs, seq_index); - *vector_elem(syms, sym_index) = ref::tagged(0); + if (err->type != PGF_EXN_NONE) + return; - sym_index++; + PGF_API_BEGIN { + if (sym_index == (size_t) -1) + throw pgf_error(builder_error_msg); + + if (seq_index >= lin->seqs->len) + throw pgf_error(builder_error_msg); + + ref> syms = *vector_elem(lin->seqs, seq_index); + + if (sym_index >= syms->len) + throw pgf_error(builder_error_msg); + + *vector_elem(syms, sym_index) = ref::tagged(0); + sym_index++; + } PGF_API_END } void add_symallcapit(PgfExn *err) { - ref> syms = *vector_elem(lin->seqs, seq_index); - *vector_elem(syms, sym_index) = ref::tagged(0); + if (err->type != PGF_EXN_NONE) + return; - sym_index++; + PGF_API_BEGIN { + if (sym_index == (size_t) -1) + throw pgf_error(builder_error_msg); + + if (seq_index >= lin->seqs->len) + throw pgf_error(builder_error_msg); + + ref> syms = *vector_elem(lin->seqs, seq_index); + + if (sym_index >= syms->len) + throw pgf_error(builder_error_msg); + + *vector_elem(syms, sym_index) = ref::tagged(0); + } PGF_API_END } - void end_sequence(PgfExn *err) { - seq_index++; + void end_sequence(PgfExn *err) + { + if (err->type != PGF_EXN_NONE) + return; + + PGF_API_BEGIN { + if (sym_index != (*vector_elem(lin->seqs, seq_index))->len) + throw pgf_error(builder_error_msg); + sym_index = (size_t) -1; + seq_index++; + } PGF_API_END } void end_production(PgfExn *err) { - this->res_index++; + if (err->type != PGF_EXN_NONE) + return; + + PGF_API_BEGIN { + size_t n_args = (lin->args->len/lin->res->len); + if (arg_index != (res_index+1)*n_args) + throw pgf_error(builder_error_msg); + + if (*vector_elem(lin->res, res_index) == 0) + throw pgf_error(builder_error_msg); + + size_t n_seqs = (lin->seqs->len/lin->res->len); + if (seq_index != (res_index+1)*n_seqs) + throw pgf_error(builder_error_msg); + + res_index++; + } PGF_API_END + } + + ref done() + { + if (res_index != lin->res->len) + throw pgf_error(builder_error_msg); + return lin; + } + + void failed() + { + for (size_t i = 0; i < arg_index; i++) { + PgfDB::free(vector_elem(lin->args, i)->param); + } + PgfDB::free(lin->args); + + for (size_t i = 0; i < res_index; i++) { + PgfDB::free(*vector_elem(lin->res, i)); + } + PgfDB::free(lin->res); + + for (size_t i = 0; i < seq_index; i++) { + ref> syms = *vector_elem(lin->seqs, i); + for (size_t j = 0; j < syms->len; j++) { + PgfSymbol sym = *vector_elem(syms, j); + PgfDB::free(ref::untagged(sym)); + } + PgfDB::free(syms); + } + if (sym_index != (size_t) -1) { + ref> syms = *vector_elem(lin->seqs, seq_index); + for (size_t j = 0; j < sym_index; j++) { + PgfSymbol sym = *vector_elem(syms, j); + PgfDB::free(ref::untagged(sym)); + } + PgfDB::free(syms); + } + PgfDB::free(lin->seqs); + + PgfDB::free(lin); + lin = 0; } }; @@ -1394,27 +1648,17 @@ void pgf_create_lin(PgfDB *db, throw pgf_error("There is no corresponding function in the abstract syntax"); } - ref lincat = - namespace_lookup(concr->lincats, &absfun->type->name); - if (lincat == 0) { - throw pgf_error("Missing linearization category"); - } - - ref lin = PgfDB::malloc(name->size+1); - memcpy(&lin->name, name, sizeof(PgfText)+name->size+1); - lin->ref_count = 1; - lin->absfun = absfun; - lin->args = vector_new(n_prods*absfun->type->hypos->len); - lin->res = vector_new>(n_prods); - lin->seqs = vector_new>>(n_prods*lincat->fields->len); - - PgfLinBuilder builder(lin); + PgfLinBuilder builder(absfun, concr, n_prods); build->build(&builder, err); - - Namespace lins = - namespace_insert(concr->lins, lin); - namespace_release(concr->lins); - concr->lins = lins; + if (err->type == PGF_EXN_NONE) { + ref lin = builder.done(); + Namespace lins = + namespace_insert(concr->lins, lin); + namespace_release(concr->lins); + concr->lins = lins; + } else { + builder.failed(); + } } PGF_API_END } diff --git a/src/runtime/haskell/PGF2/Transactions.hsc b/src/runtime/haskell/PGF2/Transactions.hsc index 82acbe8fa..5f388b888 100644 --- a/src/runtime/haskell/PGF2/Transactions.hsc +++ b/src/runtime/haskell/PGF2/Transactions.hsc @@ -31,7 +31,6 @@ import PGF2.Expr import Foreign import Foreign.C -import Control.Monad import Control.Exception #include @@ -243,17 +242,24 @@ createLin name prods = Transaction $ \c_db c_abstr c_revision c_exn -> (#poke PgfBuildLinIfaceVtbl, build) vtbl c_callback pgf_create_lin c_db c_abstr c_revision c_name (fromIntegral (length prods)) c_build c_exn where + forM_ [] c_exn f = return () + forM_ (x:xs) c_exn f = do + ex_type <- (#peek PgfExn, type) c_exn + if (ex_type :: (#type PgfExnType)) == (#const PGF_EXN_NONE) + then f x >> forM_ xs c_exn f + else return () + build _ c_builder c_exn = do vtbl <- (#peek PgfLinBuilderIface, vtbl) c_builder - forM_ prods $ \(Production args res seqs) -> do + forM_ prods c_exn $ \(Production args res seqs) -> do fun <- (#peek PgfLinBuilderIfaceVtbl, start_production) vtbl callLinBuilder0 fun c_builder c_exn fun <- (#peek PgfLinBuilderIfaceVtbl, add_argument) vtbl - forM_ args $ \(PArg _ param) -> + forM_ args c_exn $ \(PArg _ param) -> callLParam (callLinBuilder3 fun c_builder) param c_exn fun <- (#peek PgfLinBuilderIfaceVtbl, set_result) vtbl callLParam (callLinBuilder3 fun c_builder) res c_exn - forM_ seqs $ \syms -> do + forM_ seqs c_exn $ \syms -> do fun <- (#peek PgfLinBuilderIfaceVtbl, start_sequence) vtbl callLinBuilder1 fun c_builder (fromIntegral (length syms)) c_exn mapM_ (addSymbol c_builder vtbl c_exn) syms @@ -261,7 +267,6 @@ createLin name prods = Transaction $ \c_db c_abstr c_revision c_exn -> callLinBuilder0 fun c_builder c_exn fun <- (#peek PgfLinBuilderIfaceVtbl, end_production) vtbl callLinBuilder0 fun c_builder c_exn - return () addSymbol c_builder vtbl c_exn (SymCat d r) = do fun <- (#peek PgfLinBuilderIfaceVtbl, add_symcat) vtbl