Commit 5b5b3c9a20b7b79b281d57263892353eb76e93a1

Thomas de Grivel 2023-08-11T09:53:01

ic3> f = fn (x) { x + 1 }

diff --git a/libc3/env.c b/libc3/env.c
index b4e2396..e0afa1c 100644
--- a/libc3/env.c
+++ b/libc3/env.c
@@ -79,7 +79,7 @@ bool env_eval_call (s_env *env, const s_call *call, s_tag *dest)
   assert(call);
   assert(dest);
   call_copy(call, &c);
-  env_resolve_call(env, &c);
+  env_eval_call_resolve(env, &c);
   if (c.macro)
     result = env_eval_call_macro(env, &c, dest);
   else if (c.special_operator)
@@ -198,6 +198,90 @@ bool env_eval_call_macro (s_env *env, const s_call *call, s_tag *dest)
   return false;
 }
 
+bool env_eval_call_resolve (s_env *env, s_call *call)
+{
+  s_facts_with_cursor cursor;
+  s_tag tag_cfn;
+  s_tag tag_fn;
+  s_tag tag_ident;
+  s_tag tag_is_a;
+  s_tag tag_macro;
+  s_tag tag_module;
+  s_tag tag_module_name;
+  s_tag tag_special_operator;
+  s_tag tag_sym;
+  s_tag tag_symbol;
+  s_tag tag_var;
+  const s_tag *value;
+  assert(env);
+  assert(call);
+  if ((value = frame_get(env->frame, call->ident.sym))) {
+    if (value->type == TAG_CFN) {
+      call->cfn = cfn_new_copy(&value->data.cfn);
+      return true;
+    }
+    else if (value->type == TAG_FN) {
+      call->fn = value->data.fn;
+      return true;
+    }
+  }
+  ident_resolve_module(&call->ident, env);
+  tag_init_1(    &tag_cfn,      ":cfn");
+  tag_init_1(    &tag_fn,       ":fn");
+  tag_init_ident(&tag_ident, &call->ident);
+  tag_init_1(    &tag_is_a,     ":is_a");
+  tag_init_1(    &tag_macro,    ":macro");
+  tag_init_1(    &tag_module,   ":module");
+  tag_init_sym(  &tag_module_name, call->ident.module_name);
+  tag_init_1(    &tag_special_operator, ":special_operator");
+  tag_init_sym(  &tag_sym, call->ident.sym);
+  tag_init_1(    &tag_symbol,   ":symbol");
+  tag_init_var(  &tag_var);
+  facts_with(&env->facts, &cursor, (t_facts_spec) {
+      &tag_module_name,
+      &tag_is_a, &tag_module,     /* module exists */
+      &tag_symbol, &tag_ident,    /* module exports symbol */
+      NULL, NULL });
+  if (! facts_with_cursor_next(&cursor))
+    errx(1, "symbol %s not found in module %s",
+         call->ident.sym->str.ptr.ps8,
+         call->ident.module_name->str.ptr.ps8);
+  facts_with_cursor_clean(&cursor);
+  facts_with(&env->facts, &cursor, (t_facts_spec) {
+      &tag_ident, &tag_fn, &tag_var,
+      NULL, NULL });
+  if (facts_with_cursor_next(&cursor)) {
+    if (tag_var.type != TAG_FN)
+      errx(1, "%s.%s is not a function",
+           call->ident.module_name->str.ptr.ps8,
+           call->ident.sym->str.ptr.ps8);
+    call->fn = tag_var.data.fn;
+  }
+  facts_with_cursor_clean(&cursor);
+  facts_with(&env->facts, &cursor, (t_facts_spec) {
+      &tag_ident, &tag_cfn, &tag_var,
+      NULL, NULL });
+  if (facts_with_cursor_next(&cursor)) {
+    if (tag_var.type != TAG_CFN)
+      errx(1, "%s.%s is not a C function",
+           call->ident.module_name->str.ptr.ps8,
+           call->ident.sym->str.ptr.ps8);
+    call->cfn = cfn_new_copy(&tag_var.data.cfn);
+  }
+  facts_with_cursor_clean(&cursor);
+  facts_with(&env->facts, &cursor, (t_facts_spec) {
+      &tag_ident, &tag_is_a, &tag_macro, NULL, NULL });
+  if (facts_with_cursor_next(&cursor))
+    call->macro = true;
+  facts_with_cursor_clean(&cursor);
+  facts_with(&env->facts, &cursor, (t_facts_spec) {
+      &tag_ident, &tag_is_a, &tag_special_operator, NULL, NULL});
+  if (facts_with_cursor_next(&cursor))
+    call->special_operator = true;
+  facts_with_cursor_clean(&cursor);
+  return true;
+}
+
 bool env_eval_call_special_operator (s_env *env, const s_call *call,
                                      s_tag *dest)
 {
@@ -691,79 +775,6 @@ void env_push_unwind_protect (s_env *env,
   env->unwind_protect = unwind_protect;
 }
 
-bool env_resolve_call (s_env *env, s_call *call)
-{
-  s_facts_with_cursor cursor;
-  s_tag tag_cfn;
-  s_tag tag_fn;
-  s_tag tag_ident;
-  s_tag tag_is_a;
-  s_tag tag_macro;
-  s_tag tag_module;
-  s_tag tag_module_name;
-  s_tag tag_special_operator;
-  s_tag tag_sym;
-  s_tag tag_symbol;
-  s_tag tag_var;
-  assert(env);
-  assert(call);
-  ident_resolve_module(&call->ident, env);
-  tag_init_1(    &tag_cfn,      ":cfn");
-  tag_init_1(    &tag_fn,       ":fn");
-  tag_init_ident(&tag_ident, &call->ident);
-  tag_init_1(    &tag_is_a,     ":is_a");
-  tag_init_1(    &tag_macro,    ":macro");
-  tag_init_1(    &tag_module,   ":module");
-  tag_init_sym(  &tag_module_name, call->ident.module_name);
-  tag_init_1(    &tag_special_operator, ":special_operator");
-  tag_init_sym(  &tag_sym, call->ident.sym);
-  tag_init_1(    &tag_symbol,   ":symbol");
-  tag_init_var(  &tag_var);
-  facts_with(&env->facts, &cursor, (t_facts_spec) {
-      &tag_module_name,
-      &tag_is_a, &tag_module,     /* module exists */
-      &tag_symbol, &tag_ident,    /* module exports symbol */
-      NULL, NULL });
-  if (! facts_with_cursor_next(&cursor))
-    errx(1, "symbol %s not found in module %s",
-         call->ident.sym->str.ptr.ps8,
-         call->ident.module_name->str.ptr.ps8);
-  facts_with_cursor_clean(&cursor);
-  facts_with(&env->facts, &cursor, (t_facts_spec) {
-      &tag_ident, &tag_fn, &tag_var,
-      NULL, NULL });
-  if (facts_with_cursor_next(&cursor)) {
-    if (tag_var.type != TAG_FN)
-      errx(1, "%s.%s is not a function",
-           call->ident.module_name->str.ptr.ps8,
-           call->ident.sym->str.ptr.ps8);
-    call->fn = tag_var.data.fn;
-  }
-  facts_with_cursor_clean(&cursor);
-  facts_with(&env->facts, &cursor, (t_facts_spec) {
-      &tag_ident, &tag_cfn, &tag_var,
-      NULL, NULL });
-  if (facts_with_cursor_next(&cursor)) {
-    if (tag_var.type != TAG_CFN)
-      errx(1, "%s.%s is not a C function",
-           call->ident.module_name->str.ptr.ps8,
-           call->ident.sym->str.ptr.ps8);
-    call->cfn = cfn_new_copy(&tag_var.data.cfn);
-  }
-  facts_with_cursor_clean(&cursor);
-  facts_with(&env->facts, &cursor, (t_facts_spec) {
-      &tag_ident, &tag_is_a, &tag_macro, NULL, NULL });
-  if (facts_with_cursor_next(&cursor))
-    call->macro = true;
-  facts_with_cursor_clean(&cursor);
-  facts_with(&env->facts, &cursor, (t_facts_spec) {
-      &tag_ident, &tag_is_a, &tag_special_operator, NULL, NULL});
-  if (facts_with_cursor_next(&cursor))
-    call->special_operator = true;
-  facts_with_cursor_clean(&cursor);
-  return true;
-}
-
 s_tag * env_unwind_protect (s_env *env, s_tag *protected, s_list *cleanup,
                             s_tag *dest)
 {
diff --git a/libc3/env.h b/libc3/env.h
index 655b167..1babe0e 100644
--- a/libc3/env.h
+++ b/libc3/env.h
@@ -32,6 +32,7 @@ bool       env_eval_call_fn (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);
+bool       env_eval_call_resolve (s_env *env, s_call *call);
 bool       env_eval_call_special_operator (s_env *env,
                                            const s_call *call,
                                            s_tag *dest);
@@ -55,7 +56,6 @@ bool       env_operator_is_right_associative (s_env *env,
 bool       env_operator_is_unary (s_env *env, const s_ident *op);
 s8         env_operator_precedence (s_env *env,
                                     const s_ident *op);
-bool       env_resolve_call (s_env *env, s_call *call);
 
 /* control structures */
 void env_error_f (s_env *env, const char *fmt, ...);