diff --git a/http/http_response.c b/http/http_response.c
index 7294fb0..ca67e11 100644
--- a/http/http_response.c
+++ b/http/http_response.c
@@ -24,11 +24,11 @@ sw http_response_buf_write (const s_http_response *response,
s_ident ident = {0};
s_tag *key = NULL;
const s_list *l = NULL;
- s_tag message = {0};
s_str protocol = {0};
sw r = 0;
sw result = 0;
s_tag tag_code = {0};
+ s_tag tag_message = {0};
s_tag *value = NULL;
assert(response);
assert(buf);
@@ -65,21 +65,26 @@ sw http_response_buf_write (const s_http_response *response,
return -1;
}
if (alist_get((const s_list * const *) &default_messages.data.list,
- &tag_code, &message)) {
- if (message.type != TAG_STR) {
+ &tag_code, &tag_message)) {
+ if (tag_message.type != TAG_STR) {
err_puts("http_response_buf_write: invalid default message:"
" not a Str");
+ tag_clean(&tag_message);
return -1;
}
}
}
else {
- message.type = TAG_STR;
- message.data.str = response->message;
+ tag_message.type = TAG_STR;
+ tag_message.data.str = response->message;
}
- if ((r = buf_write_str(buf, &message.data.str)) < 0)
+ err_write_1("message: ");
+ err_inspect_tag(&tag_message);
+ err_write_1("\n");
+ if ((r = buf_write_str(buf, &tag_message.data.str)) < 0)
return r;
result += r;
+ tag_clean(&tag_message);
if ((r = buf_write_1(buf, "\r\n")) < 0)
return r;
result += r;
diff --git a/lib/kc3/0.1/http/response.kc3 b/lib/kc3/0.1/http/response.kc3
index 8630e6b..98ebcb1 100644
--- a/lib/kc3/0.1/http/response.kc3
+++ b/lib/kc3/0.1/http/response.kc3
@@ -3,7 +3,7 @@ defmodule HTTP.Response do
defstruct [protocol: "HTTP/1.1",
code: (U16) 200,
message: "OK",
- headers: [],
+ headers: [{"Content-Type", "text/html"}],
body: ""]
dlopen(__DIR__ + "../http.so")
diff --git a/lib/kc3/0.1/httpd.kc3 b/lib/kc3/0.1/httpd.kc3
index 81bb49d..83ebea3 100644
--- a/lib/kc3/0.1/httpd.kc3
+++ b/lib/kc3/0.1/httpd.kc3
@@ -3,10 +3,12 @@ defmodule HTTPd do
def server_loop = fn (client) {
puts("HTTPd.server_loop: got client #{client}")
ok = true
- while ok do
+ req = true
+ while req do
req = HTTP.Request.buf_parse(client.buf_rw.r)
- res = %HTTP.Response{body: "
-<html>
+ if req do
+ puts("HTTPd.server_loop: got request #{req}")
+ res = %HTTP.Response{body: "<html>
<head>
<title>KC3 HTTPd</title>
</head>
@@ -20,7 +22,11 @@ defmodule HTTPd do
</body>
</html>
"}
- if (HTTP.Response.buf_write(res, client.buf_rw.w) < 0) do
+ puts("HTTPd.server_loop: response: #{res}")
+ if (HTTP.Response.buf_write(res, client.buf_rw.w) < 0) do
+ req = false
+ end
+ else
ok = false
end
end
diff --git a/lib/kc3/0.1/socket/buf.kc3 b/lib/kc3/0.1/socket/buf.kc3
index af8d02c..e564aac 100644
--- a/lib/kc3/0.1/socket/buf.kc3
+++ b/lib/kc3/0.1/socket/buf.kc3
@@ -1,6 +1,6 @@
defmodule Socket.Buf do
- defstruct [addr: (PtrFree) 0,
+ defstruct [addr: (Ptr) 0,
addr_len: (U32) 0,
sockfd: (S32) -1,
buf_rw: %BufRW{}]
diff --git a/libkc3/alist.c b/libkc3/alist.c
index dc75ee2..10b2e8d 100644
--- a/libkc3/alist.c
+++ b/libkc3/alist.c
@@ -25,20 +25,19 @@
#include "tag.h"
#include "tuple.h"
-s_tag * alist_get (const s_list * const *alist, const s_tag *key, s_tag *dest)
+s_tag * alist_get (const s_list * const *alist, const s_tag *key,
+ s_tag *dest)
{
- const s_list *l;
- assert(alist);
- assert(list_is_alist(alist));
- assert(key);
- assert(dest);
- l = *alist;
- while (l) {
- if (! compare_tag(&l->tag.data.tuple.tag[0], key)) {
- *dest = l->tag.data.tuple.tag[1];
- return dest;
- }
- l = list_next(l);
- }
- return NULL;
+ const s_list *l;
+ assert(alist);
+ assert(list_is_alist(alist));
+ assert(key);
+ assert(dest);
+ l = *alist;
+ while (l) {
+ if (! compare_tag(&l->tag.data.tuple.tag[0], key))
+ return tag_init_copy(dest, l->tag.data.tuple.tag + 1);
+ l = list_next(l);
+ }
+ return NULL;
}
diff --git a/libkc3/bool.c b/libkc3/bool.c
index 1932511..f409d8c 100644
--- a/libkc3/bool.c
+++ b/libkc3/bool.c
@@ -72,20 +72,20 @@ bool * bool_init_cast (bool *b, const s_sym * const *type,
case TAG_SYM:
case TAG_TUPLE:
case TAG_UNQUOTE:
- case TAG_VAR:
- case TAG_VOID:
- break;
+ case TAG_VAR: *b = true; return b;
+ case TAG_VOID: *b = false; return b;
+ default:
+ err_write_1("bool_cast: cannot cast ");
+ err_write_1(tag_type_to_string(tag->type));
+ if (*type == &g_sym_Bool)
+ err_puts(" to Bool");
+ else {
+ err_write_1(" to ");
+ err_inspect_sym(type);
+ err_puts(" aka Bool");
+ }
+ assert(! "bool_cast: cannot cast to Bool");
}
- err_write_1("bool_cast: cannot cast ");
- err_write_1(tag_type_to_string(tag->type));
- if (*type == &g_sym_Bool)
- err_puts(" to Bool");
- else {
- err_write_1(" to ");
- err_inspect_sym(type);
- err_puts(" aka Bool");
- }
- assert(! "bool_cast: cannot cast to Bool");
return NULL;
}
diff --git a/libkc3/buf_fd.c b/libkc3/buf_fd.c
index 529b923..5378ed2 100644
--- a/libkc3/buf_fd.c
+++ b/libkc3/buf_fd.c
@@ -77,13 +77,11 @@ sw buf_fd_open_r_refill (s_buf *buf)
if (avail < 0) {
err_write_1("buf_fd_open_r_refill: avail: ");
err_inspect_s32_decimal(&avail);
+ err_write_1("\n");
return -1;
}
- if (! avail) {
- err_write_1("buf_fd_open_r_refill: avail: ");
- err_inspect_s32_decimal(&avail);
- return 0;
- }
+ if (! avail)
+ avail = 1;
if ((uw) avail > size)
avail = size;
r = read(fd, buf->ptr.pchar + buf->wpos, avail);
diff --git a/libkc3/buf_inspect.c b/libkc3/buf_inspect.c
index bcae46e..3079607 100644
--- a/libkc3/buf_inspect.c
+++ b/libkc3/buf_inspect.c
@@ -545,6 +545,7 @@ sw buf_inspect_call_if_then_else (s_buf *buf, const s_call *call)
{
s_tag *condition;
s_tag *else_;
+ uw i;
sw r;
sw result = 0;
s_tag *then;
@@ -561,8 +562,18 @@ sw buf_inspect_call_if_then_else (s_buf *buf, const s_call *call)
result += r;
then = &list_next(call->arguments)->tag;
if (then->type == TAG_BLOCK) {
- if ((r = buf_inspect_block_inner(buf, &then->data.block)) < 0)
+ if ((r = buf_write_1(buf, " do")) < 0)
return r;
+ result += r;
+ i = 0;
+ while (i < then->data.block.count) {
+ if ((r = buf_write_1(buf, "\n ")) < 0)
+ return r;
+ result += r;
+ if ((r = buf_inspect_tag(buf, then->data.block.tag + i)) < 0)
+ return r;
+ i++;
+ }
}
else
if ((r = buf_inspect_tag(buf, then)) < 0)
@@ -2090,12 +2101,15 @@ sw buf_inspect_ratio_size (const s_ratio *ratio)
sw buf_inspect_str (s_buf *buf, const s_str *str)
{
+ bool b = false;
sw r;
sw result = 0;
s_buf_save save;
assert(buf);
assert(str);
- if (str_has_reserved_characters(str))
+ if (! str_has_reserved_characters(str, &b))
+ return -1;
+ if (b)
return buf_inspect_str_reserved(buf, str);
buf_save_init(buf, &save);
if ((r = buf_write_u8(buf, '"')) <= 0)
@@ -2326,9 +2340,12 @@ sw buf_inspect_str_reserved_size (const s_str *str)
sw buf_inspect_str_size (const s_str *str)
{
+ bool b;
const sw quote_size = strlen("\"");
sw size;
- if (str_has_reserved_characters(str))
+ if (! str_has_reserved_characters(str, &b))
+ return -1;
+ if (b)
return buf_inspect_str_reserved_size(str);
size = str->size + 2 * quote_size;
return size;
diff --git a/libkc3/env.c b/libkc3/env.c
index 4221921..de4c878 100644
--- a/libkc3/env.c
+++ b/libkc3/env.c
@@ -524,7 +524,6 @@ bool env_eval_array_tag (s_env *env, const s_array *array, s_tag *dest)
bool env_eval_block (s_env *env, const s_block *block, s_tag *dest)
{
uw i = 0;
- bool r;
s_tag tmp = {0};
assert(env);
assert(block);
@@ -534,10 +533,8 @@ bool env_eval_block (s_env *env, const s_block *block, s_tag *dest)
return true;
}
while (i < block->count - 1) {
- r = env_eval_tag(env, block->tag + i, &tmp);
- tag_clean(&tmp);
- if (! r)
- return false;
+ if (env_eval_tag(env, block->tag + i, &tmp))
+ tag_clean(&tmp);
i++;
}
return env_eval_tag(env, block->tag + i, dest);
@@ -3145,7 +3142,7 @@ s_tag * env_unwind_protect (s_env *env, s_tag *protected, s_block *cleanup,
s_tag * env_while (s_env *env, const s_tag *cond, const s_tag *body,
s_tag *dest)
{
- s_tag cond_bool = {0};
+ s_tag cond_bool = {0};
s_call cond_cast = {0};
s_tag tmp = {0};
call_init_call_cast(&cond_cast, &g_sym_Bool);
diff --git a/libkc3/kc3.c b/libkc3/kc3.c
index 92605c5..441f73c 100644
--- a/libkc3/kc3.c
+++ b/libkc3/kc3.c
@@ -17,8 +17,10 @@
#include "bool.h"
#include "buf.h"
#include "buf_parse.h"
-#include "kc3_main.h"
+#include "call.h"
#include "env.h"
+#include "kc3_main.h"
+#include "list.h"
#include "map.h"
#include "str.h"
#include "struct.h"
@@ -139,12 +141,6 @@ void kc3_exit (sw code)
exit((int) code);
}
-bool * kc3_must_clean(const s_sym * const *sym, bool *dest)
-{
- assert(sym);
- return sym_must_clean(*sym, dest);
-}
-
uw * kc3_facts_next_id (uw *dest)
{
assert(dest);
@@ -173,24 +169,35 @@ s_str * kc3_getenv (const s_str *name, s_str *dest)
s_tag * kc3_if_then_else (const s_tag *cond, const s_tag *then,
const s_tag *else_, s_tag *dest)
{
- bool b;
+ s_call cond_cast = {0};
s_tag tmp = {0};
- const s_sym *type;
- if (! env_eval_tag(&g_kc3_env, cond, &tmp))
+ call_init_call_cast(&cond_cast, &g_sym_Bool);
+ if (! tag_init_copy(&list_next(cond_cast.arguments)->tag, cond)) {
+ call_clean(&cond_cast);
+ return NULL;
+ }
+ if (! env_eval_call(&g_kc3_env, &cond_cast, &tmp)) {
+ call_clean(&cond_cast);
return NULL;
- type = &g_sym_Bool;
- if (! bool_init_cast(&b, &type, &tmp)) {
+ }
+ if (tmp.type != TAG_BOOL) {
tag_clean(&tmp);
+ call_clean(&cond_cast);
return NULL;
}
- tag_clean(&tmp);
- if (b) {
- if (! env_eval_tag(&g_kc3_env, then, dest))
+ if (tmp.data.bool) {
+ if (! env_eval_tag(&g_kc3_env, then, dest)) {
+ call_clean(&cond_cast);
return NULL;
+ }
+ call_clean(&cond_cast);
return dest;
}
- if (! env_eval_tag(&g_kc3_env, else_, dest))
+ if (! env_eval_tag(&g_kc3_env, else_, dest)) {
+ call_clean(&cond_cast);
return NULL;
+ }
+ call_clean(&cond_cast);
return dest;
}
@@ -222,6 +229,12 @@ const s_sym ** kc3_module (const s_sym **dest)
return env_module(&g_kc3_env, dest);
}
+bool * kc3_must_clean (const s_sym * const *sym, bool *dest)
+{
+ assert(sym);
+ return sym_must_clean(*sym, dest);
+}
+
s_tag * kc3_pin (const s_tag *a, s_tag *dest)
{
if (! env_eval_tag(&g_kc3_env, a, dest))
diff --git a/libkc3/str.c b/libkc3/str.c
index 2ab90a6..86eb67f 100644
--- a/libkc3/str.c
+++ b/libkc3/str.c
@@ -160,19 +160,24 @@ void str_delete (s_str *str)
free(str);
}
-bool str_has_reserved_characters (const s_str *src)
+bool * str_has_reserved_characters (const s_str *src, bool *dest)
{
character c;
sw r;
- s_str stra;
- str_init(&stra, NULL, src->size, src->ptr.p);
- while ((r = str_read_character_utf8(&stra, &c)) > 0) {
- if (str_character_is_reserved(c))
- return true;
+ s_str str;
+ str_init(&str, NULL, src->size, src->ptr.p);
+ while ((r = str_read_character_utf8(&str, &c)) > 0) {
+ if (str_character_is_reserved(c)) {
+ *dest = true;
+ return dest;
+ }
}
- if (r < 0)
- return true;
- return false;
+ if (r < 0) {
+ *dest = true;
+ return dest;
+ }
+ *dest = false;
+ return dest;
}
s_str * str_init (s_str *str, char *free, uw size, const char *p)
diff --git a/libkc3/str.h b/libkc3/str.h
index 31218e7..4909682 100644
--- a/libkc3/str.h
+++ b/libkc3/str.h
@@ -86,7 +86,8 @@ sw str_character (const s_str *str, uw position,
character str_character_escape (character c);
bool str_character_is_reserved (character c);
sw str_character_position (const s_str *str, character c);
-bool str_has_reserved_characters (const s_str *str);
+bool * str_has_reserved_characters (const s_str *src,
+ bool *dest);
s_str * str_inspect (const s_str *str, s_str *dest);
sw str_length_utf8 (const s_str *str);
bool str_parse_eval (const s_str *str, s_tag *dest);