implement native version of some primitive functions such as car,crd...

This commit is contained in:
Yuichi Nishiwaki 2013-11-15 16:07:03 +09:00
parent b9985dd682
commit a2f022df4e
2 changed files with 44 additions and 10 deletions

View File

@ -1,10 +1,3 @@
; Although looking like a magic, it just works.
(define (car x)
(car x))
(define (cdr x)
(cdr x))
(define (zero? n) (define (zero? n)
(= n 0)) (= n 0))
@ -138,9 +131,6 @@
(every pred (cdr list)) (every pred (cdr list))
#f))) #f)))
(define (null? obj)
(null? obj))
(define (any pred list) (define (any pred list)
(if (null? list) (if (null? list)
#f #f

View File

@ -125,6 +125,46 @@ pic_pair_pair_p(pic_state *pic)
return pic_bool_value(pic_pair_p(v)); return pic_bool_value(pic_pair_p(v));
} }
static pic_value
pic_pair_car(pic_state *pic)
{
pic_value v;
pic_get_args(pic, "o", &v);
return pic_car(pic, v);
}
static pic_value
pic_pair_cdr(pic_state *pic)
{
pic_value v;
pic_get_args(pic, "o", &v);
return pic_cdr(pic, v);
}
static pic_value
pic_pair_null_p(pic_state *pic)
{
pic_value v;
pic_get_args(pic, "o", &v);
return pic_bool_value(pic_nil_p(v));
}
static pic_value
pic_pair_cons(pic_state *pic)
{
pic_value v,w;
pic_get_args(pic, "oo", &v, &w);
return pic_cons(pic, v, w);
}
static pic_value static pic_value
pic_pair_set_car(pic_state *pic) pic_pair_set_car(pic_state *pic)
{ {
@ -157,6 +197,10 @@ void
pic_init_pair(pic_state *pic) pic_init_pair(pic_state *pic)
{ {
pic_defun(pic, "pair?", pic_pair_pair_p); pic_defun(pic, "pair?", pic_pair_pair_p);
pic_defun(pic, "car", pic_pair_car);
pic_defun(pic, "cdr", pic_pair_cdr);
pic_defun(pic, "null?", pic_pair_null_p);
pic_defun(pic, "cons", pic_pair_cons);
pic_defun(pic, "set-car!", pic_pair_set_car); pic_defun(pic, "set-car!", pic_pair_set_car);
pic_defun(pic, "set-cdr!", pic_pair_set_cdr); pic_defun(pic, "set-cdr!", pic_pair_set_cdr);
} }