Commit c9f9290756d26cacc6b6e57f87579d44c117ed7f

Thomas de Grivel 2023-03-16T18:34:06

wip cfn_apply

diff --git a/lib/c3/0.1/c3.facts b/lib/c3/0.1/c3.facts
index eb54f9c..c83eecc 100644
--- a/lib/c3/0.1/c3.facts
+++ b/lib/c3/0.1/c3.facts
@@ -9,19 +9,19 @@
 {C3, :symbol, C3.*}
 {C3, :symbol, C3./}
 {C3, :symbol, C3.first}
-{C3.+, :cfn, cfn :tag "tag_add" (:tag, :tag, :tag)}
+{C3.+, :cfn, cfn :tag "tag_add" (:tag, :tag, :&result)}
 {C3.+, :is_a, :operator}
 {C3.+, :operator_precedence, 1}
 {C3.+, :operator_associativity, :left}
-{C3.-, :cfn, cfn :tag "tag_sub" (:tag, :tag, :tag)}
+{C3.-, :cfn, cfn :tag "tag_sub" (:tag, :tag, :&result)}
 {C3.-, :is_a, :operator}
 {C3.-, :operator_precedence, 1}
 {C3.-, :operator_associativity, :left}
-{C3.*, :cfn, cfn :tag "tag_mul" (:tag, :tag, :tag)}
+{C3.*, :cfn, cfn :tag "tag_mul" (:tag, :tag, :&result)}
 {C3.*, :is_a, :operator}
 {C3.*, :operator_precedence, 2}
 {C3.*, :operator_associativity, :left}
-{C3./, :cfn, cfn :tag "tag_div" (:tag, :tag, :tag)}
+{C3./, :cfn, cfn :tag "tag_div" (:tag, :tag, :&result)}
 {C3./, :is_a, :operator}
 {C3./, :operator_precedence, 2}
 {C3./, :operator_associativity, :left}
@@ -31,4 +31,4 @@
  ({a, _b, _c}) { a }
  ({a, _b, _c, _d}) { a }
 }}
-%{hash: 0x6AA8D9E67CFF2BA6}
+%{hash: 0xE5824A30B59B37EB}
diff --git a/libc3/call.c b/libc3/call.c
index a67f10b..f47c006 100644
--- a/libc3/call.c
+++ b/libc3/call.c
@@ -58,7 +58,7 @@ s_call * call_init_op (s_call *call)
 {
   assert(call);
   bzero(call, sizeof(s_call));
-  call->arguments = list_new(list_new(list_new(NULL)));
+  call->arguments = list_new(list_new(NULL));
   return call;
 }
 
diff --git a/libc3/cfn.c b/libc3/cfn.c
index 2102b1d..c9c8f5b 100644
--- a/libc3/cfn.c
+++ b/libc3/cfn.c
@@ -22,7 +22,8 @@
 #include "sym.h"
 #include "tag.h"
 
-ffi_type * cfn_sym_to_ffi_type (const s_sym *sym);
+ffi_type * cfn_sym_to_ffi_type (const s_sym *sym,
+                                ffi_type *result_type);
 s_tag * cfn_tag_init (s_tag *tag, const s_sym *type);
 void * cfn_tag_to_ffi_value (s_tag *tag, const s_sym *type);
 
