Commit bb77d2b1c81bdfdfa28663fef21148db179811b7

Thomas de Grivel 2024-09-05T16:09:00

Facts.first_with_tags()

diff --git a/.ikc3_history b/.ikc3_history
index 4081fd6..8a99c18 100644
--- a/.ikc3_history
+++ b/.ikc3_history
@@ -1,6 +1,3 @@
-(Tag) (Ptr) 0xf24fc9ce000
-?
-Facts.with_tags(Facts.env_facts(), KC3, :operator, ?, fn (fact) { puts(fact.object); 1 })
 Facts.with(Facts.env_facts(), [[KC3, :operator, ?]], fn (fact) { puts(fact.object); 1 })
 Facts.with(Facts.env_facts(), quote [[KC3, :operator, op]], fn (fact) { puts(fact.object); 1 })
 op
@@ -97,3 +94,6 @@ b = ?
 a = ? ; void
 Facts.with_tags(Facts.env_facts(), KC3, :operator, ?, fn (fact) { puts(fact.object); 1 })
 EKC3.html_escape("plop <1>")
+Facts.first_with_tags(Facts.env_facts(), KC3, :operator, ?, fn (fact) { fact.object })
+first_operator = Facts.first_with_tags(Facts.env_facts(), KC3, :operator, ?, fn (fact) { fact.object })
+first_operator
diff --git a/lib/kc3/0.1/facts.kc3 b/lib/kc3/0.1/facts.kc3
index ab19de8..e40b360 100644
--- a/lib/kc3/0.1/facts.kc3
+++ b/lib/kc3/0.1/facts.kc3
@@ -17,6 +17,11 @@ defmodule Facts do
   # env_facts() -> facts
   def env_facts = cfn Ptr "kc3_env_facts" ()
 
+  # with_tags(facts, subject, predicate, object,
+  #           fn (fact) {result}) -> result
+  def first_with_tags = cfn Tag "kc3_facts_first_with_tags" (Facts, Tag,
+    Tag, Tag, Fn, Result)
+
   # with(facts, [[?, ?, ?]], fn (fact) {result}) -> result
   def with = cfn Tag "kc3_facts_with" (Facts, List, Fn,
     Result)
diff --git a/libkc3/env.c b/libkc3/env.c
index ca57dfa..ad6e653 100644
--- a/libkc3/env.c
+++ b/libkc3/env.c
@@ -2018,6 +2018,52 @@ s_fact_w * env_fact_w_eval (s_env *env, const s_fact_w *fact,
   return dest;
 }
 
