kc3-lang/kc3

diff --git a/libc3/buf_inspect.c b/libc3/buf_inspect.c
index e6a3a4c..18cc6b6 100644
--- a/libc3/buf_inspect.c
+++ b/libc3/buf_inspect.c
@@ -230,15 +230,28 @@ sw buf_inspect_fn (s_buf *buf, const s_fn *fn)
   if ((r = buf_write_1(buf, "fn ")) < 0)
     return r;
   result += r;
-  if ((r = buf_inspect_fn_pattern(buf, fn->pattern)) < 0)
-    return r;
-  result += r;
-  if ((r = buf_write_u8(buf, ' ')) < 0)
-    return r;
-  result += r;
-  if ((r = buf_inspect_fn_algo(buf, fn->algo)) < 0)
-    return r;
-  result += r;
+  if (fn->next_clause) {
+    if ((r = buf_write_1(buf, "{\n")) < 0)
+      return r;
+    result += r;
+    while (fn) {
+      if ((r = buf_inspect_fn_clause(buf, fn)) < 0)
+        return r;
+      result += r;
+      if ((r = buf_write_1(buf, "\n  ")) < 0)
+        return r;
+      result += r;
+      fn = fn->next_clause;
+    }
+    if ((r = buf_write_1(buf, "}\n")) < 0)
+      return r;
+    result += r;
+  }
+  else {
+    if ((r = buf_inspect_fn_clause(buf, fn)) < 0)
+      return r;
+    result += r;
+  }
   return result;
 }
 
@@ -285,6 +298,24 @@ sw buf_inspect_fn_algo (s_buf *buf, const s_list *algo)
   return result;
 }
 
+sw buf_inspect_fn_clause (s_buf *buf, const s_fn *fn)
+{
+  sw r;
+  sw result = 0;
+  assert(buf);
+  assert(fn);
+  if ((r = buf_inspect_fn_pattern(buf, fn->pattern)) < 0)
+    return r;
+  result += r;
+  if ((r = buf_write_u8(buf, ' ')) < 0)
+    return r;
+  result += r;
+  if ((r = buf_inspect_fn_algo(buf, fn->algo)) < 0)
+    return r;
+  result += r;
+  return result;
+}
+
 sw buf_inspect_fn_pattern (s_buf *buf, const s_list *pattern)
 {
   sw r;
@@ -884,7 +915,7 @@ sw buf_inspect_tag (s_buf *buf, const s_tag *tag)
     return buf_inspect_character(buf, tag->data.character);
   case TAG_F32:     return buf_inspect_f32(buf, tag->data.f32);
   case TAG_F64:     return buf_inspect_f64(buf, tag->data.f64);
-  case TAG_FN:      return buf_inspect_fn(buf, &tag->data.fn);
+  case TAG_FN:      return buf_inspect_fn(buf, tag->data.fn);
   case TAG_IDENT:   return buf_inspect_ident(buf, &tag->data.ident);
   case TAG_INTEGER: return buf_inspect_integer(buf, &tag->data.integer);
   case TAG_LIST:    return buf_inspect_list(buf, tag->data.list);
diff --git a/libc3/buf_inspect.h b/libc3/buf_inspect.h
index 1fb8d05..0d250fd 100644
--- a/libc3/buf_inspect.h
+++ b/libc3/buf_inspect.h
@@ -44,6 +44,7 @@ sw buf_inspect_fact_size (const s_fact *fact);
 sw buf_inspect_fact_spec (s_buf *buf, p_facts_spec spec);
 sw buf_inspect_fn (s_buf *buf, const s_fn *fn);
 sw buf_inspect_fn_algo (s_buf *buf, const s_list *algo);
+sw buf_inspect_fn_clause (s_buf *buf, const s_fn *fn);
 sw buf_inspect_fn_pattern (s_buf *buf, const s_list *pattern);
 sw buf_inspect_fn_size (const s_fn *fn);
 sw buf_inspect_ident (s_buf *buf, const s_ident *ident);
diff --git a/libc3/buf_parse.c b/libc3/buf_parse.c
index 7125678..67388a0 100644
--- a/libc3/buf_parse.c
+++ b/libc3/buf_parse.c
@@ -422,12 +422,13 @@ sw buf_parse_fact (s_buf *buf, s_fact_w *dest)
   return r;
 }
 
