Add bytevector and port functions.

src/base.c

@@ -48,11 +48,15 @@ extern void li_parse_args(li_object *args, const char *fmt, ...)
             break;
         obj = li_car(args);
         switch (*s) {
+        case 'B':
+            li_assert_bytevector(obj);
+            *va_arg(ap, li_bytevector_t **) = (li_bytevector_t *)obj;
+            break;
         case 'b':
             li_assert_integer(obj);
             if (0 > li_to_integer(obj) || li_to_integer(obj) > 255)
                 li_error("not a byte", obj);
-            *va_arg(ap, unsigned char *) = li_to_integer(obj);
+            *va_arg(ap, li_byte_t *) = li_to_integer(obj);
             break;
         case 'c':
             li_assert_character(obj);

src/bytevector.c

@@ -5,7 +5,7 @@
 struct li_bytevector_t {
     LI_OBJ_HEAD;
     int length;
-    unsigned char *bytes;
+    li_byte_t *bytes;
 };
 
 static void bytevector_deinit(li_bytevector_t *v)
@@ -45,7 +45,7 @@ const li_type_t li_type_bytevector = {
     .set = (li_set_f *)bytevector_set,
 };
 
-extern li_bytevector_t *li_make_bytevector(int k, unsigned char byte)
+extern li_bytevector_t *li_make_bytevector(int k, li_byte_t byte)
 {
     li_bytevector_t *v = li_allocate(NULL, 1, sizeof(*v));
     li_object_init((li_object *)v, &li_type_bytevector);
@@ -62,11 +62,8 @@ extern li_bytevector_t *li_bytevector(li_object *lst)
     li_object_init((li_object *)v, &li_type_bytevector);
     v->length = li_length(lst);
     v->bytes = li_allocate(NULL, v->length, sizeof(*v->bytes));
-    for (i = 0; i < v->length; ++i) {
-        int b;
-        li_parse_args(lst, "b.", &b, &lst);
-        v->bytes[i] = b;
-    }
+    for (i = 0; i < v->length; ++i)
+        li_parse_args(lst, "b.", &v->bytes[i], &lst);
     return v;
 }
 
@@ -75,12 +72,12 @@ extern int li_bytevector_length(li_bytevector_t *v)
     return v->length;
 }
 
-extern unsigned char li_bytevector_get(li_bytevector_t *v, int k)
+extern li_byte_t li_bytevector_get(li_bytevector_t *v, int k)
 {
     return v->bytes[k];
 }
 
-extern void li_bytevector_set(li_bytevector_t *v, int k, unsigned char byte)
+extern void li_bytevector_set(li_bytevector_t *v, int k, li_byte_t byte)
 {
     v->bytes[k] = byte;
 }
@@ -95,8 +92,8 @@ static li_object *p_is_bytevector(li_object *args)
 static li_object *p_make_bytevector(li_object *args)
 {
     int k;
-    unsigned char fill = 0;
-    li_parse_args(args, "i?b", &k, &fill);
+    li_byte_t fill = 0;
+    li_parse_args(args, "k?b", &k, &fill);
     return (li_object *)li_make_bytevector(k, fill);
 }
 
@@ -112,12 +109,88 @@ static li_object *p_bytevector(li_object *args)
     return (li_object *)v;
 }
 
