add some char primitives
This commit is contained in:
parent
7f35eb7daa
commit
850290dda3
|
@ -0,0 +1,39 @@
|
||||||
|
#include "picrin.h"
|
||||||
|
|
||||||
|
static pic_value
|
||||||
|
pic_char_char_p(pic_state *pic)
|
||||||
|
{
|
||||||
|
pic_value v;
|
||||||
|
|
||||||
|
pic_get_args(pic, "o", &v);
|
||||||
|
|
||||||
|
return pic_char_p(v) ? pic_true_value() : pic_false_value();
|
||||||
|
}
|
||||||
|
|
||||||
|
static pic_value
|
||||||
|
pic_char_char_to_integer(pic_state *pic)
|
||||||
|
{
|
||||||
|
char c;
|
||||||
|
|
||||||
|
pic_get_args(pic, "c", &c);
|
||||||
|
|
||||||
|
return pic_int_value(c);
|
||||||
|
}
|
||||||
|
|
||||||
|
static pic_value
|
||||||
|
pic_char_integer_to_char(pic_state *pic)
|
||||||
|
{
|
||||||
|
int i;
|
||||||
|
|
||||||
|
pic_get_args(pic, "i", &i);
|
||||||
|
|
||||||
|
return pic_char_value(i);
|
||||||
|
}
|
||||||
|
|
||||||
|
void
|
||||||
|
pic_init_char(pic_state *pic)
|
||||||
|
{
|
||||||
|
pic_defun(pic, "char?", pic_char_char_p);
|
||||||
|
pic_defun(pic, "char->integer", pic_char_char_to_integer);
|
||||||
|
pic_defun(pic, "integer->char", pic_char_integer_to_char);
|
||||||
|
}
|
|
@ -16,6 +16,7 @@ void pic_init_symbol(pic_state *);
|
||||||
void pic_init_vector(pic_state *);
|
void pic_init_vector(pic_state *);
|
||||||
void pic_init_blob(pic_state *);
|
void pic_init_blob(pic_state *);
|
||||||
void pic_init_cont(pic_state *);
|
void pic_init_cont(pic_state *);
|
||||||
|
void pic_init_char(pic_state *);
|
||||||
|
|
||||||
void
|
void
|
||||||
pic_load_stdlib(pic_state *pic)
|
pic_load_stdlib(pic_state *pic)
|
||||||
|
@ -81,6 +82,7 @@ pic_init_core(pic_state *pic)
|
||||||
pic_init_vector(pic); DONE;
|
pic_init_vector(pic); DONE;
|
||||||
pic_init_blob(pic); DONE;
|
pic_init_blob(pic); DONE;
|
||||||
pic_init_cont(pic); DONE;
|
pic_init_cont(pic); DONE;
|
||||||
|
pic_init_char(pic); DONE;
|
||||||
|
|
||||||
pic_load_stdlib(pic); DONE;
|
pic_load_stdlib(pic); DONE;
|
||||||
}
|
}
|
||||||
|
|
18
src/vm.c
18
src/vm.c
|
@ -216,6 +216,24 @@ pic_get_args(pic_state *pic, const char *format, ...)
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
break;
|
break;
|
||||||
|
case 'c':
|
||||||
|
{
|
||||||
|
char *c;
|
||||||
|
pic_value v;
|
||||||
|
|
||||||
|
c = va_arg(ap, char *);
|
||||||
|
if (i < argc) {
|
||||||
|
v = GET_OPERAND(pic,i);
|
||||||
|
if (pic_char_p(v)) {
|
||||||
|
*c = pic_char(v);
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
pic_error(pic, "pic_get_args: expected char");
|
||||||
|
}
|
||||||
|
i++;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
break;
|
||||||
default:
|
default:
|
||||||
{
|
{
|
||||||
pic_error(pic, "pic_get_args: invalid argument specifier given");
|
pic_error(pic, "pic_get_args: invalid argument specifier given");
|
||||||
|
|
Loading…
Reference in New Issue