-sw buf_parse_fn (s_buf *buf, s_fn *dest)
+sw buf_parse_fn (s_buf *buf, s_fn **dest)
 {
   sw r;
   sw result = 0;
   s_buf_save save;
-  s_fn tmp;
+  s_fn *tmp = NULL;
+  s_fn **tail = &tmp;
   assert(buf);
   assert(dest);
   buf_save_init(buf, &save);
@@ -437,7 +438,54 @@ sw buf_parse_fn (s_buf *buf, s_fn *dest)
   if ((r = buf_ignore_spaces(buf)) <= 0)
     goto restore;
   result += r;
-  fn_init(&tmp);
+  if ((r = buf_read_1(buf, "{")) < 0)
+    goto restore;
+  if (r > 0) {
+    result += r;
+    while (1) {
+      *tail = fn_new(NULL);
+      if ((r = buf_parse_fn_clause(buf, *tail)) <= 0)
+        goto restore;
+      tail = &(*tail)->next_clause;
+      if ((r = buf_ignore_spaces(buf)) < 0)
+        goto restore;
+      result += r;
+      if ((r = buf_read_1(buf, "}")) < 0)
+        goto restore;
+      if (r > 0) {
+        result += r;
+        goto ok;
+      }
+    }
+  }
+  else {
+    tmp = fn_new(NULL);
+    if ((r = buf_parse_fn_clause(buf, tmp)) <= 0)
+      goto restore;
+    result += r;
+  }
+ ok:
+  *dest = tmp;
+  r = result;
+  goto clean;
+ restore:
+  fn_delete_all(tmp);
+  buf_save_restore_rpos(buf, &save);
+ clean:
+  buf_save_clean(buf, &save);
+  return r;
+}
+
+sw buf_parse_fn_clause (s_buf *buf, s_fn *dest)
+{
+  sw r;
+  sw result = 0;
+  s_buf_save save;
+  s_fn tmp;
+  assert(buf);
+  assert(dest);
+  buf_save_init(buf, &save);
+  bzero(&tmp, sizeof(s_fn));
   if ((r = buf_parse_fn_pattern(buf, &tmp.pattern)) <= 0) {
     warnx("buf_parse_fn: invalid pattern");
     goto restore;
diff --git a/libc3/buf_parse.h b/libc3/buf_parse.h
index 35288ba..f6114d2 100644
--- a/libc3/buf_parse.h
+++ b/libc3/buf_parse.h
@@ -40,7 +40,8 @@ sw buf_parse_digit_dec (s_buf *buf, u8 *dest);
 sw buf_parse_f32 (s_buf *buf, f32 *dest);
 sw buf_parse_f64 (s_buf *buf, f64 *dest);
 sw buf_parse_fact (s_buf *buf, s_fact_w *dest);
-sw buf_parse_fn (s_buf *buf, s_fn *dest);
+sw buf_parse_fn (s_buf *buf, s_fn **dest);
+sw buf_parse_fn_clause (s_buf *buf, s_fn *dest);
 sw buf_parse_fn_algo (s_buf *buf, s_list **dest);
 sw buf_parse_fn_pattern (s_buf *buf, s_list **dest);
 sw buf_parse_call (s_buf *buf, s_call *dest);
diff --git a/libc3/env.c b/libc3/env.c
index ea132dd..0d57e8b 100644
--- a/libc3/env.c
+++ b/libc3/env.c
@@ -114,7 +114,7 @@ bool env_eval_call (s_env *env, const s_call *call, s_tag *dest)
     errx(1, "%s.%s is not a function",
          c.ident.module_name->str.ptr.ps8,
          c.ident.sym->str.ptr.ps8);
-  c.fn = &tag_var_fn.data.fn;
+  c.fn = tag_var_fn.data.fn;
   facts_with_cursor_clean(&cursor);
   facts_with(&env->facts, &cursor, (t_facts_spec) {
       &tag_ident, &tag_is_a, &tag_macro, NULL, NULL });
diff --git a/libc3/fn.c b/libc3/fn.c
index 0eb799c..b23dfd4 100644
--- a/libc3/fn.c
+++ b/libc3/fn.c
@@ -12,6 +12,8 @@
  * THIS SOFTWARE.
  */
 #include <assert.h>
+#include <err.h>
+#include <stdlib.h>
 #include <strings.h>
 #include "arg.h"
 #include "binding.h"
@@ -25,17 +27,51 @@ void fn_clean (s_fn *fn)
   list_delete_all(fn->algo);
 }
 
-s_fn * fn_copy (const s_fn *src, s_fn *dest)
+s_fn * fn_copy (const s_fn *src, s_fn **dest)
 {
-  dest->arity = src->arity;
-  list_copy(src->pattern, &dest->pattern);
-  list_copy(src->algo, &dest->algo);
-  return dest;
+  s_fn *tmp = NULL;
+  s_fn **tail = &tmp;
+  while (src) {
+    *tail = fn_new(NULL);
+    (*tail)->arity = src->arity;
+    list_copy(src->pattern, &(*tail)->pattern);
+    list_copy(src->algo, &(*tail)->algo);
+    src = src->next_clause;
+    tail = &(*tail)->next_clause;
+  }
+  *dest = tmp;
+  return tmp;
 }
 
-s_fn * fn_init (s_fn *fn)
+s_fn * fn_delete (s_fn *fn)
+{
+  s_fn *next_clause;
+  assert(fn);
+  next_clause = fn->next_clause;
+  fn_clean(fn);
+  free(fn);
+  return next_clause;
+}
+
+void fn_delete_all (s_fn *fn)
+{
+  while (fn)
+    fn = fn_delete(fn);
+}
+
+s_fn * fn_init (s_fn *fn, s_fn *next_clause)
 {
   assert(fn);
   bzero(fn, sizeof(s_fn));
+  fn->next_clause = next_clause;
+  return fn;
+}
+
+s_fn * fn_new (s_fn *next_clause)
+{
+  s_fn *fn;
+  if (! (fn = malloc(sizeof(s_fn))))
+    err(1, "out of memory");
+  fn_init(fn, next_clause);
   return fn;
 }
diff --git a/libc3/fn.h b/libc3/fn.h
index 9a7644a..c72f33b 100644
--- a/libc3/fn.h
+++ b/libc3/fn.h
@@ -24,9 +24,16 @@
 
 /* stack-allocation compatible functions */
 void   fn_clean (s_fn *fn);
-s_fn * fn_init (s_fn *fn);
+s_fn * fn_init (s_fn *fn, s_fn *next_clause);
+
+/* constructors */
+s_fn * fn_new (s_fn *next_clause);
+
+/* destructors */
+s_fn * fn_delete (s_fn *fn);
+void   fn_delete_all (s_fn *fn);
 
 /* modifiers */
-s_fn * fn_copy (const s_fn *src, s_fn *dest);
+s_fn * fn_copy (const s_fn *src, s_fn **dest);
 
 #endif /* FN_H */
diff --git a/libc3/hash.c b/libc3/hash.c
index 99a1cde..029bd93 100644
--- a/libc3/hash.c
+++ b/libc3/hash.c
@@ -98,8 +98,11 @@ void hash_update_fn (t_hash *hash, const s_fn *fn)
 {
   const s8 type[] = "fn";
   hash_update(hash, type, sizeof(type));
-  hash_update_list(hash, fn->pattern);
-  hash_update_list(hash, fn->algo);
+  while (fn) {
+    hash_update_list(hash, fn->pattern);
+    hash_update_list(hash, fn->algo);
+    fn = fn->next_clause;
+  }
 }
 
 void hash_update_ident (t_hash *hash, const s_ident *ident)
@@ -199,7 +202,7 @@ void hash_update_tag (t_hash *hash, const s_tag *tag)
     hash_update_character(hash, tag->data.character);          break;
   case TAG_F32: hash_update_f32(hash, tag->data.f32);          break;
   case TAG_F64: hash_update_f64(hash, tag->data.f64);          break;
-  case TAG_FN: hash_update_fn(hash, &tag->data.fn);            break;
+  case TAG_FN: hash_update_fn(hash, tag->data.fn);             break;
   case TAG_IDENT: hash_update_ident(hash, &tag->data.ident);   break;
   case TAG_INTEGER:
     hash_update_integer(hash, &tag->data.integer);             break;
diff --git a/libc3/tag.c b/libc3/tag.c
index 48068be..812e5e6 100644
--- a/libc3/tag.c
+++ b/libc3/tag.c
@@ -121,7 +121,7 @@ void tag_clean (s_tag *tag)
   case TAG_CALL:
   case TAG_CALL_FN:
   case TAG_CALL_MACRO: call_clean(&tag->data.call);       break;
-  case TAG_FN:         fn_clean(&tag->data.fn);           break;
+  case TAG_FN:         fn_delete_all(tag->data.fn);       break;
   case TAG_INTEGER:    integer_clean(&tag->data.integer); break;
   case TAG_LIST:       list_delete_all(tag->data.list);   break;
   case TAG_QUOTE:      quote_clean(&tag->data.quote);     break;
@@ -163,7 +163,7 @@ s_tag * tag_copy (const s_tag *src, s_tag *dest)
     call_copy(&src->data.call, &dest->data.call);
     break;
   case TAG_FN:
-    fn_copy(&src->data.fn, &dest->data.fn);
+    fn_copy(src->data.fn, &dest->data.fn);
     break;
   case TAG_INTEGER:
     integer_init(&dest->data.integer);
diff --git a/libc3/types.h b/libc3/types.h
index 6bb74eb..279a8dd 100644
--- a/libc3/types.h
+++ b/libc3/types.h
@@ -159,6 +159,7 @@ struct fn {
   uw arity;
   s_list *pattern;
   s_list *algo;
+  s_fn *next_clause;
 };
 
 struct module {
@@ -285,7 +286,7 @@ union tag_data {
   character    character;
   f32          f32;
   f64          f64;
-  s_fn         fn;
+  s_fn        *fn;
   s_ident      ident;
   s_integer    integer;
   s_list      *list;
diff --git a/test/buf_parse_test.c b/test/buf_parse_test.c
index 77711a7..16a7077 100644
--- a/test/buf_parse_test.c
+++ b/test/buf_parse_test.c
@@ -155,11 +155,12 @@
 #define BUF_PARSE_TEST_FN(test)                                        \
   do {                                                                 \
     s_buf buf;                                                         \
-    s_fn dest;                                                         \
+    s_fn *dest = NULL;                                                 \
     test_context("buf_parse_fn(" # test ")");                          \
     buf_init_1(&buf, (test));                                          \
     TEST_EQ(buf_parse_fn(&buf, &dest), strlen(test));                  \
-    fn_clean(&dest);                                                 \
+    TEST_ASSERT(dest);                                                 \
+    fn_delete_all(dest);                                               \
     buf_clean(&buf);                                                   \
     test_context(NULL);                                                \
   } while (0)
diff --git a/test/ic3/fn.in b/test/ic3/fn.in
index 1b9807a..df3ef2d 100644
--- a/test/ic3/fn.in
+++ b/test/ic3/fn.in
@@ -1,6 +1,16 @@
 quote fn (x) { x }
 quote fn (x, _y) { x }
 quote fn ([x | _y]) { x }
+quote fn {
+  ([]) { :error }
+  ([x | _y]) { x }
+  (_) { :error }
+}
 fn (x) { x }
 fn (x, _y) { x }
 fn ([x | _y]) { x }
+fn {
+  ([]) { :error }
+  ([x | _y]) { x }
+  (_) { :error }
+}