+static li_object *p_bytevector_length(li_object *args)
+{
+    li_bytevector_t *vec;
+    li_parse_args(args, "B", &vec);
+    return (li_object *)li_num_with_int(li_bytevector_length(vec));
+}
+
+static li_object *p_bytevector_u8_ref(li_object *args)
+{
+    li_bytevector_t *vec;
+    int k;
+    li_parse_args(args, "Bk", &vec, &k);
+    return (li_object *)li_num_with_int(li_bytevector_get(vec, k));
+}
+
+static li_object *p_bytevector_u8_set(li_object *args)
+{
+    li_bytevector_t *vec;
+    int k, b;
+    li_parse_args(args, "Bkk", &vec, &k, &b);
+    li_bytevector_set(vec, k, b);
+    return NULL;
+}
+
+static li_bytevector_t *bytevector_copy(
+        li_bytevector_t *to, int at,
+        li_bytevector_t *from, int start, int end)
+{
+    int i, n;
+    if (end < 0)
+        end = li_bytevector_length(from);
+    n = end - start;
+    if (!to)
+        to = li_make_bytevector(n, 0);
+    for (i = 0; i < n; ++i)
+        li_bytevector_set(to, at + i, li_bytevector_get(from, start + i));
+    return to;
+}
+
+
+static li_object *p_bytevector_copy(li_object *args)
+{
+    li_bytevector_t *from;
+    int start = 0, end = -1;
+    li_parse_args(args, "B?kk", &from, &start, &end);
+    return (li_object *)bytevector_copy(NULL, 0, from, start, end);
+}
+
+static li_object *p_bytevector_copy_ex(li_object *args)
+{
+    li_bytevector_t *to, *from;
+    int at, start = 0, end = -1;
+    li_parse_args(args, "BkB?kk", &to, &at, &from, &start, &end);
+    return (li_object *)bytevector_copy(to, at, from, start, end);
+}
+
+static li_object *p_bytevector_append(li_object *args)
+{
+    li_bytevector_t *to, *from;
+    li_object *iter = args;
+    int i = 0;
+    while (iter) {
+        li_parse_args(iter, "B.", &to, &iter);
+        i += li_bytevector_length(to);
+    }
+    to = li_make_bytevector(i, 0);
+    for (i = 0, iter = args; iter; iter = li_cdr(iter)) {
+        int j, n;
+        from = (li_bytevector_t *)li_car(iter);
+        n = li_bytevector_length(from);
+        for (j = 0; j < n; ++i, ++j)
+            li_bytevector_set(to, i, li_bytevector_get(from, j));
+    }
+    return (li_object *)to;
+}
+
 static li_object *p_bytevector_to_string(li_object *args)
 {
     li_bytevector_t *v;
     int start = 0, end = -1;
-    li_parse_args(args, "o?ii", &v, &start, &end);
-    if (end != -1)
+    li_parse_args(args, "B?kk", &v, &start, &end);
+    if (end >= 0)
         li_error_f("end arg not supported");
     return (li_object *)li_string_make((char *)v->bytes + start);
 }
@@ -143,6 +216,12 @@ extern void li_define_bytevector_functions(li_env_t *env)
     defproc(env, "bytevector?", p_is_bytevector);
     defproc(env, "make-bytevector", p_make_bytevector);
     defproc(env, "bytevector", p_bytevector);
-    defproc(env, "bytevector->string", p_bytevector_to_string);
-    defproc(env, "string->bytevector", p_string_to_bytevector);
+    defproc(env, "bytevector-length", p_bytevector_length);
+    defproc(env, "bytevector-u8-ref", p_bytevector_u8_ref);
+    defproc(env, "bytevector-u8-set!", p_bytevector_u8_set);
+    defproc(env, "bytevector-copy", p_bytevector_copy);
+    defproc(env, "bytevector-copy!", p_bytevector_copy_ex);
+    defproc(env, "bytevector-append", p_bytevector_append);
+    defproc(env, "utf8->string", p_bytevector_to_string);
+    defproc(env, "string->utf8", p_string_to_bytevector);
 }

src/li.h

@@ -16,6 +16,7 @@
     strcpy(li_allocate(NULL, strlen(s) + 1, sizeof(char)), s)
 
 typedef int li_bool_t;
+typedef unsigned char li_byte_t;
 
 #define LI_FALSE ((li_bool_t)0)
 #define LI_TRUE (!LI_FALSE)
@@ -99,12 +100,11 @@ extern const li_type_t li_type_type;
 extern const li_type_t li_type_vector;
 
 /* bytevectors */
-#define li_is_bytevector(obj)           li_is_type((obj), li_type_bytevector)
 extern li_bytevector_t *li_bytevector(li_object *lst);
-extern li_bytevector_t *li_make_bytevector(int k, unsigned char byte);
+extern li_bytevector_t *li_make_bytevector(int k, li_byte_t byte);
 extern int li_bytevector_length(li_bytevector_t *v);
