Commit a1045c3594532aa92484c754f185ec14ba59e6d3
2023-08-10T16:25:26
wip call
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152
diff --git a/libc3/call.c b/libc3/call.c
index d304f9c..4994ab6 100644
--- a/libc3/call.c
+++ b/libc3/call.c
@@ -33,6 +33,8 @@ s_call * call_copy (const s_call *src, s_call *dest)
list_copy(src->arguments, &dest->arguments);
dest->cfn = src->cfn;
dest->fn = src->fn;
+ dest->macro = src->macro;
+ dest->special_operator = src->special_operator;
return dest;
}
diff --git a/libc3/env.c b/libc3/env.c
index 4e16e10..24c3a40 100644
--- a/libc3/env.c
+++ b/libc3/env.c
@@ -73,9 +73,7 @@ void env_error_tag (s_env *env, const s_tag *tag)
bool env_resolve_call (s_env *env, s_call *call)
{
- s_call c;
s_facts_with_cursor cursor;
- bool result;
s_tag tag_cfn;
s_tag tag_fn;
s_tag tag_ident;
@@ -89,16 +87,14 @@ bool env_resolve_call (s_env *env, s_call *call)
s_tag tag_var;
assert(env);
assert(call);
- assert(dest);
- call_copy(call, &c);
- ident_resolve_module(&c.ident, env);
+ ident_resolve_module(&call->ident, env);
tag_init_1( &tag_cfn, ":cfn");
tag_init_1( &tag_fn, ":fn");
- tag_init_ident(&tag_ident, &c.ident);
+ 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, c.ident.module_name);
+ 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");
@@ -110,8 +106,8 @@ bool env_resolve_call (s_env *env, s_call *call)
NULL, NULL });
if (! facts_with_cursor_next(&cursor))
errx(1, "symbol %s not found in module %s",
- c.ident.sym->str.ptr.ps8,
- c.ident.module_name->str.ptr.ps8);
+ 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,
@@ -119,9 +115,9 @@ bool env_resolve_call (s_env *env, s_call *call)
if (facts_with_cursor_next(&cursor)) {
if (tag_var.type != TAG_FN)
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.data.fn;
+ 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) {
@@ -130,31 +126,43 @@ bool env_resolve_call (s_env *env, s_call *call)
if (facts_with_cursor_next(&cursor)) {
if (tag_var.type != TAG_CFN)
errx(1, "%s.%s is not a C function",
- c.ident.module_name->str.ptr.ps8,
- c.ident.sym->str.ptr.ps8);
- c.cfn = &tag_var.data.cfn;
+ call->ident.module_name->str.ptr.ps8,
+ call->ident.sym->str.ptr.ps8);
+ call->cfn = &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))
- result = call->macro = true;
- else {
- 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))
- result = env_eval_call_special_operator(env, &c, dest);
- else
- result = env_eval_call_fn(env, &c, dest);
- }
+ 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);
- call_clean(&c);
- return result;
+ return true;
}
bool env_eval_call (s_env *env, const s_call *call, s_tag *dest)
{
+ s_call c;
+ assert(env);
+ assert(call);
+ assert(dest);
+ call_copy(call, &c);
+ env_resolve_call(env, &c);
+ if (c.macro)
+ return env_eval_call_macro(env, &c, dest);
+ if (c.special_operator)
+ return env_eval_call_special_operator(env, &c, dest);
+ if (c.cfn)
+ return env_eval_call_cfn(env, &c, dest);
+ if (c.fn)
+ return env_eval_call_fn(env, &c, dest);
+ warnx("env_eval_call: could not resolve call %s.",
+ call->ident.sym->str.ptr.ps8);
+ return false;
}
bool env_eval_call_arguments (s_env *env, s_list *args, s_list **dest)
@@ -212,8 +220,6 @@ bool env_eval_call_fn (s_env *env, const s_call *call, s_tag *dest)
assert(env);
assert(call);
assert(dest);
- if (call->cfn)
- return env_eval_call_cfn(env, call, dest);
fn = call->fn;
assert(fn);
frame_init(&frame, env->frame);
diff --git a/libc3/env.h b/libc3/env.h
index e5459fd..655b167 100644
--- a/libc3/env.h
+++ b/libc3/env.h
@@ -26,6 +26,8 @@ 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_cfn (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);
bool env_eval_call_macro (s_env *env, const s_call *call,