bring the Haskell binding a bit closer to the pure Haskell API

5 files changed, 44 insertions, 33 deletions

diff --git a/src/runtime/c/pgf/parser.c b/src/runtime/c/pgf/parser.c
index 8843a5f37..fb2fbfc22 100644
--- a/src/runtime/c/pgf/parser.c
+++ b/src/runtime/c/pgf/parser.c
@@ -2106,16 +2106,16 @@ pgf_parsing_last_token(PgfParsing* ps, GuPool* pool)
 }
 
 GuEnum*
-pgf_parse(PgfConcr* concr, PgfCId cat, GuString sentence,
+pgf_parse(PgfConcr* concr, PgfType* typ, GuString sentence,
           GuExn* err, 
           GuPool* pool, GuPool* out_pool)
 {
 	PgfCallbacksMap* callbacks = pgf_new_callbacks_map(concr, out_pool); 
-    return pgf_parse_with_heuristics(concr, cat, sentence, -1.0, callbacks, err, pool, out_pool);
+    return pgf_parse_with_heuristics(concr, typ, sentence, -1.0, callbacks, err, pool, out_pool);
 }
 
 GuEnum*
-pgf_parse_with_heuristics(PgfConcr* concr, PgfCId cat, GuString sentence,
+pgf_parse_with_heuristics(PgfConcr* concr, PgfType* typ, GuString sentence,
                           double heuristics,
                           PgfCallbacksMap* callbacks,
                           GuExn* err,
@@ -2132,7 +2132,7 @@ pgf_parse_with_heuristics(PgfConcr* concr, PgfCId cat, GuString sentence,
 
 	// Begin parsing a sentence with the specified category
 	PgfParsing* ps =
-		pgf_parsing_init(concr, cat, 0, sentence, heuristics, callbacks, NULL, err, pool, out_pool);
+		pgf_parsing_init(concr, typ->cid, 0, sentence, heuristics, callbacks, NULL, err, pool, out_pool);
 	if (ps == NULL) {
 		return NULL;
 	}
@@ -2159,7 +2159,7 @@ pgf_parse_with_heuristics(PgfConcr* concr, PgfCId cat, GuString sentence,
 }
 
 PgfExprEnum*
-pgf_parse_with_oracle(PgfConcr* concr, PgfCId cat,
+pgf_parse_with_oracle(PgfConcr* concr, PgfType* typ,
                       GuString sentence,
                       PgfOracleCallback* oracle,
                       GuExn* err,
@@ -2177,7 +2177,7 @@ pgf_parse_with_oracle(PgfConcr* concr, PgfCId cat,
 	// Begin parsing a sentence with the specified category
 	PgfCallbacksMap* callbacks = pgf_new_callbacks_map(concr, out_pool); 
 	PgfParsing* ps =
-		pgf_parsing_init(concr, cat, 0, sentence, -1, callbacks, oracle, err, pool, out_pool);
+		pgf_parsing_init(concr, typ->cid, 0, sentence, -1, callbacks, oracle, err, pool, out_pool);
 	if (ps == NULL) {
 		return NULL;
 	}
@@ -2223,7 +2223,7 @@ pgf_parser_completions_next(GuEnum* self, void* to, GuPool* pool)
 }
 
 GuEnum*
-pgf_complete(PgfConcr* concr, PgfCId cat, GuString sentence, 
+pgf_complete(PgfConcr* concr, PgfType* type, GuString sentence, 
              GuString prefix, GuExn *err, GuPool* pool)
 {
 	if (concr->sequences == NULL ||
@@ -2239,7 +2239,7 @@ pgf_complete(PgfConcr* concr, PgfCId cat, GuString sentence,
 	PgfCallbacksMap* callbacks =
 		pgf_new_callbacks_map(concr, pool);
 	PgfParsing* ps =
-		pgf_parsing_init(concr, cat, 0, sentence, -1.0, callbacks, NULL, err, pool, pool);
+		pgf_parsing_init(concr, type->cid, 0, sentence, -1.0, callbacks, NULL, err, pool, pool);
 	if (ps == NULL) {
 		return NULL;
 	}
diff --git a/src/runtime/c/pgf/parseval.c b/src/runtime/c/pgf/parseval.c
index cbea3d429..7ef41577d 100644
--- a/src/runtime/c/pgf/parseval.c
+++ b/src/runtime/c/pgf/parseval.c
@@ -129,7 +129,7 @@ static PgfLinFuncs pgf_metrics_lin_funcs2 = {
 };
 
 bool
-pgf_parseval(PgfConcr* concr, PgfExpr expr, PgfCId cat, 
+pgf_parseval(PgfConcr* concr, PgfExpr expr, PgfType* type, 
              double *precision, double *recall, double *exact)
 {
 	GuPool* pool = gu_new_pool();
@@ -174,7 +174,7 @@ pgf_parseval(PgfConcr* concr, PgfExpr expr, PgfCId cat,
 		gu_string_buf_freeze(sbuf, pool);
 
 	GuEnum* en_trees =
-		pgf_parse(concr, cat, sentence,
+		pgf_parse(concr, type, sentence,
 		          state.err, pool, pool);
 	PgfExprProb* ep = gu_next(en_trees, PgfExprProb*, pool);
 	if (ep == NULL) {
diff --git a/src/runtime/c/pgf/pgf.c b/src/runtime/c/pgf/pgf.c
index 370b9411b..fe9c1d140 100644
--- a/src/runtime/c/pgf/pgf.c
+++ b/src/runtime/c/pgf/pgf.c
@@ -86,24 +86,35 @@ pgf_iter_categories(PgfPGF* pgf, GuMapItor* itor, GuExn* err)
 	}
 }
 
-PgfCId
-pgf_start_cat(PgfPGF* pgf)
+PgfType*
+pgf_start_cat(PgfPGF* pgf, GuPool* pool)
 {
 	PgfFlag* flag =
 		gu_seq_binsearch(pgf->abstract.aflags, pgf_flag_order, PgfFlag, "startcat");
 
-	if (flag == NULL)
-		return "S";
-
-	GuVariantInfo i = gu_variant_open(flag->value);
-	switch (i.tag) {
-	case PGF_LITERAL_STR: {
-		PgfLiteralStr *lstr = (PgfLiteralStr *) i.data;
-		return lstr->val;
-	}
+	if (flag != NULL) {
+		GuVariantInfo i = gu_variant_open(flag->value);
+		switch (i.tag) {
+		case PGF_LITERAL_STR: {
+			PgfLiteralStr *lstr = (PgfLiteralStr *) i.data;
+			
+			GuPool* tmp_pool = gu_local_pool();
+			GuIn* in = gu_string_in(lstr->val,tmp_pool);
+			GuExn* err = gu_new_exn(tmp_pool);
+			PgfType *type = pgf_read_type(in, pool, err);
+			if (!gu_ok(err))
+				break;
+			gu_pool_free(tmp_pool);
+			return type;
+		}
+		}
 	}
 
-	return "S";
+	PgfType* type = gu_new_flex(pool, PgfType, exprs, 0);
+	type->hypos   = gu_empty_seq();
+	type->cid     = "S";
+	type->n_exprs = 0;
+	return type;
 }
 
 GuString
diff --git a/src/runtime/c/pgf/pgf.h b/src/runtime/c/pgf/pgf.h
index 365d20d73..e5679a5e6 100644
--- a/src/runtime/c/pgf/pgf.h
+++ b/src/runtime/c/pgf/pgf.h
@@ -53,8 +53,8 @@ pgf_language_code(PgfConcr* concr);
 void
 pgf_iter_categories(PgfPGF* pgf, GuMapItor* itor, GuExn* err);
 
-PgfCId
-pgf_start_cat(PgfPGF* pgf);
+PgfType*
+pgf_start_cat(PgfPGF* pgf, GuPool* pool);
 
 void
 pgf_iter_functions(PgfPGF* pgf, GuMapItor* itor, GuExn* err);
@@ -89,7 +89,7 @@ pgf_align_words(PgfConcr* concr, PgfExpr expr,
                 GuExn* err, GuPool* pool);
 
 bool
-pgf_parseval(PgfConcr* concr, PgfExpr expr, PgfCId cat, 
+pgf_parseval(PgfConcr* concr, PgfExpr expr, PgfType* type, 
              double *precision, double *recall, double *exact);
 
 PgfExpr
@@ -97,11 +97,11 @@ pgf_compute(PgfPGF* pgf, PgfExpr expr, GuExn* err,
             GuPool* pool, GuPool* out_pool);
 
 PgfExprEnum*
-pgf_generate_all(PgfPGF* pgf, PgfCId cat,
+pgf_generate_all(PgfPGF* pgf, PgfType* ty,
                  GuExn* err, GuPool* pool, GuPool* out_pool);
 
 PgfExprEnum*
-pgf_parse(PgfConcr* concr, PgfCId cat, GuString sentence,
+pgf_parse(PgfConcr* concr, PgfType* typ, GuString sentence,
           GuExn* err, GuPool* pool, GuPool* out_pool);
 
 typedef struct PgfMorphoCallback PgfMorphoCallback;
@@ -134,7 +134,7 @@ pgf_lookup_word_prefix(PgfConcr *concr, GuString prefix,
 typedef GuMap PgfCallbacksMap;
 
 PgfExprEnum*
-pgf_parse_with_heuristics(PgfConcr* concr, PgfCId cat, 
+pgf_parse_with_heuristics(PgfConcr* concr, PgfType* typ, 
                           GuString sentence, double heuristics,
                           PgfCallbacksMap* callbacks,
                           GuExn* err,
@@ -159,7 +159,7 @@ struct PgfOracleCallback {
 };
 
 PgfExprEnum*
-pgf_parse_with_oracle(PgfConcr* concr, PgfCId cat, 
+pgf_parse_with_oracle(PgfConcr* concr, PgfType* typ,
                       GuString sentence,
                       PgfOracleCallback* oracle,
                       GuExn* err,
@@ -172,7 +172,7 @@ typedef struct {
 } PgfTokenProb;
 
 GuEnum*
-pgf_complete(PgfConcr* concr, PgfCId cat, GuString string, 
+pgf_complete(PgfConcr* concr, PgfType* type, GuString string, 
              GuString prefix, GuExn* err, GuPool* pool);
 
 typedef struct PgfLiteralCallback PgfLiteralCallback;
diff --git a/src/runtime/c/pgf/reasoner.c b/src/runtime/c/pgf/reasoner.c
index 75f7ee0c6..5d604a4cc 100644
--- a/src/runtime/c/pgf/reasoner.c
+++ b/src/runtime/c/pgf/reasoner.c
@@ -454,7 +454,7 @@ pgf_new_reasoner(PgfPGF* pgf, GuExn* err, GuPool* pool, GuPool* out_pool)
 }
 
 PgfExprEnum*
-pgf_generate_all(PgfPGF* pgf, PgfCId cat, GuExn* err, GuPool* pool, GuPool* out_pool)
+pgf_generate_all(PgfPGF* pgf, PgfType* typ, GuExn* err, GuPool* pool, GuPool* out_pool)
 {
 	PgfReasoner* rs = pgf_new_reasoner(pgf, err, pool, out_pool);
 
@@ -462,9 +462,9 @@ pgf_generate_all(PgfPGF* pgf, PgfCId cat, GuExn* err, GuPool* pool, GuPool* out_
 	answers->parents = gu_new_buf(PgfExprState*, rs->pool);
 	answers->exprs   = rs->exprs;
 	answers->outside_prob = 0;
-	gu_map_put(rs->table, cat, PgfAnswers*, answers);
+	gu_map_put(rs->table, typ->cid, PgfAnswers*, answers);
 
-	PgfAbsCat* abscat = gu_seq_binsearch(rs->abstract->cats, pgf_abscat_order, PgfAbsCat, cat);
+	PgfAbsCat* abscat = gu_seq_binsearch(rs->abstract->cats, pgf_abscat_order, PgfAbsCat, typ->cid);
 	if (abscat != NULL) {
 		rs->start = gu_new(PgfClosure, rs->pool);
 		rs->start->code = abscat->predicate;