kc3-lang/kc3

diff --git a/libc3/env.c b/libc3/env.c
index 3d87197..7a5840c 100644
--- a/libc3/env.c
+++ b/libc3/env.c
@@ -33,6 +33,7 @@
 #include "facts_with_cursor.h"
 #include "file.h"
 #include "fn.h"
+#include "fn_clause.h"
 #include "frame.h"
 #include "ident.h"
 #include "io.h"
@@ -1318,6 +1319,75 @@ bool env_eval_struct (s_env *env, const s_struct *s, s_tag *dest)
   return false;
 }
 
+bool env_eval_fn (s_env *env, const s_fn *fn, s_tag *dest)
+{
+  uw i;
+  s_block     *src_block;
+  s_fn_clause *src_clause;
+  s_list      *src_pattern;
+  s_tag       *src_tag;
+  s_tag         tmp = {0};
+  s_block      *tmp_block;
+  s_fn_clause **tmp_clause;
+  s_fn         *tmp_fn;
+  s_list      **tmp_pattern;
+  s_tag        *tmp_tag;
+  assert(env);
+  assert(fn);
+  assert(dest);
+  (void) env;
+  tmp.type = TAG_FN;
+  tmp_fn = &tmp.data.fn;
+  src_clause = fn->clauses;
+  tmp_clause = &tmp_fn->clauses;
+  while (src_clause) {
+    *tmp_clause = fn_clause_new(NULL);
+    src_pattern = src_clause->pattern;
+    tmp_pattern = &(*tmp_clause)->pattern;
+    while (src_pattern) {
+      *tmp_pattern = list_new(NULL);
+      if (! env_eval_fn_tag(env, &src_pattern->tag,
+                            &(*tmp_pattern)->tag))
+        goto ko;
+      src_pattern = list_next(src_pattern);
+      tmp_pattern = &(*tmp_pattern)->next.data.list;
+    }
+    src_block = &src_clause->algo;
+    tmp_block = &(*tmp_clause)->algo;
+    if (! block_init(tmp_block, src_block->count))
+      goto ko;
+    tmp_block->short_form = src_block->short_form;
+    i = 0;
+    while (i < src_block->count) {
+      src_tag = src_block->tag + i;
+      tmp_tag = tmp_block->tag + i;
+      if (! env_eval_fn_tag(env, src_tag, tmp_tag))
+        goto ko;
+      i++;
+    }
+    src_clause = src_clause->next_clause;
+    tmp_clause = &(*tmp_clause)->next_clause;
+  }
+  tmp_fn->macro = fn->macro;
+  tmp_fn->special_operator = fn->special_operator;
+  *dest = tmp;
+  return true;
+ ko:
+  fn_clean(&tmp.data.fn);
+  return false;
+}
+
+bool env_eval_fn_tag (s_env *env, const s_tag *tag, s_tag *dest)
+{
+  assert(env);
+  assert(tag);
+  assert(dest);
+  (void) env;
+  if (! tag_init_copy(dest, tag))
+    return false;
+  return true;
+}
+
 bool env_eval_tag (s_env *env, const s_tag *tag, s_tag *dest)
 {
   assert(env);
@@ -1334,6 +1404,8 @@ bool env_eval_tag (s_env *env, const s_tag *tag, s_tag *dest)
     return env_eval_call(env, &tag->data.call, dest);
   case TAG_COMPLEX:
     return env_eval_complex(env, tag->data.complex, dest);
+  case TAG_FN:
+    return env_eval_fn(env, &tag->data.fn, dest);
   case TAG_IDENT:
     return env_eval_ident(env, &tag->data.ident, dest);
   case TAG_LIST:
@@ -1355,7 +1427,6 @@ bool env_eval_tag (s_env *env, const s_tag *tag, s_tag *dest)
   case TAG_F64:
   case TAG_F128:
   case TAG_FACT:
-  case TAG_FN:
   case TAG_INTEGER:
   case TAG_RATIO:
   case TAG_PTAG:
diff --git a/libc3/env.h b/libc3/env.h
index 51f3f5c..acdb0f8 100644
--- a/libc3/env.h
+++ b/libc3/env.h
@@ -71,6 +71,8 @@ bool          env_eval_equal_tuple (s_env *env, bool macro,
                                     const s_tuple *a, const s_tuple *b,
                                     s_tuple *dest);
 bool          env_eval_fn (s_env *env, const s_fn *fn, s_tag *dest);
+bool          env_eval_fn_tag (s_env *env, const s_tag *tag,
+                               s_tag *dest);
 bool          env_eval_fn_call (s_env *env, const s_fn *fn,
                                 const s_list *arguments, s_tag *dest);
 bool          env_eval_ident (s_env *env, const s_ident *ident,
diff --git a/libc3/list_init.c b/libc3/list_init.c
index fac1925..d4d9c91 100644
--- a/libc3/list_init.c
+++ b/libc3/list_init.c
@@ -129,6 +129,17 @@ s_list * list_init_f128 (s_list *list, f128 f, s_list *next)
   return list;
 }
 
+s_list * list_init_fn_copy (s_list *list, const s_fn *fn, s_list *next)
+{
+  s_list tmp;
+  assert(list);
+  list_init(&tmp, next);
+  if (! tag_init_fn_copy(&tmp.tag, fn))
+    return NULL;
+  *list = tmp;
+  return list;
+}
+
 s_list * list_init_ident (s_list *list, const s_ident *ident, 
                           s_list *next)
 {
@@ -655,6 +666,19 @@ s_list * list_new_f128 (f128 f, s_list *next)
   return list;
 }
 
+s_list * list_new_fn_copy (const s_fn *fn, s_list *next)
+{
+  s_list *list;
+  list = list_new(next);
+  if (! list)
+    return NULL;
+  if (! tag_init_fn_copy(&list->tag, fn)) {
+    free(list);
+    return NULL;
+  }
+  return list;
+}
+
 s_list * list_new_ident (const s_ident *ident, s_list *next)
 {
   s_list *list;
diff --git a/libc3/list_init.h b/libc3/list_init.h
index 8bc30e1..d12d3e7 100644
--- a/libc3/list_init.h
+++ b/libc3/list_init.h
@@ -18,6 +18,7 @@ s_list * list_init_complex (s_list *list, s_complex *c, s_list *next);
 s_list * list_init_f32 (s_list *list, f32 f, s_list *next);
 s_list * list_init_f64 (s_list *list, f64 f, s_list *next);
 s_list * list_init_f128 (s_list *list, f128 f, s_list *next);
+s_list * list_init_fn_copy (s_list *list, const s_fn *fn, s_list *next);
 s_list * list_init_ident (s_list *list, const s_ident *ident, 
                           s_list *next);
 s_list * list_init_ident_1 (s_list *list, const char *p, s_list *next);
@@ -83,6 +84,7 @@ s_list * list_new_complex (s_complex *c, s_list *next);
 s_list * list_new_f32 (f32 f, s_list *next);
 s_list * list_new_f64 (f64 f, s_list *next);
 s_list * list_new_f128 (f128 f, s_list *next);
+s_list * list_new_fn_copy (const s_fn *fn, s_list *next);
 s_list * list_new_ident (const s_ident *ident, s_list *next);
 s_list * list_new_ident_1 (const char *p, s_list *next);
 s_list * list_new_integer_1 (const char *p, s_list *next);
@@ -139,6 +141,7 @@ s_list * list_complex (s_list *list, s_complex *c);
 s_list * list_f32 (s_list *list, f32 f);
 s_list * list_f64 (s_list *list, f64 f);
 s_list * list_f128 (s_list *list, f128 f);
+s_list * list_fn_copy (s_list *list, const s_fn *fn);
 s_list * list_ident (s_list *list, const s_ident *ident);
 s_list * list_ident_1 (s_list *list, const char *p);
 s_list * list_integer_1 (s_list *list, const char *p);
diff --git a/libc3/tag_init.c b/libc3/tag_init.c
index 042e8b2..64cf500 100644
--- a/libc3/tag_init.c
+++ b/libc3/tag_init.c
@@ -122,6 +122,17 @@ s_tag * tag_init_f128 (s_tag *tag, f128 f)
   return tag;
 }
 
+s_tag * tag_init_fn_copy (s_tag *tag, const s_fn *fn)
+{
+  s_tag tmp = {0};
+  assert(tag);
+  tmp.type = TAG_FN;
+  if (! fn_init_copy(&tmp.data.fn, fn))
+    return NULL;
+  *tag = tmp;
+  return tag;
+}
+
 s_tag * tag_init_ident (s_tag *tag, const s_ident *ident)
 {
   s_tag tmp = {0};
@@ -623,6 +634,20 @@ s_tag * tag_new_f128 (f128 f)
   return tag;
 }
 
+s_tag * tag_new_fn_copy (const s_fn *fn)
+{
+  s_tag *tag;
+  tag = alloc(sizeof(s_tag));
+  if (! tag)
+    return NULL;
+  tag->type = TAG_FN;
+  if (! fn_init_copy(&tag->data.fn, fn)) {
+    free(tag);
+    return NULL;
+  }
+  return tag;
+}
+
 s_tag * tag_new_ident (const s_ident *ident)
 {
   s_tag *tag;
@@ -1199,6 +1224,18 @@ s_tag * tag_f128 (s_tag *tag, f128 f)
   return tag;
 }
 
+s_tag * tag_fn_copy (s_tag *tag, const s_fn *fn)
+{
+  s_tag tmp = {0};
+  assert(tag);
+  tag_clean(tag);
+  tmp.type = TAG_FN;
+  if (! fn_init_copy(&tmp.data.fn, fn))
+    return NULL;
+  *tag = tmp;
+  return tag;
+}
+
 s_tag * tag_ident (s_tag *tag, const s_ident *ident)
 {
   s_tag tmp = {0};
diff --git a/libc3/tag_init.h b/libc3/tag_init.h
index 39c2c05..873add5 100644
--- a/libc3/tag_init.h
+++ b/libc3/tag_init.h
@@ -16,6 +16,7 @@ s_tag * tag_init_complex (s_tag *tag, s_complex *c);
 s_tag * tag_init_f32 (s_tag *tag, f32 f);
 s_tag * tag_init_f64 (s_tag *tag, f64 f);
 s_tag * tag_init_f128 (s_tag *tag, f128 f);
+s_tag * tag_init_fn_copy (s_tag *tag, const s_fn *fn);
 s_tag * tag_init_ident (s_tag *tag, const s_ident *ident);
 s_tag * tag_init_ident_1 (s_tag *tag, const char *p);
 s_tag * tag_init_integer_1 (s_tag *tag, const char *p);
@@ -68,6 +69,7 @@ s_tag * tag_new_complex (s_complex *c);
 s_tag * tag_new_f32 (f32 f);
 s_tag * tag_new_f64 (f64 f);
 s_tag * tag_new_f128 (f128 f);
+s_tag * tag_new_fn_copy (const s_fn *fn);
 s_tag * tag_new_ident (const s_ident *ident);
 s_tag * tag_new_ident_1 (const char *p);
 s_tag * tag_new_integer_1 (const char *p);
@@ -120,6 +122,7 @@ s_tag * tag_complex (s_tag *tag, s_complex *c);
 s_tag * tag_f32 (s_tag *tag, f32 f);
 s_tag * tag_f64 (s_tag *tag, f64 f);
 s_tag * tag_f128 (s_tag *tag, f128 f);
+s_tag * tag_fn_copy (s_tag *tag, const s_fn *fn);
 s_tag * tag_ident (s_tag *tag, const s_ident *ident);
 s_tag * tag_ident_1 (s_tag *tag, const char *p);
 s_tag * tag_integer_1 (s_tag *tag, const char *p);
diff --git a/libc3/tag_init.rb b/libc3/tag_init.rb
index 17c398f..6ab6d11 100644
--- a/libc3/tag_init.rb
+++ b/libc3/tag_init.rb
@@ -321,6 +321,8 @@ class TagInitList
                    [Arg.new("f64", "f")]),
        TagInit.new("f128", "TAG_F128", :init_mode_direct,
                    [Arg.new("f128", "f")]),
+       TagInit.new("fn", "copy", "TAG_FN", :init_mode_init,
+                   [Arg.new("const s_fn *", "fn")]),
        TagInit.new("ident", "TAG_IDENT", :init_mode_direct,
                    [Arg.new("const s_ident *", "ident")]),
        TagInit1.new("ident", "1", "TAG_IDENT", :init_mode_init),