Commit af4570a6326c60038489e8a36e52a2fc25756421

Thomas de Grivel 2023-02-11T16:20:23

bool eval

diff --git a/libc3/env.c b/libc3/env.c
index 493778d..7913a1e 100644
--- a/libc3/env.c
+++ b/libc3/env.c
@@ -71,11 +71,11 @@ void env_error_tag (s_env *env, const s_tag *tag)
   }
 }
 
-s_tag * env_eval_call (s_env *env, const s_call *call, s_tag *dest)
+bool env_eval_call (s_env *env, const s_call *call, s_tag *dest)
 {
   s_call c;
   s_facts_with_cursor cursor;
-  s_tag *result;
+  bool result;
   s_tag tag_fn;
   s_tag tag_ident;
   s_tag tag_is_a;
@@ -88,7 +88,7 @@ s_tag * env_eval_call (s_env *env, const s_call *call, s_tag *dest)
   assert(env);
   assert(call);
   assert(dest);
-  call_copy(call, &c);
+  c = *call;
   ident_resolve_module(&c.ident, env);
   tag_init_1(    &tag_fn,       ":fn");
   tag_init_ident(&tag_ident, &c.ident);
@@ -101,8 +101,8 @@ s_tag * env_eval_call (s_env *env, const s_call *call, s_tag *dest)
   tag_init_var(  &tag_var_fn);
   facts_with(&env->facts, &cursor, (t_facts_spec) {
       &tag_module_name,
-      &tag_is_a, &tag_module,       /* module exists */
-      &tag_symbol, &tag_ident, NULL,   /* module exports symbol */
+      &tag_is_a, &tag_module,           /* module exists */
+      &tag_symbol, &tag_ident, NULL,    /* module exports symbol */
       &tag_ident, &tag_fn, &tag_var_fn,
       NULL, NULL });
   if (! facts_with_cursor_next(&cursor))
@@ -125,26 +125,30 @@ s_tag * env_eval_call (s_env *env, const s_call *call, s_tag *dest)
   return result;
 }
 
-s_list * env_eval_call_arguments (s_env *env, s_list *args)
+bool env_eval_call_arguments (s_env *env, s_list *args, s_list **dest)
 {
-  s_list **dest;
-  s_list *result;
-  dest = &result;
+  s_list **t;
+  s_list *tmp;
+  t = &tmp;
   while (args) {
-    *dest = list_new();
-    env_eval_tag(env, &args->tag, &(*dest)->tag);
-    tag_init_list(&(*dest)->next, NULL);
-    dest = &(*dest)->next.data.list;
+    *t = list_new();
+    if (! env_eval_tag(env, &args->tag, &(*t)->tag)) {
+      list_delete_all(tmp);
+      return false;
+    }
+    t = &(*t)->next.data.list;
     args = list_next(args);
   }
-  return result;
+  *dest = tmp;
+  return true;
 }
 
