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, ...);