diff --git a/httpd/fx/app/models/fx.kc3 b/httpd/fx/app/models/fx.kc3
index 741dd30..a23232a 100644
--- a/httpd/fx/app/models/fx.kc3
+++ b/httpd/fx/app/models/fx.kc3
@@ -1,38 +1,34 @@
defmodule Fx do
- def db = Facts.database()
-
- Facts.open(db, "db/fx.facts")
-
def property_index = fn (path) {
if Str.starts_with?(path, "./") do
path = Str.slice(path, 2, -1)
end
- Facts.collect_with_tags(db, path, p = ?, o = ?, fn (fact) {
+ Facts.collect_with_tags(Config.db, path, p = ?, o = ?, fn (fact) {
{p, o}
})
}
def property_add = fn (path, property, value) {
- Facts.add_tags(db, path, property, value)
+ Facts.add_tags(Config.db, path, property, value)
}
def property_remove = fn (path, property, value) {
- Facts.remove_tags(db, path, property, value)
+ Facts.remove_tags(Config.db, path, property, value)
}
def tag_index = fn (path) {
- Facts.collect_with_tags(db, path, :tag, tag = ?, fn (fact) {
+ Facts.collect_with_tags(Config.db, path, :tag, tag = ?, fn (fact) {
tag
})
}
def tag_add = fn (path, tag) {
- Facts.add_tags(db, path, :tag, tag)
+ Facts.add_tags(Config.db, path, :tag, tag)
}
def tag_remove = fn (path, tag) {
- Facts.remove_tags(db, path, :tag, tag)
+ Facts.remove_tags(Config.db, path, :tag, tag)
}
end
diff --git a/lib/kc3/0.1/kc3.facts b/lib/kc3/0.1/kc3.facts
index 2c65485..e2d5968 100644
--- a/lib/kc3/0.1/kc3.facts
+++ b/lib/kc3/0.1/kc3.facts
@@ -353,3 +353,5 @@ replace {KC3.load_directory, :symbol_value, fn (dir) {
}}
add {KC3, :symbol, KC3.args}
replace {KC3.args, :symbol_value, cfn List "kc3_args" (Result)}
+add {KC3, :symbol, KC3.stacktrace}
+replace {KC3.stacktrace, :symbol_value, cfn List "kc3_stacktrace" (Result)}
diff --git a/libkc3/env.c b/libkc3/env.c
index 69d733e..73e7f73 100644
--- a/libkc3/env.c
+++ b/libkc3/env.c
@@ -183,8 +183,11 @@ bool env_call_get (s_env *env, s_call *call)
err_puts(" :symbol_value not found");
return false;
}
- if (tag_var.type == TAG_FN)
+ if (tag_var.type == TAG_FN) {
call->fn = fn_new_copy(&tag_var.data.fn);
+ fn_set_name_if_null(call->fn, call->ident.module,
+ call->ident.sym);
+ }
else if (tag_var.type == TAG_CFN)
call->cfn = cfn_new_copy(&tag_var.data.cfn);
else {
@@ -488,7 +491,7 @@ void env_error_tag (s_env *env, const s_tag *tag)
error_handler = env->error_handler;
if (error_handler) {
tag_init_copy(&error_handler->tag, tag);
- error_handler->backtrace = env->backtrace;
+ error_handler->stacktrace = list_new_copy(env->stacktrace);
env_longjmp(env, &error_handler->jmp_buf);
/* never reached */
return;
@@ -687,6 +690,7 @@ bool env_eval_call_fn_args (s_env *env, const s_fn *fn,
s_list *search_modules;
s_tag tag;
s_list *tmp = NULL;
+ s_list *trace;
assert(env);
assert(fn);
assert(dest);
@@ -746,6 +750,16 @@ bool env_eval_call_fn_args (s_env *env, const s_fn *fn,
frame_init(&frame, env->frame, fn->frame);
env->frame = &frame;
}
+ if (! (trace = list_new(env->stacktrace))) {
+ list_delete_all(args);
+ list_delete_all(tmp);
+ list_delete_all(env->search_modules);
+ env->search_modules = search_modules;
+ env->frame = env_frame;
+ frame_clean(&frame);
+ return false;
+ }
+ tag_init_ident(&trace->tag, &fn->ident);
if (! env_eval_block(env, &clause->algo, &tag)) {
list_delete_all(args);
list_delete_all(tmp);
@@ -3413,6 +3427,14 @@ s_list ** env_search_modules (s_env *env, s_list **dest)
return list_init_copy(dest, (const s_list * const *) &env->search_modules);
}
+s_list ** env_stacktrace (s_env *env, s_list **dest)
+{
+ assert(env);
+ assert(dest);
+ *dest = list_new_copy(env->stacktrace);
+ return dest;
+}
+
bool env_sym_search_modules (s_env *env, const s_sym *sym,
const s_sym **dest)
{
diff --git a/libkc3/env.h b/libkc3/env.h
index a86f4f6..5c98308 100644
--- a/libkc3/env.h
+++ b/libkc3/env.h
@@ -38,6 +38,7 @@ s_list ** env_module_search_modules (s_env *env,
const s_sym * const *module,
s_list **dest);
s_list ** env_search_modules (s_env *env, s_list **dest);
+s_list ** env_stacktrace (s_env *env, s_list **dest);
bool env_sym_search_modules (s_env *env,
const s_sym *sym,
const s_sym **dest);
diff --git a/libkc3/error.c b/libkc3/error.c
index aaf48f2..ce58770 100644
--- a/libkc3/error.c
+++ b/libkc3/error.c
@@ -21,14 +21,14 @@ void error_print (s_buf *buf, const s_error_handler *error_handler)
{
buf_write_1(buf, "error: ");
buf_inspect_tag(buf, &error_handler->tag);
- buf_write_1(buf, "\nBacktrace:\n");
- error_print_backtrace(buf, error_handler->backtrace);
+ buf_write_1(buf, "\nStacktrace:\n");
+ error_print_stacktrace(buf, error_handler->stacktrace);
}
-void error_print_backtrace (s_buf *buf, const s_list *backtrace)
+void error_print_stacktrace (s_buf *buf, const s_list *stacktrace)
{
- while (backtrace) {
- buf_inspect_tag(buf, &backtrace->tag);
+ while (stacktrace) {
+ buf_inspect_tag(buf, &stacktrace->tag);
buf_write_1(buf, "\n");
}
}
diff --git a/libkc3/error.h b/libkc3/error.h
index 2a0df97..da5ae78 100644
--- a/libkc3/error.h
+++ b/libkc3/error.h
@@ -23,6 +23,6 @@
} while (0)
void error_print (s_buf *buf, const s_error_handler *error_handler);
-void error_print_backtrace (s_buf *buf, const s_list *backtrace);
+void error_print_stacktrace (s_buf *buf, const s_list *stacktrace);
#endif /* LIBKC3_ERROR_H */
diff --git a/libkc3/fn.c b/libkc3/fn.c
index 9021146..1d27b84 100644
--- a/libkc3/fn.c
+++ b/libkc3/fn.c
@@ -149,3 +149,13 @@ s_fn * fn_new_copy (const s_fn *src)
}
return fn;
}
+
+s_fn * fn_set_name_if_null (s_fn *fn, const s_sym *module,
+ const s_sym *name)
+{
+ if (! fn->ident.sym) {
+ fn->ident.module = module;
+ fn->ident.sym = name;
+ }
+ return fn;
+}
diff --git a/libkc3/fn.h b/libkc3/fn.h
index 568e325..16dec5b 100644
--- a/libkc3/fn.h
+++ b/libkc3/fn.h
@@ -37,4 +37,8 @@ s_fn * fn_new_copy (const s_fn *fn);
/* Observers. */
s8 fn_arity (const s_fn *fn);
+/* Operators. */
+s_fn * fn_set_name_if_null (s_fn *fn, const s_sym *module,
+ const s_sym *name);
+
#endif /* LIBKC3_FN_H */
diff --git a/libkc3/frame.c b/libkc3/frame.c
index afbd9f3..e19af11 100644
--- a/libkc3/frame.c
+++ b/libkc3/frame.c
@@ -13,7 +13,9 @@
#include "alloc.h"
#include "assert.h"
#include "binding.h"
+#include "fn.h"
#include "frame.h"
+#include "ident.h"
#include "list.h"
#include "sym.h"
#include "tag.h"
@@ -41,23 +43,25 @@ s_frame * frame_binding_new_copy (s_frame *frame, const s_sym *name,
s_tag *value)
{
s_tag *tag;
- frame_binding_new(frame, name);
- tag = binding_get_w(frame->bindings, name);
- if (tag == NULL) {
- err_puts("frame_binding_new_copy: binding new");
- assert(! "frame_binding_new_copy: binding new");
+ if (! (tag = frame_binding_new(frame, name))) {
+ err_puts("frame_binding_new_copy: frame_binding_new");
+ assert(! "frame_binding_new_copy: frame_binding_new");
return NULL;
}
if (value->type == TAG_VAR) {
tag_init_var(tag, value->data.var.type);
value->data.var.ptr = tag->data.var.ptr;
}
- else if (! tag_init_copy(tag, value)) {
- err_puts("frame_binding_new_copy: tag_init_copy");
- assert(! "frame_binding_new_copy: tag_init_copy");
- frame = frame_binding_delete(frame, name);
- return NULL;
- }
+ else {
+ if (! tag_init_copy(tag, value)) {
+ err_puts("frame_binding_new_copy: tag_init_copy");
+ assert(! "frame_binding_new_copy: tag_init_copy");
+ frame = frame_binding_delete(frame, name);
+ return NULL;
+ }
+ if (tag->type == TAG_FN)
+ fn_set_name_if_null(&tag->data.fn, NULL, name);
+ }
return frame;
}
@@ -237,8 +241,15 @@ s_frame * frame_replace (s_frame *frame, const s_sym *sym,
tag_init_var(result, value->data.var.type);
value->data.var.ptr = result->data.var.ptr;
}
- else
- tag_init_copy(result, value);
+ else {
+ if (! tag_init_copy(result, value)) {
+ err_puts("frame_replace: tag_init_copy");
+ assert(! "frame_replace: tag_init_copy");
+ return NULL;
+ }
+ if (result->type == TAG_FN)
+ fn_set_name_if_null(&result->data.fn, NULL, sym);
+ }
return frame;
}
return frame_binding_new_copy(frame, sym, value);
diff --git a/libkc3/kc3.c b/libkc3/kc3.c
index 729bcf3..7334ff9 100644
--- a/libkc3/kc3.c
+++ b/libkc3/kc3.c
@@ -484,6 +484,11 @@ s_list ** kc3_search_modules (s_list **dest)
return env_search_modules(&g_kc3_env, dest);
}
+s_list ** kc3_stacktrace (s_list **dest)
+{
+ return env_stacktrace(&g_kc3_env, dest);
+}
+
s_str * kc3_str (const s_tag *tag, s_str *dest)
{
const s_sym *sym;
diff --git a/libkc3/kc3_main.h b/libkc3/kc3_main.h
index 1761696..0cd419f 100644
--- a/libkc3/kc3_main.h
+++ b/libkc3/kc3_main.h
@@ -49,6 +49,7 @@ const s_sym ** kc3_module (const s_sym **dest);
uw * kc3_offsetof (const s_sym * const *module,
const s_sym * const *field, uw *dest);
sw kc3_puts (const s_tag *tag);
+s_list ** kc3_stacktrace (s_list **dest);
s_str * kc3_str (const s_tag *tag, s_str *dest);
s_tag * kc3_struct_put (const s_tag *s,
const s_sym * const *key,
diff --git a/libkc3/types.h b/libkc3/types.h
index d5b651d..ea77d6c 100644
--- a/libkc3/types.h
+++ b/libkc3/types.h
@@ -402,14 +402,6 @@ struct file_stat {
s_time st_ctim; /* Time of last status change */
};
-struct fn {
- s_fn_clause *clauses;
- bool macro;
- bool special_operator;
- const s_sym *module;
- s_frame *frame;
-};
-
struct ident {
const s_sym *module;
const s_sym *sym;
@@ -465,6 +457,15 @@ struct cfn {
bool special_operator;
};
+struct fn {
+ s_fn_clause *clauses;
+ bool macro;
+ bool special_operator;
+ s_ident ident;
+ const s_sym *module;
+ s_frame *frame;
+};
+
struct log {
s_buf buf;
u64 count;
@@ -571,7 +572,7 @@ struct complex {
struct error_handler
{
- s_list *backtrace;
+ s_list *stacktrace;
jmp_buf jmp_buf;
s_error_handler *next;
s_tag tag;
@@ -705,7 +706,7 @@ struct env {
sw argc;
char **argv;
s_str argv0_dir;
- s_list *backtrace;
+ s_list *stacktrace;
const s_sym *current_defmodule;
s_buf err;
s_error_handler *error_handler;
diff --git a/test/httpd/config/db.kc3 b/test/httpd/config/db.kc3
new file mode 100644
index 0000000..ee9b5ff
--- /dev/null
+++ b/test/httpd/config/db.kc3
@@ -0,0 +1,7 @@
+defmodule Config do
+
+ def db = Facts.database()
+
+ Facts.open(db, "db/app.facts")
+
+end
diff --git a/test/httpd/db/app.facts b/test/httpd/db/app.facts
new file mode 120000
index 0000000..f5ce1fe
--- /dev/null
+++ b/test/httpd/db/app.facts
@@ -0,0 +1 @@
+../../../httpd/fx/db/fx.facts
\ No newline at end of file
diff --git a/test/httpd/db/fx.facts b/test/httpd/db/fx.facts
deleted file mode 120000
index f5ce1fe..0000000
--- a/test/httpd/db/fx.facts
+++ /dev/null
@@ -1 +0,0 @@
-../../../httpd/fx/db/fx.facts
\ No newline at end of file