Commit e44c8427d7481ed15c36b9396a618bb108321c8a

Thomas de Grivel 2025-04-14T23:17:37

facts with transaction

diff --git a/README.md b/README.md
index 6026af9..0ab5506 100644
--- a/README.md
+++ b/README.md
@@ -77,6 +77,8 @@ There are now four full applications written in KC3 that we know of :
      - StructType
    - optional pass by copy (--copy) for use with ASAN.
      - `env_init_args --copy`
+   - documentation
+     - document all basic types (see <kc3-lang.org/doc>)
 
 
 ## Discord invite
diff --git a/lib/kc3/0.1/facts.kc3 b/lib/kc3/0.1/facts.kc3
index fe39036..d59a946 100644
--- a/lib/kc3/0.1/facts.kc3
+++ b/lib/kc3/0.1/facts.kc3
@@ -13,15 +13,17 @@ defmodule Facts do
              transaction: (Ptr) 0]
 
   # returns true if fact was added or is already present
-  def add_tags = cfn Bool "kc3_facts_add_tags" (Facts, Tag, Tag, Tag, Result)
+  def add_tags =
+    cfn Bool "kc3_facts_add_tags" (Facts, Tag, Tag, Tag, Result)
 
   def cast = cfn Tag "tag_init_cast_struct" (Result, Sym, Tag)
 
-  def collect_with = cfn Tag "kc3_facts_collect_with" (Facts, List,
-    Fn, Result)
+  def collect_with =
+    cfn Tag "kc3_facts_collect_with" (Facts, List, Fn, Result)
 
-  def collect_with_tags = cfn Tag "kc3_facts_collect_with_tags" (Facts,
-    Tag, Tag, Tag, Callable, Result)
+  def collect_with_tags =
+    cfn Tag "kc3_facts_collect_with_tags" (Facts, Tag, Tag, Tag,
+      Callable, Result)
 
   def database = cfn Ptr "facts_database" (Result)
 
@@ -30,31 +32,42 @@ defmodule Facts do
   # env_db() -> facts
   def env_db = cfn Ptr "kc3_env_db" (Result)
 
-  def first_with = cfn Tag "kc3_facts_first_with" (Facts, List, Callable, Result)
+  def first_with =
+    cfn Tag "kc3_facts_first_with" (Facts, List, Callable, Result)
 
   # first_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, Callable, Result)
+  def first_with_tags =
+    cfn Tag "kc3_facts_first_with_tags" (Facts, Tag, Tag, Tag, Callable,
+      Result)
 
-  def open = cfn Sw "facts_open_file" (Facts, Str)
+  def open =
+    cfn Sw "facts_open_file" (Facts, Str)
 
   # returns true if fact was removed or is already absent
-  def remove_tags = cfn Bool "kc3_facts_remove_tags" (Facts, Tag, Tag, Tag, Result)
+  def remove_tags =
+    cfn Bool "kc3_facts_remove_tags" (Facts, Tag, Tag, Tag, Result)
 
   # returns true if fact was added or is already present
-  def replace_tags = cfn Bool "kc3_facts_replace_tags" (Facts, Tag, Tag, Tag, Result)
+  def replace_tags =
+    cfn Bool "kc3_facts_replace_tags" (Facts, Tag, Tag, Tag, Result)
 
   # with(facts, [[?, ?, ?]], fn (fact) {result}) -> result
-  def with = cfn Tag "kc3_facts_with" (Facts, List, Callable, Result)
+  def with =
+    cfn Tag "kc3_facts_with" (Facts, List, Callable, Result)
 
   # with_macro(facts, [[?, ?, ?]], do result end) -> result
-  def with_macro = cfn_macro Tag "kc3_facts_with_macro" (Tag, Tag, Tag, Result)
+  def with_macro =
+    cfn_macro Tag "kc3_facts_with_macro" (Tag, Tag, Tag, Result)
 
   # with_tags(facts, subject, predicate, object,
   #           fn (fact) {result}) -> result
