From 857e85c8a16d7e810ec14f897b7dd5ccabee6970 Mon Sep 17 00:00:00 2001 From: krangelov Date: Thu, 25 Nov 2021 19:04:35 +0100 Subject: [PATCH] implement pre {..} --- src/runtime/c/pgf/data.cxx | 34 ++- src/runtime/c/pgf/data.h | 17 ++ src/runtime/c/pgf/pgf.cxx | 253 +++++++++++++--------- src/runtime/c/pgf/pgf.h | 8 + src/runtime/c/pgf/printer.cxx | 27 ++- src/runtime/c/pgf/printer.h | 1 + src/runtime/c/pgf/reader.cxx | 16 +- src/runtime/c/pgf/writer.cxx | 8 +- src/runtime/haskell/PGF2.hsc | 1 + src/runtime/haskell/PGF2/FFI.hsc | 2 + src/runtime/haskell/PGF2/Transactions.hsc | 24 +- 11 files changed, 282 insertions(+), 109 deletions(-) diff --git a/src/runtime/c/pgf/data.cxx b/src/runtime/c/pgf/data.cxx index c047b9076..57741e3bd 100644 --- a/src/runtime/c/pgf/data.cxx +++ b/src/runtime/c/pgf/data.cxx @@ -46,6 +46,38 @@ void PgfConcrLincat::release(ref lincat) PgfDB::free(lincat->fields); } +PGF_INTERNAL +void pgf_symbol_free(PgfSymbol sym) +{ + switch (ref::get_tag(sym)) { + case PgfSymbolKP::tag: { + auto sym_kp = ref::untagged(sym); + pgf_symbols_free(sym_kp->default_form); + for (size_t i = 0; i < sym_kp->alts.len; i++) { + pgf_symbols_free(sym_kp->alts.data[i].form); + for (size_t j = 0; j < sym_kp->alts.data[i].prefixes->len; j++) { + ref prefix = *vector_elem(sym_kp->alts.data[i].prefixes, j); + PgfDB::free(prefix); + } + } + PgfDB::free(sym_kp); + break; + } + default: + PgfDB::free(ref::untagged(sym)); + } +} + +PGF_INTERNAL +void pgf_symbols_free(ref> syms) +{ + for (size_t i = 0; i < syms->len; i++) { + PgfSymbol sym = *vector_elem(syms, i); + pgf_symbol_free(sym); + } + PgfDB::free(syms); +} + void PgfConcrLin::release(ref lin) { for (size_t i = 0; i < lin->args->len; i++) { @@ -62,7 +94,7 @@ void PgfConcrLin::release(ref lin) ref> syms = *vector_elem(lin->seqs, i); for (size_t j = 0; j < syms->len; j++) { PgfSymbol sym = *vector_elem(syms, i); - PgfDB::free(ref::untagged(sym)); + pgf_symbol_free(sym); } PgfDB::free(syms); } diff --git a/src/runtime/c/pgf/data.h b/src/runtime/c/pgf/data.h index a4d7a3ea1..3d708a12c 100644 --- a/src/runtime/c/pgf/data.h +++ b/src/runtime/c/pgf/data.h @@ -151,8 +151,19 @@ struct PGF_INTERNAL_DECL PgfSymbolKS { PgfText token; }; +struct PGF_INTERNAL_DECL PgfAlternative { + ref> form; + /**< The form of this variant as a list of tokens. */ + + ref>> prefixes; + /**< The prefixes of the following symbol that trigger this + * form. */ +}; + struct PGF_INTERNAL_DECL PgfSymbolKP { static const uint8_t tag = 4; + ref> default_form; + Vector alts; }; struct PGF_INTERNAL_DECL PgfSymbolBIND { @@ -179,6 +190,12 @@ struct PGF_INTERNAL_DECL PgfSymbolALLCAPIT { static const uint8_t tag = 10; }; +PGF_INTERNAL_DECL +void pgf_symbol_free(PgfSymbol sym); + +PGF_INTERNAL_DECL +void pgf_symbols_free(ref> syms); + struct PGF_INTERNAL_DECL PgfConcrLin { size_t ref_count; diff --git a/src/runtime/c/pgf/pgf.cxx b/src/runtime/c/pgf/pgf.cxx index 65e4e7fe9..c81c32db0 100644 --- a/src/runtime/c/pgf/pgf.cxx +++ b/src/runtime/c/pgf/pgf.cxx @@ -852,12 +852,7 @@ PgfText *pgf_print_lin_seq_internal(object o, size_t i, size_t j) size_t n_seqs = lin->seqs->len / lin->res->len; ref> syms = *vector_elem(lin->seqs, i*n_seqs + j); - for (size_t k = 0; k < syms->len; k++) { - if (k > 0) - printer.puts(" "); - - printer.symbol(*vector_elem(syms, k)); - } + printer.symbols(syms); return printer.get_text(); } @@ -1207,6 +1202,11 @@ class PGF_INTERNAL PgfLinBuilder : public PgfLinBuilderIface size_t res_index; size_t seq_index; size_t sym_index; + size_t alt_index; + + ref> syms; + + size_t pre_sym_index; const char *builder_error_msg = "Detected incorrect use of the linearization builder"; @@ -1239,6 +1239,11 @@ public: this->res_index = 0; this->seq_index = 0; this->sym_index = (size_t) -1; + this->alt_index = (size_t) -1; + + this->syms = 0; + + this->pre_sym_index = (size_t) -1; } void start_production(PgfExn *err) @@ -1309,7 +1314,7 @@ public: if (seq_index >= lin->seqs->len) throw pgf_error(builder_error_msg); - ref> syms = vector_new(n_syms); + syms = vector_new(n_syms); *vector_elem(lin->seqs, seq_index) = syms; sym_index = 0; } PGF_API_END @@ -1321,15 +1326,7 @@ public: return; 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) + if (syms == 0 || sym_index == (size_t) -1 || sym_index >= syms->len) throw pgf_error(builder_error_msg); ref symcat = PgfDB::malloc(n_terms*2*sizeof(size_t)); @@ -1353,15 +1350,7 @@ public: return; 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) + if (syms == 0 || sym_index == (size_t) -1 || sym_index >= syms->len) throw pgf_error(builder_error_msg); ref symlit = PgfDB::malloc(n_terms*2*sizeof(size_t)); @@ -1385,15 +1374,7 @@ public: return; 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) + if (syms == 0 || sym_index == (size_t) -1 || sym_index >= syms->len) throw pgf_error(builder_error_msg); ref symvar = PgfDB::malloc(); @@ -1411,15 +1392,7 @@ public: return; 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) + if (syms == 0 || sym_index == (size_t) -1 || sym_index >= syms->len) throw pgf_error(builder_error_msg); ref symtok = PgfDB::malloc(token->size+1); @@ -1430,21 +1403,100 @@ public: } PGF_API_END } + void start_symkp(size_t n_syms, size_t n_alts, PgfExn *err) + { + if (err->type != PGF_EXN_NONE) + return; + + PGF_API_BEGIN { + if (syms == 0 || sym_index == (size_t) -1 || sym_index >= syms->len || pre_sym_index != (size_t) -1) + throw pgf_error(builder_error_msg); + + ref> def = vector_new(n_syms); + + ref symkp = PgfDB::malloc(n_alts*sizeof(PgfAlternative)); + symkp->default_form = def; + symkp->alts.len = n_alts; + + *vector_elem(syms, sym_index) = ref::tagged(symkp); + + pre_sym_index = sym_index; + syms = def; + sym_index = 0; + alt_index = 0; + } PGF_API_END + } + + void start_symkp_alt(size_t n_syms, size_t n_prefs, PgfText **prefs, PgfExn *err) + { + if (err->type != PGF_EXN_NONE) + return; + + PGF_API_BEGIN { + if (pre_sym_index == (size_t) -1) + throw pgf_error(builder_error_msg); + + ref> form = vector_new(n_syms); + + ref>> prefixes = vector_new>(n_prefs); + for (size_t i = 0; i < n_prefs; i++) { + ref pref = textdup_db(prefs[i]); + *vector_elem(prefixes, i) = pref; + } + + syms = *vector_elem(lin->seqs, seq_index); + ref symkp = ref::untagged(*vector_elem(syms, pre_sym_index)); + ref alt = ref::from_ptr(&symkp->alts.data[alt_index]); + + alt->form = form; + alt->prefixes = prefixes; + + syms = form; + sym_index = 0; + } PGF_API_END + } + + void end_symkp_alt(PgfExn *err) + { + if (err->type != PGF_EXN_NONE) + return; + + PGF_API_BEGIN { + if (pre_sym_index == (size_t) -1) + throw pgf_error(builder_error_msg); + + syms = *vector_elem(lin->seqs, seq_index); + ref symkp = ref::untagged(*vector_elem(syms, pre_sym_index)); + if (alt_index >= symkp->alts.len) + throw pgf_error(builder_error_msg); + + alt_index++; + } PGF_API_END + } + + void end_symkp(PgfExn *err) + { + if (err->type != PGF_EXN_NONE) + return; + + PGF_API_BEGIN { + if (pre_sym_index == (size_t) -1) + throw pgf_error(builder_error_msg); + + syms = *vector_elem(lin->seqs, seq_index); + sym_index = pre_sym_index+1; + alt_index = 0; + pre_sym_index = (size_t) -1; + } PGF_API_END + } + void add_symbind(PgfExn *err) { if (err->type != PGF_EXN_NONE) return; 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) + if (syms == 0 || sym_index == (size_t) -1 || sym_index >= syms->len) throw pgf_error(builder_error_msg); *vector_elem(syms, sym_index) = ref::tagged(0); @@ -1458,15 +1510,7 @@ public: return; 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) + if (syms == 0 || sym_index == (size_t) -1 || sym_index >= syms->len) throw pgf_error(builder_error_msg); *vector_elem(syms, sym_index) = ref::tagged(0); @@ -1480,15 +1524,7 @@ public: return; 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) + if (syms == 0 || sym_index == (size_t) -1 || sym_index >= syms->len) throw pgf_error(builder_error_msg); *vector_elem(syms, sym_index) = ref::tagged(0); @@ -1502,15 +1538,7 @@ public: return; 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) + if (syms == 0 || sym_index == (size_t) -1 || sym_index >= syms->len) throw pgf_error(builder_error_msg); *vector_elem(syms, sym_index) = ref::tagged(0); @@ -1524,15 +1552,7 @@ public: return; 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) + if (syms == 0 || sym_index == (size_t) -1 || sym_index >= syms->len) throw pgf_error(builder_error_msg); *vector_elem(syms, sym_index) = ref::tagged(0); @@ -1546,15 +1566,7 @@ public: return; 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) + if (syms == 0 || sym_index == (size_t) -1 || sym_index >= syms->len) throw pgf_error(builder_error_msg); *vector_elem(syms, sym_index) = ref::tagged(0); @@ -1567,9 +1579,10 @@ public: return; PGF_API_BEGIN { - if (sym_index != (*vector_elem(lin->seqs, seq_index))->len) + if (syms == 0 || sym_index != syms->len) throw pgf_error(builder_error_msg); sym_index = (size_t) -1; + syms = 0; seq_index++; } PGF_API_END } @@ -1616,20 +1629,52 @@ public: 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); + pgf_symbols_free(syms); } + if (sym_index != (size_t) -1) { ref> syms = *vector_elem(lin->seqs, seq_index); + + if (pre_sym_index != (size_t) -1) { + auto sym_kp = ref::untagged(*vector_elem(syms, pre_sym_index)); + + if (this->syms == sym_kp->default_form) { + for (size_t i = 0; i < sym_index; i++) { + PgfSymbol sym = *vector_elem(syms, i); + pgf_symbol_free(sym); + } + PgfDB::free(syms); + } else { + pgf_symbols_free(sym_kp->default_form); + for (size_t i = 0; i < alt_index; i++) { + pgf_symbols_free(sym_kp->alts.data[i].form); + for (size_t j = 0; j < sym_kp->alts.data[i].prefixes->len; j++) { + ref prefix = *vector_elem(sym_kp->alts.data[i].prefixes, j); + PgfDB::free(prefix); + } + } + for (size_t i = 0; i < sym_index; i++) { + PgfSymbol sym = *vector_elem(sym_kp->alts.data[alt_index].form, i); + pgf_symbol_free(sym); + } + PgfDB::free(sym_kp->alts.data[alt_index].form); + for (size_t i = 0; i < sym_kp->alts.data[alt_index].prefixes->len; i++) { + ref prefix = *vector_elem(sym_kp->alts.data[alt_index].prefixes, i); + PgfDB::free(prefix); + } + } + PgfDB::free(sym_kp); + + sym_index = pre_sym_index; + } + for (size_t j = 0; j < sym_index; j++) { PgfSymbol sym = *vector_elem(syms, j); - PgfDB::free(ref::untagged(sym)); + pgf_symbol_free(sym); } PgfDB::free(syms); } + PgfDB::free(lin->seqs); PgfDB::free(lin); diff --git a/src/runtime/c/pgf/pgf.h b/src/runtime/c/pgf/pgf.h index fd8bd5b46..85a8fa6de 100644 --- a/src/runtime/c/pgf/pgf.h +++ b/src/runtime/c/pgf/pgf.h @@ -494,6 +494,10 @@ struct PgfLinBuilderIface { virtual void add_symlit(size_t d, size_t i0, size_t n_terms, size_t *terms, PgfExn *err)=0; virtual void add_symvar(size_t d, size_t r, PgfExn *err)=0; virtual void add_symks(PgfText *token, PgfExn *err)=0; + virtual void start_symkp(size_t n_syms, size_t n_alts, PgfExn *err)=0; + virtual void start_symkp_alt(size_t n_syms, size_t n_prefs, PgfText **prefs, PgfExn *err)=0; + virtual void end_symkp_alt(PgfExn *err)=0; + virtual void end_symkp(PgfExn *err)=0; virtual void add_symbind(PgfExn *err)=0; virtual void add_symsoftbind(PgfExn *err)=0; virtual void add_symne(PgfExn *err)=0; @@ -519,6 +523,10 @@ typedef struct { void (*add_symlit)(PgfLinBuilderIface *this, size_t d, size_t i0, size_t n_terms, size_t *terms, PgfExn *err); void (*add_symvar)(PgfLinBuilderIface *this, size_t d, size_t r, PgfExn *err); void (*add_symks)(PgfLinBuilderIface *this, PgfText *token, PgfExn *err); + void (*start_symkp)(PgfLinBuilderIface *this, size_t n_syms, size_t n_alts, PgfExn *err); + void (*start_symkp_alt)(PgfLinBuilderIface *this, size_t n_syms, size_t n_prefs, PgfText **prefs, PgfExn *err); + void (*end_symkp_alt)(PgfLinBuilderIface *this, PgfExn *err); + void (*end_symkp)(PgfLinBuilderIface *this, PgfExn *err); void (*add_symbind)(PgfLinBuilderIface *this, PgfExn *err); void (*add_symsoftbind)(PgfLinBuilderIface *this, PgfExn *err); void (*add_symne)(PgfLinBuilderIface *this, PgfExn *err); diff --git a/src/runtime/c/pgf/printer.cxx b/src/runtime/c/pgf/printer.cxx index c51f07263..95120860e 100644 --- a/src/runtime/c/pgf/printer.cxx +++ b/src/runtime/c/pgf/printer.cxx @@ -496,7 +496,22 @@ void PgfPrinter::symbol(PgfSymbol sym) break; } case PgfSymbolKP::tag: { - auto sym_ks = ref::untagged(sym); + auto sym_kp = ref::untagged(sym); + puts("pre {"); + + symbols(sym_kp->default_form); + + for (size_t i = 0; i < sym_kp->alts.len; i++) { + puts("; "); + symbols(sym_kp->alts.data[i].form); + puts(" /"); + for (size_t j = 0; j < sym_kp->alts.data[i].prefixes->len; j++) { + puts(" "); + lstr(sym_kp->alts.data[i].prefixes->data[j]); + } + } + + puts("}"); break; } case PgfSymbolBIND::tag: @@ -520,6 +535,16 @@ void PgfPrinter::symbol(PgfSymbol sym) } } +void PgfPrinter::symbols(ref> syms) +{ + for (size_t i = 0; i < syms->len; i++) { + if (i > 0) + puts(" "); + + symbol(*vector_elem(syms, i)); + } +} + void PgfPrinter::free_ref(object x) { } diff --git a/src/runtime/c/pgf/printer.h b/src/runtime/c/pgf/printer.h index 4884710e2..185aa32b1 100644 --- a/src/runtime/c/pgf/printer.h +++ b/src/runtime/c/pgf/printer.h @@ -53,6 +53,7 @@ public: void parg(ref ty, ref parg); void lparam(ref lparam); void symbol(PgfSymbol sym); + void symbols(ref> syms); virtual PgfExpr eabs(PgfBindType btype, PgfText *name, PgfExpr body); virtual PgfExpr eapp(PgfExpr fun, PgfExpr arg); diff --git a/src/runtime/c/pgf/reader.cxx b/src/runtime/c/pgf/reader.cxx index 93d7cdd61..9743c78e7 100644 --- a/src/runtime/c/pgf/reader.cxx +++ b/src/runtime/c/pgf/reader.cxx @@ -442,7 +442,21 @@ PgfSymbol PgfReader::read_symbol() break; } case PgfSymbolKP::tag: { - ref sym_kp = PgfDB::malloc(); + size_t n_alts = read_len(); + ref sym_kp = PgfDB::malloc(n_alts*sizeof(PgfAlternative)); + sym_kp->alts.len = n_alts; + + for (size_t i = 0; i < n_alts; i++) { + auto form = read_vector(&PgfReader::read_symbol2); + auto prefixes = read_vector(&PgfReader::read_text2); + + sym_kp->alts.data[i].form = form; + sym_kp->alts.data[i].prefixes = prefixes; + } + + auto default_form = read_vector(&PgfReader::read_symbol2); + sym_kp->default_form = default_form; + sym = ref::tagged(sym_kp); break; } diff --git a/src/runtime/c/pgf/writer.cxx b/src/runtime/c/pgf/writer.cxx index 9e1a4fb6e..cd18a7e83 100644 --- a/src/runtime/c/pgf/writer.cxx +++ b/src/runtime/c/pgf/writer.cxx @@ -381,7 +381,13 @@ void PgfWriter::write_symbol(PgfSymbol sym) break; } case PgfSymbolKP::tag: { - auto sym_ks = ref::untagged(sym); + auto sym_kp = ref::untagged(sym); + write_len(sym_kp->alts.len); + for (size_t i = 0; i < sym_kp->alts.len; i++) { + write_seq(sym_kp->alts.data[i].form); + write_vector(sym_kp->alts.data[i].prefixes, &PgfWriter::write_text); + } + write_seq(sym_kp->default_form); break; } case PgfSymbolBIND::tag: diff --git a/src/runtime/haskell/PGF2.hsc b/src/runtime/haskell/PGF2.hsc index 8300bb66e..7667062c6 100644 --- a/src/runtime/haskell/PGF2.hsc +++ b/src/runtime/haskell/PGF2.hsc @@ -275,6 +275,7 @@ showPGF p = nest 2 (vcat syms) $$ char ']') modifyIORef ref $ (\doc -> doc $$ def) + return () -- | The abstract language name is the name of the top-level -- abstract module diff --git a/src/runtime/haskell/PGF2/FFI.hsc b/src/runtime/haskell/PGF2/FFI.hsc index 139e9ff23..a1196f92a 100644 --- a/src/runtime/haskell/PGF2/FFI.hsc +++ b/src/runtime/haskell/PGF2/FFI.hsc @@ -185,6 +185,8 @@ foreign import ccall "dynamic" callLinBuilder4 :: Dynamic (Ptr PgfLinBuilderIfac foreign import ccall "dynamic" callLinBuilder5 :: Dynamic (Ptr PgfLinBuilderIface -> Ptr PgfText -> Ptr PgfExn -> IO ()) +foreign import ccall "dynamic" callLinBuilder6 :: Dynamic (Ptr PgfLinBuilderIface -> CSize -> CSize -> Ptr (Ptr PgfText) -> Ptr PgfExn -> IO ()) + foreign import ccall pgf_create_lincat :: Ptr PgfDB -> Ptr PGF -> Ptr Concr -> Ptr PgfText -> CSize -> Ptr (Ptr PgfText) -> Ptr PgfExn -> IO () foreign import ccall pgf_drop_lincat :: Ptr PgfDB -> Ptr Concr -> Ptr PgfText -> Ptr PgfExn -> IO () diff --git a/src/runtime/haskell/PGF2/Transactions.hsc b/src/runtime/haskell/PGF2/Transactions.hsc index d5d24bc23..ea23bac89 100644 --- a/src/runtime/haskell/PGF2/Transactions.hsc +++ b/src/runtime/haskell/PGF2/Transactions.hsc @@ -264,7 +264,7 @@ createLin name prods = Transaction $ \c_db c_abstr c_revision c_exn -> 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 + forM_ syms c_exn (addSymbol c_builder vtbl c_exn) fun <- (#peek PgfLinBuilderIfaceVtbl, end_sequence) vtbl callLinBuilder0 fun c_builder c_exn fun <- (#peek PgfLinBuilderIfaceVtbl, end_production) vtbl @@ -283,6 +283,28 @@ createLin name prods = Transaction $ \c_db c_abstr c_revision c_exn -> fun <- (#peek PgfLinBuilderIfaceVtbl, add_symks) vtbl withText tok $ \c_tok -> callLinBuilder5 fun c_builder c_tok c_exn + addSymbol c_builder vtbl c_exn (SymKP def alts) = do + fun <- (#peek PgfLinBuilderIfaceVtbl, start_symkp) vtbl + callLinBuilder2 fun c_builder (fromIntegral (length def)) (fromIntegral (length alts)) c_exn + forM_ def c_exn (addSymbol c_builder vtbl c_exn) + forM_ alts c_exn $ \(form,ps) -> do + let n_ps = length ps + (allocaBytes (n_ps*(#size PgfText*)) $ \c_ps -> + withTexts c_ps 0 ps $ do + fun <- (#peek PgfLinBuilderIfaceVtbl, start_symkp_alt) vtbl + callLinBuilder6 fun c_builder (fromIntegral (length form)) (fromIntegral n_ps) c_ps c_exn) + forM_ form c_exn (addSymbol c_builder vtbl c_exn) + fun <- (#peek PgfLinBuilderIfaceVtbl, end_symkp_alt) vtbl + callLinBuilder0 fun c_builder c_exn + fun <- (#peek PgfLinBuilderIfaceVtbl, end_symkp) vtbl + callLinBuilder0 fun c_builder c_exn + where + withTexts p i [] f = f + withTexts p i (s:ss) f = + withText s $ \c_s -> do + pokeElemOff p i c_s + withTexts p (i+1) ss f + addSymbol c_builder vtbl c_exn SymBIND = do fun <- (#peek PgfLinBuilderIfaceVtbl, add_symbind) vtbl callLinBuilder0 fun c_builder c_exn