-s_tag * env_eval_call_fn (s_env *env, const s_call *call, s_tag *dest)
+bool env_eval_call_fn (s_env *env, const s_call *call, s_tag *dest)
 {
   s_list *args = NULL;
   s_frame frame;
   s_fn *fn;
+  s_tag tag;
   s_list *tmp = NULL;
   assert(env);
   assert(call);
@@ -154,29 +158,30 @@ s_tag * env_eval_call_fn (s_env *env, const s_call *call, s_tag *dest)
   frame_init(&frame, env->frame);
   env->frame = &frame;
   if (call->arguments) {
-    if (! (args = env_eval_call_arguments(env, call->arguments))) {
+    if (! env_eval_call_arguments(env, call->arguments, &args)) {
       env->frame = frame_clean(&frame);
-      return NULL;
+      return false;
     }
     if (! env_eval_equal_list(env, fn->pattern, args, &tmp)) {
       list_delete_all(args);
       env->frame = frame_clean(&frame);
-      return NULL;
+      return false;
     }
   }
-  if (! env_eval_progn(env, fn->algo, dest)) {
+  if (! env_eval_progn(env, fn->algo, &tag)) {
     list_delete_all(args);
     list_delete_all(tmp);
     env->frame = frame_clean(&frame);
-    return NULL;
+    return false;
   }
+  *dest = tag;
   list_delete_all(args);
   list_delete_all(tmp);
   env->frame = frame_clean(&frame);
-  return dest;
+  return true;
 }
 
-s_tag * env_eval_call_macro (s_env *env, const s_call *call, s_tag *dest)
+bool env_eval_call_macro (s_env *env, const s_call *call, s_tag *dest)
 {
   s_tag *expanded;
   assert(env);
@@ -185,7 +190,8 @@ s_tag * env_eval_call_macro (s_env *env, const s_call *call, s_tag *dest)
   (void) env;
   (void) call;
   (void) expanded;
-  return dest;
+  (void) dest;
+  return false;
 }
 
 bool env_eval_equal_list (s_env *env, const s_list *a, const s_list *b,
@@ -312,7 +318,7 @@ bool env_eval_equal_tuple (s_env *env, const s_tuple *a,
   return true;
 }
 
-s_tag * env_eval_ident (s_env *env, const s_ident *ident, s_tag *dest)
+bool env_eval_ident (s_env *env, const s_ident *ident, s_tag *dest)
 {
   const s_tag *tag;
   assert(env);
@@ -321,10 +327,11 @@ s_tag * env_eval_ident (s_env *env, const s_ident *ident, s_tag *dest)
     assert(! "env_eval_ident: unbound variable");
     errx(1, "env_eval_ident: unbound variable");
   }
-  return tag_copy(tag, dest);
+  tag_copy(tag, dest);
+  return true;
 }
 
-s_tag * env_eval_progn (s_env *env, const s_list *program, s_tag *dest)
+bool env_eval_progn (s_env *env, const s_list *program, s_tag *dest)
 {
   const s_list *next;
   s_tag tmp;
@@ -333,19 +340,22 @@ s_tag * env_eval_progn (s_env *env, const s_list *program, s_tag *dest)
   assert(dest);
   while (program) {
     next = list_next(program);
-    env_eval_tag(env, &program->tag, &tmp);
+    if (! env_eval_tag(env, &program->tag, &tmp))
+      return false;
     if (next)
       tag_clean(&tmp);
     program = next;
   }
   *dest = tmp;
-  return dest;
+  return true;
 }
 
-s_tag * env_eval_tag (s_env *env, const s_tag *tag, s_tag *dest)
+bool env_eval_tag (s_env *env, const s_tag *tag, s_tag *dest)
 {
   switch (tag->type.type) {
-  case TAG_VOID: return tag_init_void(dest);
+  case TAG_VOID:
+    tag_init_void(dest);
+    return true;
   case TAG_CALL:
     return env_eval_call(env, &tag->data.call, dest);
   case TAG_CALL_FN:
@@ -375,11 +385,12 @@ s_tag * env_eval_tag (s_env *env, const s_tag *tag, s_tag *dest)
   case TAG_U64:
   case TAG_U8:
   case TAG_VAR:
-    return tag_copy(tag, dest);
+    tag_copy(tag, dest);
+    return true;
   }
   assert(! "env_eval_tag: invalid tag");
   errx(1, "env_eval_tag: invalid tag");
-  return NULL;
+  return false;
 }
 
 s_env * env_init (s_env *env)
diff --git a/libc3/env.h b/libc3/env.h
index b4420da..8ebe4c2 100644
--- a/libc3/env.h
+++ b/libc3/env.h
@@ -23,9 +23,13 @@ void    env_clean (s_env *env);
 s_env * env_init (s_env *env);
 
 /* modifiers */
-s_tag *    env_eval_call_fn (s_env *env, const s_call *call,
+bool       env_eval_call (s_env *env, const s_call *call,
+                          s_tag *dest);
+bool       env_eval_call_arguments (s_env *env, s_list *args,
+                                    s_list **dest);
+bool       env_eval_call_fn (s_env *env, const s_call *call,
                              s_tag *dest);
-s_tag *    env_eval_call_macro (s_env *env, const s_call *call,
+bool       env_eval_call_macro (s_env *env, const s_call *call,
                                 s_tag *dest);
 bool       env_eval_equal_list (s_env *env, const s_list *a,
                                 const s_list *b, s_list **dest);
@@ -33,12 +37,12 @@ bool       env_eval_equal_tag (s_env *env, const s_tag *a,
                                const s_tag *b, s_tag *dest);
 bool       env_eval_equal_tuple (s_env *env, const s_tuple *a,
                                  const s_tuple *b, s_tuple *dest);
-s_tag *    env_eval_fn (s_env *env, const s_fn *fn, s_tag *dest);
-s_tag *    env_eval_ident (s_env *env, const s_ident *ident,
+bool       env_eval_fn (s_env *env, const s_fn *fn, s_tag *dest);
+bool       env_eval_ident (s_env *env, const s_ident *ident,
                            s_tag *dest);
-s_tag *    env_eval_progn (s_env *env, const s_list *program,
+bool       env_eval_progn (s_env *env, const s_list *program,
                            s_tag *dest);
-s_tag *    env_eval_tag (s_env *env, const s_tag *tag, s_tag *dest);
+bool       env_eval_tag (s_env *env, const s_tag *tag, s_tag *dest);
 s_module * env_module_load (s_env *env, s_module *module,
                             const s_sym *name, s_facts *facts);
 
diff --git a/libc3/eval.c b/libc3/eval.c
index 9f9d0f1..4de6a54 100644
--- a/libc3/eval.c
+++ b/libc3/eval.c
@@ -16,7 +16,7 @@
 #include <stdlib.h>
 #include "c3.h"
 
-s_tag * eval_tag (const s_tag *tag, s_tag *dest)
+bool eval_tag (const s_tag *tag, s_tag *dest)
 {
   return env_eval_tag(&g_c3_env, tag, dest);
 }
diff --git a/libc3/eval.h b/libc3/eval.h
index 5676e93..27b62f9 100644
--- a/libc3/eval.h
+++ b/libc3/eval.h
@@ -16,12 +16,12 @@
 
 #include "types.h"
 
-s_tag *       eval_call_function (const s_call *call,
-                                  s_tag *dest);
-s_tag *       eval_call_macro (const s_call *call, s_tag *dest);
-s_tag *       eval_fn (const s_fn *fn, s_tag *dest);
-const s_tag * eval_ident (const s_ident *ident);
-s_tag *       eval_progn (const s_list *program, s_tag *dest);
-s_tag *       eval_tag (const s_tag *tag, s_tag *dest);
+bool eval_call_function (const s_call *call,
+                         s_tag *dest);
+bool eval_call_macro (const s_call *call, s_tag *dest);
+bool eval_fn (const s_fn *fn, s_tag *dest);
+bool eval_ident (const s_ident *ident, s_tag *dest);
+bool eval_progn (const s_list *program, s_tag *dest);
+bool eval_tag (const s_tag *tag, s_tag *dest);
 
 #endif /* EVAL_H */