-  def with_tags = cfn Tag "kc3_facts_with_tags" (Facts, Tag, Tag, Tag,
-    Callable, Result)
+  def with_tags =
+    cfn Tag "kc3_facts_with_tags" (Facts, Tag, Tag, Tag, Callable,
+      Result)
+
+  def with_transaction =
+    cfn_macro Tag "kc3_facts_with_transaction" (Tag, Tag, Result)
 
   # with_tuple(facts, tuple, fn (fact) {result}) -> result
   def with_tuple = cfn Tag "kc3_facts_with_tuple" (Facts, Tuple, Callable,
diff --git a/libkc3/env.c b/libkc3/env.c
index 4ed080e..2888411 100644
--- a/libkc3/env.c
+++ b/libkc3/env.c
@@ -897,6 +897,39 @@ s_tag * env_facts_with_tags (s_env *env, s_facts *facts, s_tag *subject,
   return NULL;
 }
 
+s_tag * env_facts_with_transaction (s_env *env, s_tag *facts_arg,
+                                    s_tag *tag_arg, s_tag *dest)
+{
+  s_tag facts_tag = {0};
+  s_facts *facts;
+  s_tag tmp = {0};
+  s_facts_transaction transaction = {0};
+  if (! facts_transaction_init(&transaction))
+    return NULL;
+  if (! env_eval_tag(env, facts_arg, &facts_tag)) {
+    facts_transaction_clean(&transaction);
+    return NULL;
+  }
+  if (facts_tag.type != TAG_PTR) {
+    err_puts("env_with_transaction: first arg is not a Ptr to Facts");
+    tag_clean(&facts_tag);
+    facts_transaction_clean(&transaction);
+    return NULL;
+  }
+  facts = facts_tag.data.ptr.p;
+  facts_transaction_start(facts, &transaction);
+  if (! env_eval_tag(env, tag_arg, &tmp)) {
+    tag_clean(&facts_tag);
+    facts_transaction_clean(&transaction);
+    return NULL;
+  }
+  facts_transaction_end(facts, &transaction);
+  tag_clean(&facts_tag);
+  facts_transaction_clean(&transaction);
+  *dest = tmp;
+  return dest;
+}
+
 s_tag * env_frames_get (s_env *env, const s_sym *name)
 {
   s_tag *tag;
diff --git a/libkc3/env.h b/libkc3/env.h
index cfc8f75..e3c4bdb 100644
--- a/libkc3/env.h
+++ b/libkc3/env.h
@@ -93,6 +93,8 @@ s_tag *        env_facts_with_tags (s_env *env, s_facts *facts,
                                     s_tag *subject, s_tag *predicate,
                                     s_tag *object, s_callable *callback,
                                     s_tag *dest);
+s_tag *        env_facts_with_transaction (s_env *env, s_tag *facts_arg,
+                                           s_tag *tag_arg, s_tag *dest);
 s_tag *        env_ident_get (s_env *env, const s_ident *ident,
                               s_tag *dest);
 bool *         env_ident_is_special_operator (s_env *env,
diff --git a/libkc3/kc3.c b/libkc3/kc3.c
index 09564b3..b8da300 100644
--- a/libkc3/kc3.c
+++ b/libkc3/kc3.c
@@ -439,6 +439,13 @@ s_tag * kc3_facts_with_tags (s_facts *facts, s_tag *subject,
                              object, *callback, dest);
 }
 
+s_tag * kc3_facts_with_transaction (s_tag *facts_arg, s_tag *tag_arg,
+                                    s_tag *dest)
+{
+  return env_facts_with_transaction(env_global(), facts_arg, tag_arg,
+                                    dest);
+}
+
 s_tag * kc3_facts_with_tuple (s_facts *facts, s_tuple *tuple,
                               p_callable *callback, s_tag *dest)
 {
diff --git a/libkc3/kc3_main.h b/libkc3/kc3_main.h
index 3025937..a2ec55e 100644
--- a/libkc3/kc3_main.h
+++ b/libkc3/kc3_main.h
@@ -106,6 +106,8 @@ s_tag *      kc3_facts_with_macro (s_tag *facts_tag, s_tag *spec_tag,
 s_tag *      kc3_facts_with_tags (s_facts *facts, s_tag *subject,
                                   s_tag *predicate, s_tag *object,
                                   p_callable *callback, s_tag *dest);
+s_tag *      kc3_facts_with_transaction (s_tag *facts_arg,
+                                         s_tag *tag_arg, s_tag *dest);
 s_tag *      kc3_identity (s_tag *tag, s_tag *dest);
 s_tag *      kc3_integer_reduce (s_tag *tag, s_tag *dest);
 bool         kc3_killpg (sw process_group, const s_sym * const *signal);
diff --git a/libkc3/list_init.c b/libkc3/list_init.c
index d5949e8..95f9061 100644
--- a/libkc3/list_init.c
+++ b/libkc3/list_init.c
@@ -343,6 +343,17 @@ s_list * list_init_ptr_free (s_list *list, void *p, s_list *next)
   return list;
 }
 
+s_list * list_init_quote (s_list *list, s_tag *src, s_list *next)
+{
+  s_list tmp = {0};
+  assert(list);
+  list_init(&tmp, next);
+  if (! tag_init_quote(&tmp.tag, src))
+    return NULL;
+  *list = tmp;
+  return list;
+}
+
 s_list * list_init_quote_copy (s_list *list, s_quote *quote,
                                s_list *next)
 {
@@ -1042,6 +1053,19 @@ s_list * list_new_ptr_free (void *p, s_list *next)
   return list;
 }
 
+s_list * list_new_quote (s_tag *src, s_list *next)
+{
+  s_list *list;
+  list = list_new(next);
+  if (! list)
+    return NULL;
+  if (! tag_init_quote(&list->tag, src)) {
+    free(list);
+    return NULL;
+  }
+  return list;
+}
+
 s_list * list_new_quote_copy (s_quote *quote, s_list *next)
 {
   s_list *list;
diff --git a/libkc3/list_init.h b/libkc3/list_init.h
index 55827e7..b51ee58 100644
--- a/libkc3/list_init.h
+++ b/libkc3/list_init.h
@@ -62,6 +62,7 @@ s_list * list_init_pstruct_type_clean (s_list *list,
                                        s_list *next);
 s_list * list_init_ptr (s_list *list, void *p, s_list *next);
 s_list * list_init_ptr_free (s_list *list, void *p, s_list *next);
+s_list * list_init_quote (s_list *list, s_tag *src, s_list *next);
 s_list * list_init_quote_copy (s_list *list, s_quote *quote,
                                s_list *next);
 s_list * list_init_ratio_1 (s_list *list, const char *p, s_list *next);
@@ -146,6 +147,7 @@ s_list * list_new_pstruct_type_clean (const s_struct_type *st,
                                       const s_cfn *clean, s_list *next);
 s_list * list_new_ptr (void *p, s_list *next);
 s_list * list_new_ptr_free (void *p, s_list *next);
+s_list * list_new_quote (s_tag *src, s_list *next);
 s_list * list_new_quote_copy (s_quote *quote, s_list *next);
 s_list * list_new_ratio_1 (const char *p, s_list *next);
 s_list * list_new_ratio (s_list *next);
diff --git a/libkc3/tag_init.c b/libkc3/tag_init.c
index 3c7223a..2fcb83f 100644
--- a/libkc3/tag_init.c
+++ b/libkc3/tag_init.c
@@ -342,6 +342,17 @@ s_tag * tag_init_ptr_free (s_tag *tag, void *p)
   return tag;
 }
 
+s_tag * tag_init_quote (s_tag *tag, s_tag *src)
+{
+  s_tag tmp = {0};
+  assert(tag);
+  tmp.type = TAG_QUOTE;
+  if (! quote_init(&tmp.data.quote, src))
+    return NULL;
+  *tag = tmp;
+  return tag;
+}
+
 s_tag * tag_init_quote_copy (s_tag *tag, s_quote *quote)
 {
   s_tag tmp = {0};
@@ -1036,6 +1047,20 @@ s_tag * tag_new_ptr_free (void *p)
   return tag;
 }
 
+s_tag * tag_new_quote (s_tag *src)
+{
+  s_tag *tag;
+  tag = alloc(sizeof(s_tag));
+  if (! tag)
+    return NULL;
+  tag->type = TAG_QUOTE;
+  if (! quote_init(&tag->data.quote, src)) {
+    free(tag);
+    return NULL;
+  }
+  return tag;
+}
+
 s_tag * tag_new_quote_copy (s_quote *quote)
 {
   s_tag *tag;
@@ -1758,6 +1783,18 @@ s_tag * tag_ptr_free (s_tag *tag, void *p)
   return tag;
 }
 
+s_tag * tag_quote (s_tag *tag, s_tag *src)
+{
+  s_tag tmp = {0};
+  assert(tag);
+  tag_clean(tag);
+  tmp.type = TAG_QUOTE;
+  if (! quote_init(&tmp.data.quote, src))
+    return NULL;
+  *tag = tmp;
+  return tag;
+}
+
 s_tag * tag_quote_copy (s_tag *tag, s_quote *quote)
 {
   s_tag tmp = {0};
diff --git a/libkc3/tag_init.h b/libkc3/tag_init.h
index 80ac9cb..505e04b 100644
--- a/libkc3/tag_init.h
+++ b/libkc3/tag_init.h
@@ -51,6 +51,7 @@ s_tag * tag_init_pstruct_type_clean (s_tag *tag,
                                      const s_cfn *clean);
 s_tag * tag_init_ptr (s_tag *tag, void *p);
 s_tag * tag_init_ptr_free (s_tag *tag, void *p);
+s_tag * tag_init_quote (s_tag *tag, s_tag *src);
 s_tag * tag_init_quote_copy (s_tag *tag, s_quote *quote);
 s_tag * tag_init_ratio_1 (s_tag *tag, const char *p);
 s_tag * tag_init_ratio (s_tag *tag);
@@ -123,6 +124,7 @@ s_tag * tag_new_pstruct_type_clean (const s_struct_type *st,
                                     const s_cfn *clean);
 s_tag * tag_new_ptr (void *p);
 s_tag * tag_new_ptr_free (void *p);
+s_tag * tag_new_quote (s_tag *src);
 s_tag * tag_new_quote_copy (s_quote *quote);
 s_tag * tag_new_ratio_1 (const char *p);
 s_tag * tag_new_ratio (void);
@@ -192,6 +194,7 @@ s_tag * tag_pstruct_type_clean (s_tag *tag, const s_struct_type *st,
                                 const s_cfn *clean);
 s_tag * tag_ptr (s_tag *tag, void *p);
 s_tag * tag_ptr_free (s_tag *tag, void *p);
+s_tag * tag_quote (s_tag *tag, s_tag *src);
 s_tag * tag_quote_copy (s_tag *tag, s_quote *quote);
 s_tag * tag_ratio_1 (s_tag *tag, const char *p);
 s_tag * tag_ratio (s_tag *tag);
diff --git a/libkc3/tag_init.rb b/libkc3/tag_init.rb
index 31cf22b..960f22a 100644
--- a/libkc3/tag_init.rb
+++ b/libkc3/tag_init.rb
@@ -358,6 +358,8 @@ class TagInitList
                    [Arg.new("void *", "p")]),
        TagInit.new("ptr_free", "TAG_PTR_FREE", :init_mode_init,
                    [Arg.new("void *", "p")]),
+       TagInit.new("quote", "TAG_QUOTE", :init_mode_init,
+                   [Arg.new("s_tag *", "src")]),
        TagInit.new("quote", "copy", "TAG_QUOTE", :init_mode_init,
                    [Arg.new("s_quote *", "quote")]),
        TagInit1.new("ratio", "1", "TAG_RATIO", :init_mode_init),
diff --git a/test/ikc3/facts_with.kc3 b/test/ikc3/facts_with.kc3
index 76b7ac4..f9dd1ee 100644
--- a/test/ikc3/facts_with.kc3
+++ b/test/ikc3/facts_with.kc3
@@ -19,3 +19,8 @@ Facts.with(Facts.env_db(), [[op = ?, :op_sym, sym = ?]], fn (fact) {
   puts("#{inspect(sym)} #{inspect(op)}")
   2
 })
+def count = 0
+Facts.with_transaction(Facts.env_db(), do
+  def count = count + 1
+end)
+count
diff --git a/test/ikc3/facts_with.out.expected b/test/ikc3/facts_with.out.expected
index b23b311..ad26845 100644
--- a/test/ikc3/facts_with.out.expected
+++ b/test/ikc3/facts_with.out.expected
@@ -61,3 +61,6 @@ Facts.with(Facts.env_db(), [[op = ?, :op_sym, sym = ?]], fn (fact) { puts("#{ins
 :~ :op_3
 :← :op_27
 2
+count
+count
+1