-extern unsigned char li_bytevector_get(li_bytevector_t *v, int k);
-extern void li_bytevector_set(li_bytevector_t *v, int k, unsigned char byte);
+extern li_byte_t li_bytevector_get(li_bytevector_t *v, int k);
+extern void li_bytevector_set(li_bytevector_t *v, int k, li_byte_t byte);
 
 /* Characters */
 
@@ -298,6 +298,7 @@ extern int li_length(li_object *obj);
     ((li_special_form_obj_t *)(obj))->special_form
 
 #define li_is_boolean(obj)              li_is_type(obj, &li_type_boolean)
+#define li_is_bytevector(obj)           li_is_type(obj, &li_type_bytevector)
 #define li_is_character(obj)            li_is_type(obj, &li_type_character)
 #define li_is_environment(obj)          li_is_type(obj, &li_type_environment)
 #define li_is_macro(obj)                li_is_type(obj, &li_type_macro)
@@ -383,6 +384,7 @@ extern FILE *li_port_fp(li_port_t *port);
     if (!li_is_##type(arg)) \
         li_error("not a " #type, arg)
 
+#define li_assert_bytevector(arg)       li_assert_type(bytevector, arg)
 #define li_assert_character(arg)        li_assert_type(character, arg)
 #define li_assert_integer(arg)          li_assert_type(integer, arg)
 #define li_assert_list(arg)             li_assert_type(list, arg)

src/port.c

@@ -202,6 +202,24 @@ static li_object *p_is_output_port_open(li_object *args)
     return li_boolean(port->flags & IO_OUTPUT);
 }
 
+static li_object *p_current_input_port(li_object *args)
+{
+    (void)args;
+    return (li_object *)li_port_stdin;
+}
+
+static li_object *p_current_output_port(li_object *args)
+{
+    (void)args;
+    return (li_object *)li_port_stdout;
+}
+
+static li_object *p_current_error_port(li_object *args)
+{
+    (void)args;
+    return (li_object *)li_port_stderr;
+}
+
 /*
  * (open-input-file filename)
  */
@@ -263,12 +281,19 @@ static li_object *p_peek_char(li_object *args) {
     return li_character(c);
 }
 
-static li_object *p_is_eof_object(li_object *args) {
+static li_object *p_is_eof_object(li_object *args)
+{
     li_object *obj;
     li_parse_args(args, "o", &obj);
     return li_boolean(obj == li_eof);
 }
 
+static li_object *p_eof_object(li_object *args)
+{
+    li_parse_args(args, "");
+    return li_eof;
+}
+
 /*
  * (write obj)
  * Displays an li_object. Always returns null.
@@ -304,6 +329,65 @@ static li_object *p_newline(li_object *args) {
     return NULL;
 }
 
+static li_object *p_write_char(li_object *args) {
+    li_character_t c;
+    li_port_t *port = li_port_stdout;
+    char s[5];
+    li_parse_args(args, "c?r", &c, &port);
+    li_chr_encode(c, s, 5);
+    li_port_printf(port, "%s", s);
+    return NULL;
+}
+
+static li_object *p_write_string(li_object *args)
+{
+    li_str_t *str;
+    li_port_t *port = li_port_stdout;
+    int start = 0, end = -1;
+    li_parse_args(args, "s?rkk", &str, &port, &start, &end);
+    if (!start && end < 0)
+        li_port_printf(port, "%s", li_string_bytes(str));
+    else
+        /* TODO: implement this. */
+        li_error_f("unimplemented parameters: ~a", args);
+    return NULL;
+}
+
+static li_object *p_write_u8(li_object *args)
+{
+    li_byte_t b;
+    li_port_t *port = li_port_stdout;
+    li_parse_args(args, "b?rkk", &b);
+    li_port_printf(port, "%c", b);
+    return NULL;
+}
+
+static li_object *p_write_bytevector(li_object *args)
+{
+    li_bytevector_t *bv;
+    li_port_t *port = li_port_stdout;
+    int start = 0, end = -1;
+    li_parse_args(args, "B?rkk", &bv, &port, &start, &end);
+    if (end < 0)
+        end = li_bytevector_length(bv);
+    while (start < end)
+        li_port_printf(port, "%s", li_bytevector_get(bv, start));
+    return NULL;
+}
+
+static li_object *p_flush_output_port(li_object *args)
+{
+    li_port_t *port = li_port_stdout;
+    FILE *fp;
+    li_parse_args(args, "?r", &port);
+    if (!(port->flags & IO_OUTPUT))
+        return NULL;
+    fp = li_port_fp(port);
+    if (fp)
+        fflush(fp);
+    return NULL;
+}
+
 static li_object *p_print(li_object *args) {
     for (; args; args = li_cdr(args)) {
         li_port_display(li_port_stdout, li_car(args));
@@ -316,22 +400,60 @@ static li_object *p_print(li_object *args) {
 
 extern void li_define_port_functions(li_env_t *env)
 {
-    lilib_defproc(env, "port?", p_is_port);
     lilib_defproc(env, "input-port?", p_is_input_port);
     lilib_defproc(env, "output-port?", p_is_output_port);
+    /* lilib_defproc(env, "textual-port?", p_is_textual_port); */
+    /* lilib_defproc(env, "binary-port?", p_is_binary_port); */
+    lilib_defproc(env, "port?", p_is_port);
+
     lilib_defproc(env, "input-port-open?", p_is_input_port_open);
     lilib_defproc(env, "output-port-open?", p_is_output_port_open);
+
+    lilib_defproc(env, "current-input-port", p_current_input_port);
+    lilib_defproc(env, "current-output-port", p_current_output_port);
+    lilib_defproc(env, "current-error-port", p_current_error_port);
+
     lilib_defproc(env, "open-input-file", p_open_input_file);
+    /* lilib_defproc(env, "open-binary-input-file", p_open_binary_input_file); */
+
     lilib_defproc(env, "open-output-file", p_open_output_file);
+    /* lilib_defproc(env, "open-binary-output-file", p_open_binary_output_file); */
+
     lilib_defproc(env, "close-port", p_close_port);
     lilib_defproc(env, "close-input-port", p_close_port);
     lilib_defproc(env, "close-output-port", p_close_port);
+
+    /* lilib_defproc(env, "open-input-string", p_open_input_string); */
+    /* lilib_defproc(env, "open-output-string", p_open_output_string); */
+    /* lilib_defproc(env, "get-output-string", p_get_output_string); */
+
+    /* lilib_defproc(env, "open-input-bytevector", p_open_input_bytevector); */
+    /* lilib_defproc(env, "open-output-bytevector", p_open_output_bytevector); */
+    /* lilib_defproc(env, "get-output-bytevector", p_get_output_bytevector); */
+
     lilib_defproc(env, "read", p_read);
     lilib_defproc(env, "read-char", p_read_char);
     lilib_defproc(env, "peek-char", p_peek_char);
+    /* lilib_defproc(env, "read-line", p_read_line); */
     lilib_defproc(env, "eof-object?", p_is_eof_object);
+    lilib_defproc(env, "eof-object", p_eof_object);
+    /* lilib_defproc(env, "char-ready?", p_is_char_ready); */
+    /* lilib_defproc(env, "read-string", p_read_string); */
+    /* lilib_defproc(env, "read-u8", p_read_u8); */
+    /* lilib_defproc(env, "peek-u8", p_peek_u8); */
+    /* lilib_defproc(env, "read-bytevector", p_read_bytevector); */
+    /* lilib_defproc(env, "read-bytevector!", p_read_bytevector_ex); */
+
     lilib_defproc(env, "write", p_write);
+    /* lilib_defproc(env, "write-shared", p_write); */
+    /* lilib_defproc(env, "write-simple", p_write); */
     lilib_defproc(env, "display", p_display);
     lilib_defproc(env, "newline", p_newline);
+    lilib_defproc(env, "write-char", p_write_char);
+    lilib_defproc(env, "write-string", p_write_string);
+    lilib_defproc(env, "write-u8", p_write_u8);
+    lilib_defproc(env, "write-bytevector", p_write_bytevector);
+    lilib_defproc(env, "flush-output-port", p_flush_output_port);
+
     lilib_defproc(env, "print", p_print);
 }