@@ -30,19 +31,24 @@ s_tag * cfn_apply (s_cfn *cfn, s_list *args, s_tag *dest)
 {
   s_list *a;
   void **arg_values = NULL;
+  u8 arity;
   s_list *cfn_arg_type;
   sw i = 0;
   sw num_args;
   void* result;
   s_tag tmp;
+  s_tag tmp2;
   assert(cfn);
   num_args = list_length(args);
-  if (cfn->arity != num_args) {
+  arity = cfn->arity - (cfn->arg_result ? 1 : 0);
+  if (arity != num_args) {
     warnx("cfn_apply: invalid number of arguments, expected %d, have %ld",
-          cfn->arity, num_args);
+          arity, num_args);
     return NULL;
   }
   cfn_tag_init(&tmp, cfn->result_type);
+  if (cfn->arg_result)
+    cfn_tag_init(&tmp2, cfn->result_type);
   /* make result point to tmp value */
   result = cfn_tag_to_ffi_value(&tmp, cfn->result_type);
   if (cfn->arity) {
@@ -52,9 +58,13 @@ s_tag * cfn_apply (s_cfn *cfn, s_list *args, s_tag *dest)
     a = args;
     while (a) {
       assert(cfn_arg_type->tag.type.type == TAG_SYM);
-      arg_values[i] = cfn_tag_to_ffi_value(&a->tag,
-                                           cfn_arg_type->tag.data.sym);
-      a = list_next(a);
+      if (cfn_arg_type->tag.data.sym == sym_1("&result"))
+        arg_values[i] = cfn_tag_to_ffi_value(&tmp2, cfn->result_type);
+      else {
+        arg_values[i] = cfn_tag_to_ffi_value(&a->tag,
+                                             cfn_arg_type->tag.data.sym);
+        a = list_next(a);
+      }
       cfn_arg_type = list_next(cfn_arg_type);
       i++;
     }
@@ -83,6 +93,7 @@ s_cfn * cfn_copy (const s_cfn *cfn, s_cfn *dest)
   assert(cfn);
   assert(dest);
   str_copy(&cfn->name, &dest->name);
+  dest->arg_result = cfn->arg_result;
   list_copy(cfn->arg_types, &dest->arg_types);
   dest->arity = cfn->arity;
   dest->result_type = cfn->result_type;
@@ -115,7 +126,8 @@ s_cfn * cfn_set_type (s_cfn *cfn, s_list *arg_type,
   u8 i = 0;
   ffi_type *result_ffi_type;
   assert(cfn);
-  result_ffi_type = cfn_sym_to_ffi_type(result_type);
+  if (! (result_ffi_type = cfn_sym_to_ffi_type(result_type, NULL)))
+    return NULL;
   if ((arity = list_length(arg_type))) {
     if (arity > 255) {
       assert(arity <= 255);
@@ -130,7 +142,12 @@ s_cfn * cfn_set_type (s_cfn *cfn, s_list *arg_type,
         assert(! "cfn_set_type: invalid type");
         errx(1, "cfn_set_type: invalid type");
       }
-      arg_ffi_type[i] = cfn_sym_to_ffi_type(a->tag.data.sym);
+      if (! (arg_ffi_type[i] = cfn_sym_to_ffi_type(a->tag.data.sym, result_ffi_type))) {
+        free(arg_ffi_type);
+        return NULL;
+      }
+      if (a->tag.data.sym == sym_1("&result"))
+        cfn->arg_result = true;
       i++;
       a = list_next(a);
     }
@@ -143,10 +160,15 @@ s_cfn * cfn_set_type (s_cfn *cfn, s_list *arg_type,
   return cfn;
 }
 
-ffi_type * cfn_sym_to_ffi_type (const s_sym *sym)
+ffi_type * cfn_sym_to_ffi_type (const s_sym *sym, ffi_type *result_type)
 {
   if (sym == sym_1("tag"))
     return &ffi_type_pointer;
+  if (sym == sym_1("&result")) {
+    if (! result_type)
+      warnx("invalid result type: &result");
+    return result_type;
+  }
   if (sym == sym_1("s8"))
     return &ffi_type_sint8;
   if (sym == sym_1("s16"))
diff --git a/libc3/types.h b/libc3/types.h
index 54efda1..b871f28 100644
--- a/libc3/types.h
+++ b/libc3/types.h
@@ -288,6 +288,7 @@ struct cfn {
   } ptr;
   u8 arity;
   const s_sym *result_type;
+  bool arg_result;
   s_list *arg_types;
   ffi_cif cif;
 };
diff --git a/test/Makefile b/test/Makefile
index 7eb2bce..94ca7a3 100644
--- a/test/Makefile
+++ b/test/Makefile
@@ -45,7 +45,7 @@ gcovr:
 	gcovr --gcov-executable ${GCOV} --html-details test.html
 
 gdb_test: debug
-	if [ -f libc3_test_debug.core ]; then gdb libc3_test_debug libc3_test_debug.core; else gdb libc3_test_debug; fi
+	if [ -f libc3_test_debug.core ]; then gdb .libs/libc3_test_debug libc3_test_debug.core; else gdb .libs/libc3_test_debug; fi
 
 ic3_test_cov:
 	IC3=${SRC_TOP}/ic3/ic3_cov time ./ic3_test