implement memq and assq with c

This commit is contained in:
Yuichi Nishiwaki 2014-07-19 12:48:27 +09:00
parent d6b6376408
commit a2c00017ea
3 changed files with 41 additions and 23 deletions

View File

@ -49,6 +49,8 @@ int pic_length(pic_state *, pic_value);
pic_value pic_reverse(pic_state *, pic_value);
pic_value pic_append(pic_state *, pic_value, pic_value);
pic_value pic_memq(pic_state *, pic_value key, pic_value list);
pic_value pic_assq(pic_state *, pic_value key, pic_value assoc);
pic_value pic_assoc(pic_state *, pic_value key, pic_value assoc);
pic_value pic_acons(pic_state *, pic_value key, pic_value val, pic_value assoc);

View File

@ -39,13 +39,6 @@
(import (scheme base)
(picrin dictionary))
(define (memq obj list)
(if (null? list)
#f
(if (eq? obj (car list))
list
(memq obj (cdr list)))))
(define (list->vector list)
(define vector (make-vector (length list)))
(define (go list i)
@ -830,13 +823,6 @@
;;; 6.4 Pairs and lists
(define (memq obj list)
(if (null? list)
#f
(if (eq? obj (car list))
list
(memq obj (cdr list)))))
(define (memv obj list)
(if (null? list)
#f
@ -844,13 +830,6 @@
list
(memq obj (cdr list)))))
(define (assq obj list)
(if (null? list)
#f
(if (eq? obj (caar list))
(car list)
(assq obj (cdr list)))))
(define (assv obj list)
(if (null? list)
#f
@ -874,8 +853,8 @@
(car list)
(assoc obj (cdr list) compare)))))
(export memq memv member
assq assv assoc)
(export memv member
assv assoc)
;;; 6.5. Symbols

View File

@ -261,6 +261,21 @@ pic_append(pic_state *pic, pic_value xs, pic_value ys)
return ys;
}
pic_value
pic_memq(pic_state *pic, pic_value key, pic_value list)
{
enter:
if (pic_nil_p(list))
return pic_false_value();
if (pic_eq_p(key, pic_car(pic, list)))
return list;
list = pic_cdr(pic, list);
goto enter;
}
pic_value
pic_assq(pic_state *pic, pic_value key, pic_value assoc)
{
@ -594,6 +609,26 @@ pic_pair_list_copy(pic_state *pic)
return pic_list_copy(pic, obj);
}
static pic_value
pic_pair_memq(pic_state *pic)
{
pic_value key, list;
pic_get_args(pic, "oo", &key, &list);
return pic_memq(pic, key, list);
}
static pic_value
pic_pair_assq(pic_state *pic)
{
pic_value key, list;
pic_get_args(pic, "oo", &key, &list);
return pic_assq(pic, key, list);
}
void
pic_init_pair(pic_state *pic)
{
@ -618,4 +653,6 @@ pic_init_pair(pic_state *pic)
pic_defun(pic, "list-ref", pic_pair_list_ref);
pic_defun(pic, "list-set!", pic_pair_list_set);
pic_defun(pic, "list-copy", pic_pair_list_copy);
pic_defun(pic, "memq", pic_pair_memq);
pic_defun(pic, "assq", pic_pair_assq);
}