add some char primitives

This commit is contained in:
Yuichi Nishiwaki 2013-11-14 20:41:22 +09:00
parent 7f35eb7daa
commit 850290dda3
3 changed files with 59 additions and 0 deletions

39
src/char.c Normal file
View File

@ -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);
}

View File

@ -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;
} }

View File

@ -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");