add set-car!/set-cdr!

This commit is contained in:
Yuichi Nishiwaki 2013-10-23 12:01:06 +09:00
parent 5f05fed38f
commit f01ac50dd2
2 changed files with 37 additions and 0 deletions

View File

@ -1,5 +1,6 @@
#include "picrin.h"
void pic_init_pair(pic_state *);
void pic_init_port(pic_state *);
void pic_init_number(pic_state *);
void pic_init_time(pic_state *);
@ -14,6 +15,7 @@ pic_init_core(pic_state *pic)
int ai;
ai = pic_gc_arena_preserve(pic);
pic_init_pair(pic); DONE;
pic_init_port(pic); DONE;
pic_init_number(pic); DONE;
pic_init_time(pic); DONE;

View File

@ -82,3 +82,38 @@ pic_acons(pic_state *pic, pic_value key, pic_value val, pic_value assoc)
{
return pic_cons(pic, pic_cons(pic, key, val), assoc);
}
static pic_value
pic_pair_set_car(pic_state *pic)
{
pic_value v,w;
pic_get_args(pic, "oo", &v, &w);
if (! pic_pair_p(v))
pic_error(pic, "pair expected");
pic_pair_ptr(v)->car = w;
return pic_true_value();
}
static pic_value
pic_pair_set_cdr(pic_state *pic)
{
pic_value v,w;
pic_get_args(pic, "oo", &v, &w);
if (! pic_pair_p(v))
pic_error(pic, "pair expected");
pic_pair_ptr(v)->cdr = w;
return pic_true_value();
}
void
pic_init_pair(pic_state *pic)
{
pic_defun(pic, "set-car!", pic_pair_set_car);
pic_defun(pic, "set-cdr!", pic_pair_set_cdr);
}