summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/compiler/GF/Command/Commands.hs8
-rw-r--r--src/compiler/GF/Compile/GeneratePMCFG.hs5
-rw-r--r--src/runtime/c/gu/map.c15
-rw-r--r--src/runtime/c/gu/map.h2
-rw-r--r--src/runtime/c/pgf/graphviz.c2
-rw-r--r--src/runtime/c/pgf/parser.c330
-rw-r--r--src/runtime/haskell-bind/CHANGELOG.md8
-rw-r--r--src/runtime/haskell-bind/PGF2.hsc115
-rw-r--r--src/runtime/haskell-bind/PGF2/FFI.hsc8
-rw-r--r--src/runtime/haskell-bind/pgf2.cabal5
-rw-r--r--src/runtime/haskell/pgf.cabal30
-rw-r--r--src/runtime/python/pypgf.c70
-rw-r--r--src/server/PGFService.hs34
13 files changed, 363 insertions, 269 deletions
diff --git a/src/compiler/GF/Command/Commands.hs b/src/compiler/GF/Command/Commands.hs
index 0e5c61404..2f2e802e0 100644
--- a/src/compiler/GF/Command/Commands.hs
+++ b/src/compiler/GF/Command/Commands.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE FlexibleInstances, UndecidableInstances #-}
+{-# LANGUAGE FlexibleInstances, UndecidableInstances, CPP #-}
module GF.Command.Commands (
PGFEnv,HasPGFEnv(..),pgf,mos,pgfEnv,pgfCommands,
options,flags,
@@ -741,7 +741,7 @@ pgfCommands = Map.fromList [
Nothing -> do putStrLn ("unknown category of function identifier "++show id)
return void
[e] -> case inferExpr pgf e of
- Left tcErr -> error $ render (ppTcError tcErr)
+ Left tcErr -> errorWithoutStackTrace $ render (ppTcError tcErr)
Right (e,ty) -> do putStrLn ("Expression: "++showExpr [] e)
putStrLn ("Type: "++showType [] ty)
putStrLn ("Probability: "++show (probTree pgf e))
@@ -1019,3 +1019,7 @@ stanzas = map unlines . chop . lines where
chop ls = case break (=="") ls of
(ls1,[]) -> [ls1]
(ls1,_:ls2) -> ls1 : chop ls2
+
+#if !(MIN_VERSION_base(4,9,0))
+errorWithoutStackTrace = error
+#endif \ No newline at end of file
diff --git a/src/compiler/GF/Compile/GeneratePMCFG.hs b/src/compiler/GF/Compile/GeneratePMCFG.hs
index 35c25cc0d..ab6476b31 100644
--- a/src/compiler/GF/Compile/GeneratePMCFG.hs
+++ b/src/compiler/GF/Compile/GeneratePMCFG.hs
@@ -622,7 +622,9 @@ ppbug msg = error completeMsg
where
originalMsg = render $ hang "Internal error in GeneratePMCFG:" 4 msg
completeMsg =
- unlines [originalMsg
+ case render msg of -- the error message for pattern matching a runtime string
+ "descend (CStr 0,CNil,CProj (LIdent (Id {rawId2utf8 = \"s\"})) CNil)"
+ -> unlines [originalMsg -- add more helpful output
,""
,"1) Check that you are not trying to pattern match a /runtime string/."
," These are illegal:"
@@ -633,5 +635,6 @@ ppbug msg = error completeMsg
,"2) Not about pattern matching? Submit a bug report and we update the error message."
," https://github.com/GrammaticalFramework/gf-core/issues"
]
+ _ -> originalMsg -- any other message: just print it as is
ppU = ppTerm Unqualified
diff --git a/src/runtime/c/gu/map.c b/src/runtime/c/gu/map.c
index dc19bc932..ebd917b3e 100644
--- a/src/runtime/c/gu/map.c
+++ b/src/runtime/c/gu/map.c
@@ -322,7 +322,7 @@ gu_map_iter(GuMap* map, GuMapItor* itor, GuExn* err)
}
GU_API bool
-gu_map_next(GuMap* map, size_t* pi, void** pkey, void* pvalue)
+gu_map_next(GuMap* map, size_t* pi, void* pkey, void* pvalue)
{
while (*pi < map->data.n_entries) {
if (gu_map_entry_is_free(map, &map->data, *pi)) {
@@ -330,14 +330,17 @@ gu_map_next(GuMap* map, size_t* pi, void** pkey, void* pvalue)
continue;
}
- *pkey = &map->data.keys[*pi * map->key_size];
if (map->hasher == gu_addr_hasher) {
- *pkey = *(void**) *pkey;
+ *((void**) pkey) = *((void**) &map->data.keys[*pi * sizeof(void*)]);
+ } else if (map->hasher == gu_word_hasher) {
+ *((GuWord*) pkey) = *((GuWord*) &map->data.keys[*pi * sizeof(GuWord)]);
} else if (map->hasher == gu_string_hasher) {
- *pkey = *(void**) *pkey;
- }
+ *((GuString*) pkey) = *((GuString*) &map->data.keys[*pi * sizeof(GuString)]);
+ } else {
+ memcpy(pkey, &map->data.keys[*pi * map->key_size], map->key_size);
+ }
- memcpy(pvalue, &map->data.values[*pi * map->cell_size],
+ memcpy(pvalue, &map->data.values[*pi * map->cell_size],
map->value_size);
(*pi)++;
diff --git a/src/runtime/c/gu/map.h b/src/runtime/c/gu/map.h
index cc91a27f7..7ac33dc3b 100644
--- a/src/runtime/c/gu/map.h
+++ b/src/runtime/c/gu/map.h
@@ -75,7 +75,7 @@ GU_API_DECL void
gu_map_iter(GuMap* ht, GuMapItor* itor, GuExn* err);
GU_API bool
-gu_map_next(GuMap* map, size_t* pi, void** pkey, void* pvalue);
+gu_map_next(GuMap* map, size_t* pi, void* pkey, void* pvalue);
typedef GuMap GuIntMap;
diff --git a/src/runtime/c/pgf/graphviz.c b/src/runtime/c/pgf/graphviz.c
index a404ed009..f46b8dd3a 100644
--- a/src/runtime/c/pgf/graphviz.c
+++ b/src/runtime/c/pgf/graphviz.c
@@ -192,7 +192,7 @@ pgf_bracket_lzn_begin_phrase(PgfLinFuncs** funcs, PgfCId cat, int fid, GuString
}
static void
-pgf_bracket_lzn_end_phrase(PgfLinFuncs** funcs, PgfCId cat, int fid, size_t lindex, PgfCId fun)
+pgf_bracket_lzn_end_phrase(PgfLinFuncs** funcs, PgfCId cat, int fid, GuString ann, PgfCId fun)
{
PgfBracketLznState* state = gu_container(funcs, PgfBracketLznState, funcs);
diff --git a/src/runtime/c/pgf/parser.c b/src/runtime/c/pgf/parser.c
index 1ee24ac59..d558908ab 100644
--- a/src/runtime/c/pgf/parser.c
+++ b/src/runtime/c/pgf/parser.c
@@ -61,6 +61,14 @@ typedef struct {
typedef enum { BIND_NONE, BIND_HARD, BIND_SOFT } BIND_TYPE;
+typedef struct {
+ PgfProductionIdx* idx;
+ size_t offset;
+ size_t sym_idx;
+} PgfLexiconIdxEntry;
+
+typedef GuBuf PgfLexiconIdx;
+
struct PgfParseState {
PgfParseState* next;
@@ -74,6 +82,8 @@ struct PgfParseState {
size_t end_offset;
prob_t viterbi_prob;
+
+ PgfLexiconIdx* lexicon_idx;
};
typedef struct PgfAnswers {
@@ -687,16 +697,6 @@ static void
pgf_parsing_complete(PgfParsing* ps, PgfItem* item, PgfExprProb *ep);
static void
-pgf_parsing_push_item(PgfParseState* state, PgfItem* item)
-{
- if (gu_buf_length(state->agenda) == 0) {
- state->viterbi_prob =
- item->inside_prob+item->conts->outside_prob;
- }
- gu_buf_heap_push(state->agenda, pgf_item_prob_order, &item);
-}
-
-static void
pgf_parsing_push_production(PgfParsing* ps, PgfParseState* state,
PgfItemConts* conts, PgfProduction prod)
{
@@ -727,7 +727,7 @@ pgf_parsing_combine(PgfParsing* ps,
}
pgf_item_advance(item, ps->pool);
- pgf_parsing_push_item(before, item);
+ gu_buf_heap_push(before->agenda, pgf_item_prob_order, &item);
}
static PgfProduction
@@ -898,9 +898,65 @@ pgf_parsing_complete(PgfParsing* ps, PgfItem* item, PgfExprProb *ep)
}
}
+PGF_INTERNAL_DECL int
+pgf_symbols_cmp(PgfCohortSpot* spot,
+ PgfSymbols* syms, size_t* sym_idx,
+ bool case_sensitive);
+
+static void
+pgf_parsing_lookahead(PgfParsing *ps, PgfParseState* state,
+ int i, int j, ptrdiff_t min, ptrdiff_t max)
+{
+ // This is a variation of a binary search algorithm which
+ // can retrieve all prefixes of a string with minimal
+ // comparisons, i.e. there is no need to lookup every
+ // prefix separately.
+
+ while (i <= j) {
+ int k = (i+j) / 2;
+ PgfSequence* seq = gu_seq_index(ps->concr->sequences, PgfSequence, k);
+
+ PgfCohortSpot start = {0, ps->sentence + state->end_offset};
+ PgfCohortSpot current = start;
+ size_t sym_idx = 0;
+ int cmp = pgf_symbols_cmp(&current, seq->syms, &sym_idx, ps->case_sensitive);
+ if (cmp < 0) {
+ j = k-1;
+ } else if (cmp > 0) {
+ ptrdiff_t len = current.ptr - start.ptr;
+
+ if (min <= len)
+ pgf_parsing_lookahead(ps, state, i, k-1, min, len);
+
+ if (len+1 <= max)
+ pgf_parsing_lookahead(ps, state, k+1, j, len+1, max);
+
+ break;
+ } else {
+ ptrdiff_t len = current.ptr - start.ptr;
+
+ if (min <= len-1)
+ pgf_parsing_lookahead(ps, state, i, k-1, min, len-1);
+
+ if (seq->idx != NULL) {
+ PgfLexiconIdxEntry* entry = gu_buf_extend(state->lexicon_idx);
+ entry->idx = seq->idx;
+ entry->offset = (size_t) (current.ptr - ps->sentence);
+ entry->sym_idx = sym_idx;
+ }
+
+ if (len+1 <= max)
+ pgf_parsing_lookahead(ps, state, k+1, j, len+1, max);
+
+ break;
+ }
+ }
+}
+
static PgfParseState*
pgf_new_parse_state(PgfParsing* ps, size_t start_offset,
- BIND_TYPE bind_type)
+ BIND_TYPE bind_type,
+ prob_t viterbi_prob)
{
PgfParseState** pstate;
if (ps->before == NULL && start_offset == 0)
@@ -953,170 +1009,34 @@ pgf_new_parse_state(PgfParsing* ps, size_t start_offset,
(start_offset == end_offset);
state->start_offset = start_offset;
state->end_offset = end_offset;
- state->viterbi_prob = 0;
+ state->viterbi_prob = viterbi_prob;
+ state->lexicon_idx =
+ gu_new_buf(PgfLexiconIdxEntry, ps->pool);
if (ps->before == NULL && start_offset == 0)
state->needs_bind = false;
- *pstate = state;
-
- return state;
-}
-
-PGF_INTERNAL_DECL int
-pgf_symbols_cmp(PgfCohortSpot* spot,
- PgfSymbols* syms, size_t* sym_idx,
- bool case_sensitive);
-
-static bool
-pgf_parsing_scan_helper(PgfParsing *ps, PgfParseState* state,
- int i, int j, ptrdiff_t min, ptrdiff_t max)
-{
- // This is a variation of a binary search algorithm which
- // can retrieve all prefixes of a string with minimal
- // comparisons, i.e. there is no need to lookup every
- // prefix separately.
-
- bool found = false;
- while (i <= j) {
- int k = (i+j) / 2;
- PgfSequence* seq = gu_seq_index(ps->concr->sequences, PgfSequence, k);
-
- PgfCohortSpot start = {0, ps->sentence+state->end_offset};
- PgfCohortSpot current = start;
-
- size_t sym_idx = 0;
- int cmp = pgf_symbols_cmp(&current, seq->syms, &sym_idx, ps->case_sensitive);
- if (cmp < 0) {
- j = k-1;
- } else if (cmp > 0) {
- ptrdiff_t len = current.ptr - start.ptr;
-
- if (min <= len)
- if (pgf_parsing_scan_helper(ps, state, i, k-1, min, len))
- found = true;
-
- if (len+1 <= max)
- if (pgf_parsing_scan_helper(ps, state, k+1, j, len+1, max))
- found = true;
-
- break;
- } else {
- ptrdiff_t len = current.ptr - start.ptr;
-
- if (min <= len)
- if (pgf_parsing_scan_helper(ps, state, i, k-1, min, len))
- found = true;
-
- // Here we do bottom-up prediction for all lexical categories.
- // The epsilon productions will be predicted in top-down
- // fashion while parsing.
- if (seq->idx != NULL && len > 0) {
- found = true;
-
- // A new state will mark the end of the current match
- PgfParseState* new_state =
- pgf_new_parse_state(ps, (size_t) (current.ptr - ps->sentence), BIND_NONE);
-
- // Bottom-up prediction for lexical rules
- size_t n_entries = gu_buf_length(seq->idx);
- for (size_t i = 0; i < n_entries; i++) {
- PgfProductionIdxEntry* entry =
- gu_buf_index(seq->idx, PgfProductionIdxEntry, i);
-
- PgfItemConts* conts =
- pgf_parsing_get_conts(state,
- entry->ccat, entry->lin_idx,
- ps->pool);
-
- // Create the new category if it doesn't exist yet
- PgfCCat* tmp_ccat = pgf_parsing_get_completed(new_state, conts);
- PgfCCat* ccat = tmp_ccat;
- if (ccat == NULL) {
- ccat = pgf_parsing_create_completed(ps, new_state, conts, INFINITY);
- }
-
- // Add the production
- if (ccat->prods == NULL || ccat->n_synprods >= gu_seq_length(ccat->prods)) {
- ccat->prods = gu_realloc_seq(ccat->prods, PgfProduction, ccat->n_synprods+1);
- }
- GuVariantInfo i;
- i.tag = PGF_PRODUCTION_APPLY;
- i.data = entry->papp;
- PgfProduction prod = gu_variant_close(i);
- gu_seq_set(ccat->prods, PgfProduction, ccat->n_synprods++, prod);
-
- // Update the category's probability to be minimum
- if (ccat->viterbi_prob > entry->papp->fun->ep->prob)
- ccat->viterbi_prob = entry->papp->fun->ep->prob;
-
-#ifdef PGF_PARSER_DEBUG
- GuPool* tmp_pool = gu_new_pool();
- GuOut* out = gu_file_out(stderr, tmp_pool);
- GuExn* err = gu_exn(tmp_pool);
- if (tmp_ccat == NULL) {
- gu_printf(out, err, "[");
- pgf_print_range(state, new_state, out, err);
- gu_puts("; ", out, err);
- pgf_print_fid(conts->ccat->fid, out, err);
- gu_printf(out, err, "; %d; ",
- conts->lin_idx);
- pgf_print_fid(ccat->fid, out, err);
- gu_puts("] ", out, err);
- pgf_print_fid(ccat->fid, out, err);
- gu_printf(out, err, ".chunk_count=%d\n", ccat->chunk_count);
- }
- pgf_print_production(ccat->fid, prod, out, err);
- gu_pool_free(tmp_pool);
-#endif
- }
- }
-
- if (len <= max)
- if (pgf_parsing_scan_helper(ps, state, k+1, j, len, max))
- found = true;
-
- break;
+ if (gu_seq_length(ps->concr->sequences) > 0) {
+ // Add epsilon lexical rules to the bottom up index
+ PgfSequence* seq = gu_seq_index(ps->concr->sequences, PgfSequence, 0);
+ if (gu_seq_length(seq->syms) == 0 && seq->idx != NULL) {
+ PgfLexiconIdxEntry* entry = gu_buf_extend(state->lexicon_idx);
+ entry->idx = seq->idx;
+ entry->offset = state->start_offset;
+ entry->sym_idx= 0;
}
- }
-
- return found;
-}
-
-static void
-pgf_parsing_scan(PgfParsing *ps)
-{
- size_t len = strlen(ps->sentence);
- PgfParseState* state =
- pgf_new_parse_state(ps, 0, BIND_SOFT);
-
- while (state != NULL && state->end_offset < len) {
- if (state->needs_bind) {
- // We have encountered two tokens without space in between.
- // Those can be accepted only if there is a BIND token
- // in between. We encode this by having one more state
- // at the same offset. A transition between these two
- // states is possible only with the BIND token.
- state =
- pgf_new_parse_state(ps, state->end_offset, BIND_HARD);
+ // Add non-epsilon lexical rules to the bottom up index
+ if (!state->needs_bind) {
+ pgf_parsing_lookahead(ps, state,
+ 0, gu_seq_length(ps->concr->sequences)-1,
+ 1, strlen(ps->sentence)-state->end_offset);
}
+ }
- if (!pgf_parsing_scan_helper
- (ps, state,
- 0, gu_seq_length(ps->concr->sequences)-1,
- 1, len-state->end_offset)) {
- // skip one character and try again
- GuString s = ps->sentence+state->end_offset;
- gu_utf8_decode((const uint8_t**) &s);
- pgf_new_parse_state(ps, s-ps->sentence, BIND_NONE);
- }
+ *pstate = state;
- if (state == ps->before)
- state = ps->after;
- else
- state = state->next;
- }
+ return state;
}
static void
@@ -1138,8 +1058,9 @@ pgf_parsing_add_transition(PgfParsing* ps, PgfToken tok, PgfItem* item)
if (!ps->before->needs_bind && cmp_string(&current, tok, ps->case_sensitive) == 0) {
PgfParseState* state =
pgf_new_parse_state(ps, (current.ptr - ps->sentence),
- BIND_NONE);
- pgf_parsing_push_item(state, item);
+ BIND_NONE,
+ item->inside_prob+item->conts->outside_prob);
+ gu_buf_heap_push(state->agenda, pgf_item_prob_order, &item);
} else {
pgf_item_free(ps, item);
}
@@ -1147,6 +1068,27 @@ pgf_parsing_add_transition(PgfParsing* ps, PgfToken tok, PgfItem* item)
}
static void
+pgf_parsing_predict_lexeme(PgfParsing* ps, PgfItemConts* conts,
+ PgfProductionIdxEntry* entry,
+ size_t offset, size_t sym_idx)
+{
+ GuVariantInfo i = { PGF_PRODUCTION_APPLY, entry->papp };
+ PgfProduction prod = gu_variant_close(i);
+ PgfItem* item =
+ pgf_new_item(ps, conts, prod);
+ PgfSymbols* syms = entry->papp->fun->lins[conts->lin_idx]->syms;
+ item->sym_idx = sym_idx;
+ pgf_item_set_curr_symbol(item, ps->pool);
+ prob_t prob = item->inside_prob+item->conts->outside_prob;
+ PgfParseState* state =
+ pgf_new_parse_state(ps, offset, BIND_NONE, prob);
+ if (state->viterbi_prob > prob) {
+ state->viterbi_prob = prob;
+ }
+ gu_buf_heap_push(state->agenda, pgf_item_prob_order, &item);
+}
+
+static void
pgf_parsing_td_predict(PgfParsing* ps,
PgfItem* item, PgfCCat* ccat, size_t lin_idx)
{
@@ -1193,36 +1135,34 @@ pgf_parsing_td_predict(PgfParsing* ps,
pgf_parsing_push_production(ps, ps->before, conts, prod);
}
- // Top-down prediction for epsilon lexical rules if any
- PgfSequence* seq = gu_seq_index(ps->concr->sequences, PgfSequence, 0);
- if (gu_seq_length(seq->syms) == 0 && seq->idx != NULL) {
+ // Bottom-up prediction for lexical and epsilon rules
+ size_t n_idcs = gu_buf_length(ps->before->lexicon_idx);
+ for (size_t i = 0; i < n_idcs; i++) {
+ PgfLexiconIdxEntry* lentry =
+ gu_buf_index(ps->before->lexicon_idx, PgfLexiconIdxEntry, i);
PgfProductionIdxEntry key;
key.ccat = ccat;
key.lin_idx = lin_idx;
key.papp = NULL;
PgfProductionIdxEntry* value =
- gu_seq_binsearch(gu_buf_data_seq(seq->idx),
+ gu_seq_binsearch(gu_buf_data_seq(lentry->idx),
pgf_production_idx_entry_order,
PgfProductionIdxEntry, &key);
if (value != NULL) {
- GuVariantInfo i = { PGF_PRODUCTION_APPLY, value->papp };
- PgfProduction prod = gu_variant_close(i);
- pgf_parsing_push_production(ps, ps->before, conts, prod);
+ pgf_parsing_predict_lexeme(ps, conts, value, lentry->offset, lentry->sym_idx);
PgfProductionIdxEntry* start =
- gu_buf_data(seq->idx);
+ gu_buf_data(lentry->idx);
PgfProductionIdxEntry* end =
- start + gu_buf_length(seq->idx)-1;
+ start + gu_buf_length(lentry->idx)-1;
PgfProductionIdxEntry* left = value-1;
while (left >= start &&
value->ccat->fid == left->ccat->fid &&
value->lin_idx == left->lin_idx) {
- GuVariantInfo i = { PGF_PRODUCTION_APPLY, left->papp };
- PgfProduction prod = gu_variant_close(i);
- pgf_parsing_push_production(ps, ps->before, conts, prod);
+ pgf_parsing_predict_lexeme(ps, conts, left, lentry->offset, lentry->sym_idx);
left--;
}
@@ -1230,9 +1170,7 @@ pgf_parsing_td_predict(PgfParsing* ps,
while (right <= end &&
value->ccat->fid == right->ccat->fid &&
value->lin_idx == right->lin_idx) {
- GuVariantInfo i = { PGF_PRODUCTION_APPLY, right->papp };
- PgfProduction prod = gu_variant_close(i);
- pgf_parsing_push_production(ps, ps->before, conts, prod);
+ pgf_parsing_predict_lexeme(ps, conts, right, lentry->offset, lentry->sym_idx);
right++;
}
}
@@ -1271,7 +1209,7 @@ pgf_parsing_pre(PgfParsing* ps, PgfItem* item, PgfSymbols* syms)
} else {
item->alt = 0;
pgf_item_advance(item, ps->pool);
- pgf_parsing_push_item(ps->before, item);
+ gu_buf_heap_push(ps->before->agenda, pgf_item_prob_order, &item);
}
}
@@ -1401,8 +1339,9 @@ pgf_parsing_symbol(PgfParsing* ps, PgfItem* item, PgfSymbol sym)
item->curr_sym = gu_null_variant;
item->sym_idx = gu_seq_length(syms);
PgfParseState* state =
- pgf_new_parse_state(ps, offset, BIND_NONE);
- pgf_parsing_push_item(state, item);
+ pgf_new_parse_state(ps, offset, BIND_NONE,
+ item->inside_prob+item->conts->outside_prob);
+ gu_buf_heap_push(state->agenda, pgf_item_prob_order, &item);
match = true;
}
}
@@ -1445,10 +1384,11 @@ pgf_parsing_symbol(PgfParsing* ps, PgfItem* item, PgfSymbol sym)
if (ps->before->start_offset == ps->before->end_offset &&
ps->before->needs_bind) {
PgfParseState* state =
- pgf_new_parse_state(ps, ps->before->end_offset, BIND_HARD);
+ pgf_new_parse_state(ps, ps->before->end_offset, BIND_HARD,
+ item->inside_prob+item->conts->outside_prob);
if (state != NULL) {
pgf_item_advance(item, ps->pool);
- pgf_parsing_push_item(state, item);
+ gu_buf_heap_push(state->agenda, pgf_item_prob_order, &item);
} else {
pgf_item_free(ps, item);
}
@@ -1462,10 +1402,11 @@ pgf_parsing_symbol(PgfParsing* ps, PgfItem* item, PgfSymbol sym)
if (ps->before->start_offset == ps->before->end_offset) {
if (ps->before->needs_bind) {
PgfParseState* state =
- pgf_new_parse_state(ps, ps->before->end_offset, BIND_HARD);
+ pgf_new_parse_state(ps, ps->before->end_offset, BIND_HARD,
+ item->inside_prob+item->conts->outside_prob);
if (state != NULL) {
pgf_item_advance(item, ps->pool);
- pgf_parsing_push_item(state, item);
+ gu_buf_heap_push(state->agenda, pgf_item_prob_order, &item);
} else {
pgf_item_free(ps, item);
}
@@ -1474,7 +1415,7 @@ pgf_parsing_symbol(PgfParsing* ps, PgfItem* item, PgfSymbol sym)
}
} else {
pgf_item_advance(item, ps->pool);
- pgf_parsing_push_item(ps->before, item);
+ gu_buf_heap_push(ps->before->agenda, pgf_item_prob_order, &item);
}
break;
}
@@ -1725,7 +1666,8 @@ pgf_parsing_init(PgfConcr* concr, PgfCId cat,
ps->heuristic_factor = heuristic_factor;
}
- pgf_parsing_scan(ps);
+ PgfParseState* state =
+ pgf_new_parse_state(ps, 0, BIND_SOFT, 0);
int fidString = -1;
PgfCCat* start_ccat = gu_new(PgfCCat, ps->pool);
@@ -1745,7 +1687,7 @@ pgf_parsing_init(PgfConcr* concr, PgfCId cat,
#endif
PgfItemConts* conts =
- pgf_parsing_get_conts(ps->before, start_ccat, 0, ps->pool);
+ pgf_parsing_get_conts(state, start_ccat, 0, ps->pool);
gu_buf_push(conts->items, PgfItem*, NULL);
size_t n_ccats = gu_seq_length(cnccat->cats);
diff --git a/src/runtime/haskell-bind/CHANGELOG.md b/src/runtime/haskell-bind/CHANGELOG.md
index aed2d9c4f..570c7fd73 100644
--- a/src/runtime/haskell-bind/CHANGELOG.md
+++ b/src/runtime/haskell-bind/CHANGELOG.md
@@ -1,7 +1,11 @@
+## 1.3.0
+
+- Add completion support.
+
## 1.2.1
-- Remove deprecated pgf_print_expr_tuple
-- Added an API for cloning expressions/types/literals
+- Remove deprecated `pgf_print_expr_tuple`.
+- Added an API for cloning expressions/types/literals.
## 1.2.0
diff --git a/src/runtime/haskell-bind/PGF2.hsc b/src/runtime/haskell-bind/PGF2.hsc
index 5681f0f86..38fae67ef 100644
--- a/src/runtime/haskell-bind/PGF2.hsc
+++ b/src/runtime/haskell-bind/PGF2.hsc
@@ -43,30 +43,28 @@ module PGF2 (-- * PGF
mkCId,
exprHash, exprSize, exprFunctions, exprSubstitute,
treeProbability,
-
-- ** Types
Type, Hypo, BindType(..), startCat,
readType, showType, showContext,
mkType, unType,
-
-- ** Type checking
+ -- | Dynamically-built expressions should always be type-checked before using in other functions,
+ -- as the exceptions thrown by using invalid expressions may not catchable.
checkExpr, inferExpr, checkType,
-
-- ** Computing
compute,
-- * Concrete syntax
ConcName,Concr,languages,concreteName,languageCode,
-
-- ** Linearization
linearize,linearizeAll,tabularLinearize,tabularLinearizeAll,bracketedLinearize,bracketedLinearizeAll,
FId, BracketedString(..), showBracketedString, flattenBracketedString,
printName, categoryFields,
-
alignWords,
-- ** Parsing
ParseOutput(..), parse, parseWithHeuristics,
parseToChart, PArg(..),
+ complete,
-- ** Sentence Lookup
lookupSentence,
-- ** Generation
@@ -180,7 +178,7 @@ languageCode c = unsafePerformIO (peekUtf8CString =<< pgf_language_code (concr c
-- | Generates an exhaustive possibly infinite list of
--- all abstract syntax expressions of the given type.
+-- all abstract syntax expressions of the given type.
-- The expressions are ordered by their probability.
generateAll :: PGF -> Type -> [(Expr,Float)]
generateAll p (Type ctype _) =
@@ -469,21 +467,21 @@ newGraphvizOptions pool opts = do
-- Functions using Concr
-- Morpho analyses, parsing & linearization
--- | This triple is returned by all functions that deal with
+-- | This triple is returned by all functions that deal with
-- the grammar's lexicon. Its first element is the name of an abstract
--- lexical function which can produce a given word or
+-- lexical function which can produce a given word or
-- a multiword expression (i.e. this is the lemma).
--- After that follows a string which describes
+-- After that follows a string which describes
-- the particular inflection form.
--
-- The last element is a logarithm from the
--- the probability of the function. The probability is not
+-- the probability of the function. The probability is not
-- conditionalized on the category of the function. This makes it
-- possible to compare the likelihood of two functions even if they
--- have different types.
+-- have different types.
type MorphoAnalysis = (Fun,String,Float)
--- | 'lookupMorpho' takes a string which must be a single word or
+-- | 'lookupMorpho' takes a string which must be a single word or
-- a multiword expression. It then computes the list of all possible
-- morphological analyses.
lookupMorpho :: Concr -> String -> [MorphoAnalysis]
@@ -541,12 +539,12 @@ lookupCohorts lang@(Concr concr master) sent =
return ((start,tok,ans,end):cohs)
filterBest :: [(Int,String,[MorphoAnalysis],Int)] -> [(Int,String,[MorphoAnalysis],Int)]
-filterBest ans =
+filterBest ans =
reverse (iterate (maxBound :: Int) [(0,0,[],ans)] [] [])
where
iterate v0 [] [] res = res
iterate v0 [] new res = iterate v0 new [] res
- iterate v0 ((_,v,conf, []):old) new res =
+ iterate v0 ((_,v,conf, []):old) new res =
case compare v0 v of
LT -> res
EQ -> iterate v0 old new (merge conf res)
@@ -649,7 +647,7 @@ getAnalysis ref self c_lemma c_anal prob exn = do
data ParseOutput a
= ParseFailed Int String -- ^ The integer is the position in number of unicode characters where the parser failed.
-- The string is the token where the parser have failed.
- | ParseOk a -- ^ If the parsing and the type checking are successful
+ | ParseOk a -- ^ If the parsing and the type checking are successful
-- we get the abstract syntax trees as either a list or a chart.
| ParseIncomplete -- ^ The sentence is not complete.
@@ -659,9 +657,9 @@ parse lang ty sent = parseWithHeuristics lang ty sent (-1.0) []
parseWithHeuristics :: Concr -- ^ the language with which we parse
-> Type -- ^ the start category
-> String -- ^ the input sentence
- -> Double -- ^ the heuristic factor.
- -- A negative value tells the parser
- -- to lookup up the default from
+ -> Double -- ^ the heuristic factor.
+ -- A negative value tells the parser
+ -- to lookup up the default from
-- the grammar flags
-> [(Cat, String -> Int -> Maybe (Expr,Float,Int))]
-- ^ a list of callbacks for literal categories.
@@ -715,9 +713,9 @@ parseWithHeuristics lang (Type ctype touchType) sent heuristic callbacks =
parseToChart :: Concr -- ^ the language with which we parse
-> Type -- ^ the start category
-> String -- ^ the input sentence
- -> Double -- ^ the heuristic factor.
- -- A negative value tells the parser
- -- to lookup up the default from
+ -> Double -- ^ the heuristic factor.
+ -- A negative value tells the parser
+ -- to lookup up the default from
-- the grammar flags
-> [(Cat, String -> Int -> Maybe (Expr,Float,Int))]
-- ^ a list of callbacks for literal categories.
@@ -886,7 +884,7 @@ lookupSentence lang (Type ctype _) sent =
-- | The oracle is a triple of functions.
-- The first two take a category name and a linearization field name
--- and they should return True/False when the corresponding
+-- and they should return True/False when the corresponding
-- prediction or completion is appropriate. The third function
-- is the oracle for literals.
type Oracle = (Maybe (Cat -> String -> Int -> Bool)
@@ -974,6 +972,67 @@ parseWithOracle lang cat sent (predict,complete,literal) =
return ep
Nothing -> do return nullPtr
+-- | Returns possible completions of the current partial input.
+complete :: Concr -- ^ the language with which we parse
+ -> Type -- ^ the start category
+ -> String -- ^ the input sentence (excluding token being completed)
+ -> String -- ^ prefix (partial token being completed)
+ -> ParseOutput [(String, CId, CId, Float)] -- ^ (token, category, function, probability)
+complete lang (Type ctype _) sent pfx =
+ unsafePerformIO $ do
+ parsePl <- gu_new_pool
+ exn <- gu_new_exn parsePl
+ sent <- newUtf8CString sent parsePl
+ pfx <- newUtf8CString pfx parsePl
+ enum <- pgf_complete (concr lang) ctype sent pfx exn parsePl
+ failed <- gu_exn_is_raised exn
+ if failed
+ then do
+ is_parse_error <- gu_exn_caught exn gu_exn_type_PgfParseError
+ if is_parse_error
+ then do
+ c_err <- (#peek GuExn, data.data) exn
+ c_offset <- (#peek PgfParseError, offset) c_err
+ token_ptr <- (#peek PgfParseError, token_ptr) c_err
+ token_len <- (#peek PgfParseError, token_len) c_err
+ tok <- peekUtf8CStringLen token_ptr token_len
+ gu_pool_free parsePl
+ return (ParseFailed (fromIntegral (c_offset :: CInt)) tok)
+ else do
+ is_exn <- gu_exn_caught exn gu_exn_type_PgfExn
+ if is_exn
+ then do
+ c_msg <- (#peek GuExn, data.data) exn
+ msg <- peekUtf8CString c_msg
+ gu_pool_free parsePl
+ throwIO (PGFError msg)
+ else do
+ gu_pool_free parsePl
+ throwIO (PGFError "Parsing failed")
+ else do
+ fpl <- newForeignPtr gu_pool_finalizer parsePl
+ ParseOk <$> fromCompletions enum fpl
+ where
+ fromCompletions :: Ptr GuEnum -> ForeignPtr GuPool -> IO [(String, CId, CId, Float)]
+ fromCompletions enum fpl =
+ withGuPool $ \tmpPl -> do
+ cmpEntry <- alloca $ \ptr ->
+ withForeignPtr fpl $ \pl ->
+ do gu_enum_next enum ptr pl
+ peek ptr
+ if cmpEntry == nullPtr
+ then do
+ finalizeForeignPtr fpl
+ touchConcr lang
+ return []
+ else do
+ tok <- peekUtf8CString =<< (#peek PgfTokenProb, tok) cmpEntry
+ cat <- peekUtf8CString =<< (#peek PgfTokenProb, cat) cmpEntry
+ fun <- peekUtf8CString =<< (#peek PgfTokenProb, fun) cmpEntry
+ prob <- (#peek PgfTokenProb, prob) cmpEntry
+ toks <- unsafeInterleaveIO (fromCompletions enum fpl)
+ return ((tok, cat, fun, prob) : toks)
+
-- | Returns True if there is a linearization defined for that function in that language
hasLinearization :: Concr -> Fun -> Bool
hasLinearization lang id = unsafePerformIO $
@@ -1047,7 +1106,7 @@ linearizeAll lang e = unsafePerformIO $
-- | Generates a table of linearizations for an expression
tabularLinearize :: Concr -> Expr -> [(String, String)]
-tabularLinearize lang e =
+tabularLinearize lang e =
case tabularLinearizeAll lang e of
(lins:_) -> lins
_ -> []
@@ -1138,7 +1197,7 @@ data BracketedString
-- the phrase. The 'FId' is an unique identifier for
-- every phrase in the sentence. For context-free grammars
-- i.e. without discontinuous constituents this identifier
- -- is also unique for every bracket. When there are discontinuous
+ -- is also unique for every bracket. When there are discontinuous
-- phrases then the identifiers are unique for every phrase but
-- not for every bracket since the bracket represents a constituent.
-- The different constituents could still be distinguished by using
@@ -1148,7 +1207,7 @@ data BracketedString
-- The second 'CId' is the name of the abstract function that generated
-- this phrase.
--- | Renders the bracketed string as a string where
+-- | Renders the bracketed string as a string where
-- the brackets are shown as @(S ...)@ where
-- @S@ is the category.
showBracketedString :: BracketedString -> String
@@ -1166,7 +1225,7 @@ flattenBracketedString (Bracket _ _ _ _ bss) = concatMap flattenBracketedString
bracketedLinearize :: Concr -> Expr -> [BracketedString]
bracketedLinearize lang e = unsafePerformIO $
- withGuPool $ \pl ->
+ withGuPool $ \pl ->
do exn <- gu_new_exn pl
cts <- pgf_lzr_concretize (concr lang) (expr e) exn pl
failed <- gu_exn_is_raised exn
@@ -1192,7 +1251,7 @@ bracketedLinearize lang e = unsafePerformIO $
bracketedLinearizeAll :: Concr -> Expr -> [[BracketedString]]
bracketedLinearizeAll lang e = unsafePerformIO $
- withGuPool $ \pl ->
+ withGuPool $ \pl ->
do exn <- gu_new_exn pl
cts <- pgf_lzr_concretize (concr lang) (expr e) exn pl
failed <- gu_exn_is_raised exn
@@ -1467,7 +1526,7 @@ type LiteralCallback =
literalCallbacks :: [(AbsName,[(Cat,LiteralCallback)])]
literalCallbacks = [("App",[("PN",nerc),("Symb",chunk)])]
--- | Named entity recognition for the App grammar
+-- | Named entity recognition for the App grammar
-- (based on ../java/org/grammaticalframework/pgf/NercLiteralCallback.java)
nerc :: LiteralCallback
nerc pgf (lang,concr) sentence lin_idx offset =
diff --git a/src/runtime/haskell-bind/PGF2/FFI.hsc b/src/runtime/haskell-bind/PGF2/FFI.hsc
index c72c48e3b..16f9ad46d 100644
--- a/src/runtime/haskell-bind/PGF2/FFI.hsc
+++ b/src/runtime/haskell-bind/PGF2/FFI.hsc
@@ -103,7 +103,7 @@ foreign import ccall unsafe "gu/file.h gu_file_in"
foreign import ccall safe "gu/enum.h gu_enum_next"
gu_enum_next :: Ptr a -> Ptr (Ptr b) -> Ptr GuPool -> IO ()
-
+
foreign import ccall unsafe "gu/string.h gu_string_buf_freeze"
gu_string_buf_freeze :: Ptr GuStringBuf -> Ptr GuPool -> IO CString
@@ -241,7 +241,7 @@ newSequence elem_size pokeElem values pool = do
type FId = Int
data PArg = PArg [FId] {-# UNPACK #-} !FId deriving (Eq,Ord,Show)
-peekFId :: Ptr a -> IO FId
+peekFId :: Ptr a -> IO FId
peekFId c_ccat = do
c_fid <- (#peek PgfCCat, fid) c_ccat
return (fromIntegral (c_fid :: CInt))
@@ -256,6 +256,7 @@ data PgfApplication
data PgfConcr
type PgfExpr = Ptr ()
data PgfExprProb
+data PgfTokenProb
data PgfExprParser
data PgfFullFormEntry
data PgfMorphoCallback
@@ -422,6 +423,9 @@ foreign import ccall
foreign import ccall "pgf/pgf.h pgf_parse_with_oracle"
pgf_parse_with_oracle :: Ptr PgfConcr -> CString -> CString -> Ptr PgfOracleCallback -> Ptr GuExn -> Ptr GuPool -> Ptr GuPool -> IO (Ptr GuEnum)
+foreign import ccall "pgf/pgf.h pgf_complete"
+ pgf_complete :: Ptr PgfConcr -> PgfType -> CString -> CString -> Ptr GuExn -> Ptr GuPool -> IO (Ptr GuEnum)
+
foreign import ccall "pgf/pgf.h pgf_lookup_morpho"
pgf_lookup_morpho :: Ptr PgfConcr -> CString -> Ptr PgfMorphoCallback -> Ptr GuExn -> IO ()
diff --git a/src/runtime/haskell-bind/pgf2.cabal b/src/runtime/haskell-bind/pgf2.cabal
index 4ef9ed4f0..c8d5d8c6c 100644
--- a/src/runtime/haskell-bind/pgf2.cabal
+++ b/src/runtime/haskell-bind/pgf2.cabal
@@ -1,5 +1,5 @@
name: pgf2
-version: 1.2.1
+version: 1.3.0
synopsis: Bindings to the C version of the PGF runtime
description:
GF, Grammatical Framework, is a programming language for multilingual grammar applications.
@@ -9,8 +9,7 @@ homepage: https://www.grammaticalframework.org
license: LGPL-3
license-file: LICENSE
author: Krasimir Angelov
-maintainer: kr.angelov@gmail.com
-category: Language
+category: Natural Language Processing
build-type: Simple
extra-source-files: CHANGELOG.md, README.md
cabal-version: >=1.10
diff --git a/src/runtime/haskell/pgf.cabal b/src/runtime/haskell/pgf.cabal
index 76e12bd2c..f829a6e35 100644
--- a/src/runtime/haskell/pgf.cabal
+++ b/src/runtime/haskell/pgf.cabal
@@ -1,5 +1,5 @@
name: pgf
-version: 3.10
+version: 3.10.1-git
cabal-version: >= 1.20
build-type: Simple
@@ -9,20 +9,21 @@ synopsis: Grammatical Framework
description: A library for interpreting the Portable Grammar Format (PGF)
homepage: http://www.grammaticalframework.org/
bug-reports: https://github.com/GrammaticalFramework/gf-core/issues
-maintainer: Thomas Hallgren
-tested-with: GHC==7.6.3, GHC==7.8.3, GHC==7.10.3, GHC==8.0.2
+tested-with: GHC==7.6.3, GHC==7.8.3, GHC==7.10.3, GHC==8.0.2, GHC==8.4.4
-Library
- default-language: Haskell2010
- build-depends: base >= 4.6 && <5,
- array,
- containers,
- bytestring,
- utf8-string,
- random,
- pretty,
- mtl,
- exceptions
+library
+ default-language: Haskell2010
+ build-depends:
+ array,
+ base >= 4.6 && <5,
+ bytestring,
+ containers,
+ -- exceptions,
+ ghc-prim,
+ mtl,
+ pretty,
+ random,
+ utf8-string
other-modules:
-- not really part of GF but I have changed the original binary library
@@ -37,7 +38,6 @@ Library
--if impl(ghc>=7.8)
-- ghc-options: +RTS -A20M -RTS
ghc-prof-options: -fprof-auto
- extensions:
exposed-modules:
PGF
diff --git a/src/runtime/python/pypgf.c b/src/runtime/python/pypgf.c
index e009d9e72..eebaa2781 100644
--- a/src/runtime/python/pypgf.c
+++ b/src/runtime/python/pypgf.c
@@ -2078,6 +2078,58 @@ static PyTypeObject pgf_BracketType = {
};
typedef struct {
+ PyObject_HEAD
+} BINDObject;
+
+static PyObject *
+BIND_repr(BINDObject *self)
+{
+ return PyString_FromString("&+");
+}
+
+static PyTypeObject pgf_BINDType = {
+ PyVarObject_HEAD_INIT(NULL, 0)
+ //0, /*ob_size*/
+ "pgf.BIND", /*tp_name*/
+ sizeof(BINDObject), /*tp_basicsize*/
+ 0, /*tp_itemsize*/
+ 0, /*tp_dealloc*/
+ 0, /*tp_print*/
+ 0, /*tp_getattr*/
+ 0, /*tp_setattr*/
+ 0, /*tp_compare*/
+ 0, /*tp_repr*/
+ 0, /*tp_as_number*/
+ 0, /*tp_as_sequence*/
+ 0, /*tp_as_mapping*/
+ 0, /*tp_hash */
+ 0, /*tp_call*/
+ (reprfunc) BIND_repr, /*tp_str*/
+ 0, /*tp_getattro*/
+ 0, /*tp_setattro*/
+ 0, /*tp_as_buffer*/
+ Py_TPFLAGS_DEFAULT | Py_TPFLAGS_BASETYPE, /*tp_flags*/
+ "a marker for BIND in a bracketed string", /*tp_doc*/
+ 0, /*tp_traverse */
+ 0, /*tp_clear */
+ 0, /*tp_richcompare */
+ 0, /*tp_weaklistoffset */
+ 0, /*tp_iter */
+ 0, /*tp_iternext */
+ 0, /*tp_methods */
+ 0, /*tp_members */
+ 0, /*tp_getset */
+ 0, /*tp_base */
+ 0, /*tp_dict */
+ 0, /*tp_descr_get */
+ 0, /*tp_descr_set */
+ 0, /*tp_dictoffset */
+ 0, /*tp_init */
+ 0, /*tp_alloc */
+ 0, /*tp_new */
+};
+
+typedef struct {
PgfLinFuncs* funcs;
GuBuf* stack;
PyObject* list;
@@ -2129,6 +2181,16 @@ pgf_bracket_lzn_end_phrase(PgfLinFuncs** funcs, PgfCId cat, int fid, GuString an
}
static void
+pgf_bracket_lzn_symbol_bind(PgfLinFuncs** funcs)
+{
+ PgfBracketLznState* state = gu_container(funcs, PgfBracketLznState, funcs);
+
+ PyObject* bind = pgf_BINDType.tp_alloc(&pgf_BINDType, 0);
+ PyList_Append(state->list, bind);
+ Py_DECREF(bind);
+}
+
+static void
pgf_bracket_lzn_symbol_meta(PgfLinFuncs** funcs, PgfMetaId meta_id)
{
pgf_bracket_lzn_symbol_token(funcs, "?");
@@ -2139,7 +2201,7 @@ static PgfLinFuncs pgf_bracket_lin_funcs = {
.begin_phrase = pgf_bracket_lzn_begin_phrase,
.end_phrase = pgf_bracket_lzn_end_phrase,
.symbol_ne = NULL,
- .symbol_bind = NULL,
+ .symbol_bind = pgf_bracket_lzn_symbol_bind,
.symbol_capit = NULL,
.symbol_meta = pgf_bracket_lzn_symbol_meta
};
@@ -3559,6 +3621,9 @@ MOD_INIT(pgf)
if (PyType_Ready(&pgf_BracketType) < 0)
return MOD_ERROR_VAL;
+ if (PyType_Ready(&pgf_BINDType) < 0)
+ return MOD_ERROR_VAL;
+
if (PyType_Ready(&pgf_ExprType) < 0)
return MOD_ERROR_VAL;
@@ -3605,5 +3670,8 @@ MOD_INIT(pgf)
PyModule_AddObject(m, "Bracket", (PyObject *) &pgf_BracketType);
Py_INCREF(&pgf_BracketType);
+ PyModule_AddObject(m, "BIND", (PyObject *) &pgf_BINDType);
+ Py_INCREF(&pgf_BINDType);
+
return MOD_SUCCESS_VAL(m);
}
diff --git a/src/server/PGFService.hs b/src/server/PGFService.hs
index 7edfa9c44..260c2e278 100644
--- a/src/server/PGFService.hs
+++ b/src/server/PGFService.hs
@@ -151,29 +151,37 @@ getFile get path =
cpgfMain qsem command (t,(pgf,pc)) =
case command of
"c-parse" -> withQSem qsem $
- out t=<< join (parse # input % start % limit % treeopts)
+ out t=<< join (parse # input % cat % start % limit % treeopts)
"c-parseToChart"-> withQSem qsem $
- out t=<< join (parseToChart # input % limit)
+ out t=<< join (parseToChart # input % cat % limit)
"c-linearize" -> out t=<< lin # tree % to
"c-bracketedLinearize"
-> out t=<< bracketedLin # tree % to
"c-linearizeAll"-> out t=<< linAll # tree % to
"c-translate" -> withQSem qsem $
- out t=<<join(trans # input % to % start % limit%treeopts)
+ out t=<<join(trans # input % cat % to % start % limit%treeopts)
"c-lookupmorpho"-> out t=<< morpho # from1 % textInput
"c-lookupcohorts"->out t=<< cohorts # from1 % getInput "filter" % textInput
"c-flush" -> out t=<< flush
"c-grammar" -> out t grammar
"c-abstrtree" -> outputGraphviz=<< C.graphvizAbstractTree pgf C.graphvizDefaults # tree
"c-parsetree" -> outputGraphviz=<< (\cnc -> C.graphvizParseTree cnc C.graphvizDefaults) . snd # from1 %tree
- "c-wordforword" -> out t =<< wordforword # input % to
+ "c-wordforword" -> out t =<< wordforword # input % cat % to
_ -> badRequest "Unknown command" command
where
flush = liftIO $ do --modifyMVar_ pc $ const $ return Map.empty
performGC
return $ showJSON ()
- cat = C.startCat pgf
+ cat :: CGI C.Type
+ cat =
+ do mcat <- getInput1 "cat"
+ case mcat of
+ Nothing -> return (C.startCat pgf)
+ Just cat -> case C.readType cat of
+ Nothing -> badRequest "Bad category" cat
+ Just typ -> return typ
+
langs = C.languages pgf
grammar = showJSON $ makeObj
@@ -184,8 +192,8 @@ cpgfMain qsem command (t,(pgf,pc)) =
where
languages = [makeObj ["name".= l] | (l,_)<-Map.toList langs]
- parse input@((from,_),_) start mlimit (trie,json) =
- do r <- parse' start mlimit input
+ parse input@((from,_),_) cat start mlimit (trie,json) =
+ do r <- parse' cat start mlimit input
return $ showJSON [makeObj ("from".=from:jsonParseResult json r)]
jsonParseResult json = either bad good
@@ -195,7 +203,7 @@ cpgfMain qsem command (t,(pgf,pc)) =
tp (tree,prob) = makeObj (addTree json tree++["prob".=prob])
-- Without caching parse results:
- parse' start mlimit ((from,concr),input) =
+ parse' cat start mlimit ((from,concr),input) =
case C.parseWithHeuristics concr cat input (-1) callbacks of
C.ParseOk ts -> return (Right (maybe id take mlimit (drop start ts)))
C.ParseFailed _ tok -> return (Left tok)
@@ -221,7 +229,7 @@ cpgfMain qsem command (t,(pgf,pc)) =
-- remove unused parse results after 2 minutes
-}
- parseToChart ((from,concr),input) mlimit =
+ parseToChart ((from,concr),input) cat mlimit =
do r <- case C.parseToChart concr cat input (-1) callbacks (fromMaybe 5 mlimit) of
C.ParseOk chart -> return (good chart)
C.ParseFailed _ tok -> return (bad tok)
@@ -262,8 +270,8 @@ cpgfMain qsem command (t,(pgf,pc)) =
bracketedLin' tree (tos,unlex) =
[makeObj ["to".=to,"brackets".=showJSON (C.bracketedLinearize c tree)]|(to,c)<-tos]
- trans input@((from,_),_) to start mlimit (trie,jsontree) =
- do parses <- parse' start mlimit input
+ trans input@((from,_),_) cat to start mlimit (trie,jsontree) =
+ do parses <- parse' cat start mlimit input
return $
showJSON [ makeObj ["from".=from,
"translations".= jsonParses parses]]
@@ -297,7 +305,7 @@ cpgfMain qsem command (t,(pgf,pc)) =
_ -> id)
(C.lookupCohorts concr input)]
- wordforword input@((from,_),_) = jsonWFW from . wordforword' input
+ wordforword input@((from,_),_) cat = jsonWFW from . wordforword' input cat
jsonWFW from rs =
showJSON
@@ -307,7 +315,7 @@ cpgfMain qsem command (t,(pgf,pc)) =
[makeObj["to".=to,"text".=text]
| (to,text)<-rs]]]]]
- wordforword' inp@((from,concr),input) (tos,unlex) =
+ wordforword' inp@((from,concr),input) cat (tos,unlex) =
[(to,unlex . unwords $ map (lin_word' c) pws)
|let pws=map parse_word' (words input),(to,c)<-tos]
where