+s_tag * env_facts_first_with_tags (s_env *env, s_facts *facts,
+                                   s_tag *subject, s_tag *predicate,
+                                   s_tag *object, s_fn *callback,
+                                   s_tag *dest)
+{
+  s_list *arguments;
+  s_facts_cursor cursor = {0};
+  const s_fact *fact = NULL;
+  s_fact_w *fact_w = NULL;
+  s_tag tmp = {0};
+  assert(env);
+  assert(facts);
+  assert(subject);
+  assert(predicate);
+  assert(object);
+  assert(callback);
+  assert(dest);
+  if (! (arguments = list_new_struct(&g_sym_FactW, NULL)))
+    return NULL;
+  if (! struct_allocate(&arguments->tag.data.struct_))
+    return NULL;
+  fact_w = arguments->tag.data.struct_.data;
+  if (! facts_with_tags(facts, &cursor, subject, predicate, object))
+    return NULL;
+  if (! facts_cursor_next(&cursor, &fact))
+    goto clean;
+  if (! fact)
+    goto ok;
+  if (! fact_w_init_fact(fact_w, fact))
+    goto clean;
+  if (! env_eval_call_fn_args(env, callback, arguments, &tmp)) {
+    goto clean;
+  }
+  fact_w_clean(fact_w);
+ ok:
+  list_delete_all(arguments);
+  *dest = tmp;
+  return dest;
+ clean:
+  facts_cursor_clean(&cursor);
+  tag_clean(&tmp);
+  fact_w_clean(fact_w);
+  list_delete_all(arguments);
+  return NULL;  
+}
+
 s_tag * env_facts_with (s_env *env, s_facts *facts, s_list **spec,
                         s_fn *callback, s_tag *dest)
 {
diff --git a/libkc3/env.h b/libkc3/env.h
index 1b12f42..cf3ca92 100644
--- a/libkc3/env.h
+++ b/libkc3/env.h
@@ -56,6 +56,11 @@ s_tag *       env_defoperator (s_env *env, const s_sym * const *name,
 const s_sym * env_defstruct (s_env *env, const s_list *spec);
 s_fact_w *    env_fact_w_eval (s_env *env, const s_fact_w *fact,
 			       s_fact_w *dest);
+s_tag *       env_facts_first_with_tags (s_env *env, s_facts *facts,
+                                         s_tag *subject,
+                                         s_tag *predicate,
+                                         s_tag *object,
+                                         s_fn *callback, s_tag *dest);
 s_tag *       env_facts_with (s_env *env, s_facts *facts, s_list **spec,
                               s_fn *callback, s_tag *dest);
 s_facts_with_cursor *
diff --git a/libkc3/facts.h b/libkc3/facts.h
index 567a559..0be502b 100644
--- a/libkc3/facts.h
+++ b/libkc3/facts.h
@@ -56,11 +56,11 @@ bool *         facts_remove_fact_tags (s_facts *facts,
 s_facts *      facts_remove_all (s_facts *facts);
 const s_fact * facts_replace_fact (s_facts *facts, const s_fact *fact);
 const s_fact * facts_replace_tags (s_facts *facts, const s_tag *subject,
-                              const s_tag *predicate,
-                              const s_tag *object);
+                                   const s_tag *predicate,
+                                   const s_tag *object);
 sw             facts_save_file (s_facts *facts, const char *path);
 s_facts_transaction * facts_transaction_clean
-(s_facts_transaction *transaction);
+                 (s_facts_transaction *transaction);
 s_facts *      facts_transaction_rollback
                  (s_facts *facts,
                   const s_facts_transaction *transaction);
diff --git a/libkc3/kc3.c b/libkc3/kc3.c
index c9b1714..fc59467 100644
--- a/libkc3/kc3.c
+++ b/libkc3/kc3.c
@@ -184,6 +184,14 @@ s_tag * kc3_fact_from_ptr (s_tag *tag, u_ptr_w *ptr)
   return tag_init_struct_with_data(tag, &g_sym_Fact, ptr->p, false);
 }
 
+s_tag * kc3_facts_first_with_tags (s_facts *facts, s_tag *subject,
+                                   s_tag *predicate, s_tag *object,
+                                   s_fn *callback, s_tag *dest)
+{
+  return env_facts_with_tags(&g_kc3_env, facts, subject, predicate,
+                             object, callback, dest);
+}
+
 uw * kc3_facts_next_id (uw *dest)
 {
   assert(dest);
diff --git a/libkc3/kc3_main.h b/libkc3/kc3_main.h
index 49d185e..b263025 100644
--- a/libkc3/kc3_main.h
+++ b/libkc3/kc3_main.h
@@ -34,6 +34,11 @@ s_tag *        kc3_fact_from_ptr (s_tag *tag, u_ptr_w *ptr);
 s_tag *        kc3_fact_object (s_fact *fact, s_tag *dest);
 s_tag *        kc3_fact_predicate (s_fact *fact, s_tag *dest);
 s_tag *        kc3_fact_subject (s_fact *fact, s_tag *dest);
+s_tag *        kc3_facts_first_with_tags (s_facts *facts,
+                                          s_tag *subject,
+                                          s_tag *predicate,
+                                          s_tag *object,
+                                          s_fn *callback, s_tag *dest);
 uw *           kc3_facts_next_id (uw *dest);
 s_str *        kc3_getenv (const s_str *name, s_str *dest);
 void           kc3_license (void);