Expand module-sensitive meta-predicate arg

trealla-prolog · Aug 7, 2023 · ee68e07 · ee68e07
1 parent f8cbbc6
commit ee68e07
Show file tree

Hide file tree

Showing 3 changed files with 12 additions and 4 deletions.
diff --git a/src/prolog.c b/src/prolog.c
@@ -27,7 +27,8 @@ pl_idx g_dcg_s, g_throw_s, g_sys_block_catcher_s, g_sys_drop_barrier_s;
 pl_idx g_sys_soft_prune_s, g_if_then_s, g_soft_cut_s, g_negation_s;
 pl_idx g_error_s, g_slash_s, g_sys_cleanup_if_det_s, g_sys_table_s;
 pl_idx g_goal_expansion_s, g_term_expansion_s, g_tm_s, g_float_s;
-pl_idx g_sys_cut_if_det_s, g_as_s, g_colon_s, g_sys_prune_s, g_syscall_s;
+pl_idx g_sys_cut_if_det_s, g_as_s, g_colon_s, g_sys_prune_s;
+pl_idx g_caret_s, g_syscall_s;
 
 unsigned g_cpu_count = 4;
 char *g_tpl_lib = NULL;
@@ -443,6 +444,7 @@ static bool g_init(prolog *pl)
 	CHECK_SENTINEL(g_sys_table_s = index_from_pool(pl, "$table"), ERR_IDX);
 	CHECK_SENTINEL(g_as_s = index_from_pool(pl, "as"), ERR_IDX);
 	CHECK_SENTINEL(g_colon_s = index_from_pool(pl, ":"), ERR_IDX);
+	CHECK_SENTINEL(g_caret_s = index_from_pool(pl, "^"), ERR_IDX);
 
 	return error;
 }

diff --git a/src/prolog.h b/src/prolog.h
@@ -23,7 +23,8 @@ extern pl_idx g_dcg_s, g_throw_s, g_sys_block_catcher_s, g_sys_drop_barrier_s;
 extern pl_idx g_sys_soft_prune_s, g_if_then_s, g_soft_cut_s, g_negation_s;
 extern pl_idx g_error_s, g_slash_s, g_sys_cleanup_if_det_s, g_sys_table_s;
 extern pl_idx g_goal_expansion_s, g_term_expansion_s, g_tm_s, g_float_s;
-extern pl_idx g_sys_cut_if_det_s, g_as_s, g_colon_s, g_sys_prune_s, g_syscall_s;
+extern pl_idx g_sys_cut_if_det_s, g_as_s, g_colon_s, g_sys_prune_s;
+extern pl_idx g_caret_s, g_syscall_s;
 
 extern void convert_path(char *filename);
 

diff --git a/src/query.c b/src/query.c
@@ -386,9 +386,14 @@ static bool expand_meta_predicate(query *q, predicate *pr)
 	// Expand module-sensitive args...
 
 	for (cell *k = q->st.key+1, *m = pr->meta_args+1; arity--; k += k->nbr_cells, m += m->nbr_cells) {
-		if ((k->arity == 2) && (k->val_off == g_colon_s))
+		if ((k->arity == 2) && (k->val_off == g_colon_s) && is_atom(FIRST_ARG(k)))
 			;
-		else if (m->val_off == g_colon_s) {
+		else if (!is_interned(k))
+			;
+		else if ((m->val_off == g_colon_s)
+			//|| (m->val_off == g_caret_s)
+			//|| (is_smallint(m) && (get_smallint(m) >= 0) && (get_smallint(m) <= 9))
+			) {
 			make_struct(tmp, g_colon_s, NULL, 2, 1+k->nbr_cells);
 			SET_OP(tmp, OP_XFY); tmp++;
 			make_atom(tmp++, index_from_pool(q->pl, pr->m->name));