picrin/extlib/benz/char.c

86 lines
1.9 KiB
C
Raw Normal View History

2014-08-25 00:38:09 -04:00
/**
* See Copyright Notice in picrin.h
*/
#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(pic, v) ? pic_true_value(pic) : pic_false_value(pic);
2014-08-25 00:38:09 -04:00
}
static pic_value
pic_char_char_to_integer(pic_state *pic)
{
char c;
pic_get_args(pic, "c", &c);
return pic_int_value(pic, c);
2014-08-25 00:38:09 -04:00
}
static pic_value
pic_char_integer_to_char(pic_state *pic)
{
int i;
pic_get_args(pic, "i", &i);
if (i < 0 || i > 127) {
pic_errorf(pic, "integer->char: integer out of char range: %d", i);
}
2015-08-26 06:04:27 -04:00
return pic_char_value(pic, (char)i);
2014-08-25 00:38:09 -04:00
}
2014-09-10 04:18:14 -04:00
#define DEFINE_CHAR_CMP(op, name) \
static pic_value \
pic_char_##name##_p(pic_state *pic) \
{ \
2015-08-26 06:04:27 -04:00
int argc, i; \
2014-09-10 04:18:14 -04:00
pic_value *argv; \
char c, d; \
\
pic_get_args(pic, "cc*", &c, &d, &argc, &argv); \
\
if (! (c op d)) \
return pic_false_value(pic); \
2014-09-10 04:18:14 -04:00
\
for (i = 0; i < argc; ++i) { \
c = d; \
if (pic_char_p(pic, argv[i])) \
d = pic_char(pic, argv[i]); \
2014-09-10 04:18:14 -04:00
else \
2014-09-16 10:43:15 -04:00
pic_errorf(pic, #op ": char required"); \
2014-09-10 04:18:14 -04:00
\
if (! (c op d)) \
return pic_false_value(pic); \
2014-09-10 04:18:14 -04:00
} \
\
return pic_true_value(pic); \
2014-09-10 04:18:14 -04:00
}
DEFINE_CHAR_CMP(==, eq)
DEFINE_CHAR_CMP(<, lt)
DEFINE_CHAR_CMP(>, gt)
DEFINE_CHAR_CMP(<=, le)
DEFINE_CHAR_CMP(>=, ge)
2014-08-25 00:38:09 -04:00
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);
2014-09-10 04:18:14 -04:00
pic_defun(pic, "char=?", pic_char_eq_p);
pic_defun(pic, "char<?", pic_char_lt_p);
pic_defun(pic, "char>?", pic_char_gt_p);
pic_defun(pic, "char<=?", pic_char_le_p);
pic_defun(pic, "char>=?", pic_char_ge_p);
2014-08-25 00:38:09 -04:00
}