diff --git a/contrib/40.srfi/srfi/17.scm b/contrib/40.srfi/srfi/17.scm index 66c0061c..62221ed9 100644 --- a/contrib/40.srfi/srfi/17.scm +++ b/contrib/40.srfi/srfi/17.scm @@ -16,9 +16,9 @@ (define setter (letrec ((setter (lambda (proc) - (let ((setter (dictionary-ref (attribute proc) '@@setter))) - (if setter - (cdr setter) + (let ((attr (attribute proc))) + (if (dictionary-has? attr '@@setter) + (dictionary-ref attr '@@setter) (error "no setter found"))))) (set-setter! (lambda (proc setter) diff --git a/lib/dict.c b/lib/dict.c index 234b090b..6a521428 100644 --- a/lib/dict.c +++ b/lib/dict.c @@ -121,6 +121,16 @@ pic_dict_dictionary_p(pic_state *pic) return pic_bool_value(pic, pic_dict_p(pic, obj)); } +static pic_value +pic_dict_dictionary_has_p(pic_state *pic) +{ + pic_value dict, key; + + pic_get_args(pic, "dm", &dict, &key); + + return pic_bool_value(pic, pic_dict_has(pic, dict, key)); +} + static pic_value pic_dict_dictionary_ref(pic_state *pic) { @@ -128,10 +138,7 @@ pic_dict_dictionary_ref(pic_state *pic) pic_get_args(pic, "dm", &dict, &key); - if (! pic_dict_has(pic, dict, key)) { - return pic_false_value(pic); - } - return pic_cons(pic, key, pic_dict_ref(pic, dict, key)); + return pic_dict_ref(pic, dict, key); } static pic_value @@ -141,14 +148,18 @@ pic_dict_dictionary_set(pic_state *pic) pic_get_args(pic, "dmo", &dict, &key, &val); - if (pic_undef_p(pic, val)) { - if (pic_dict_has(pic, dict, key)) { - pic_dict_del(pic, dict, key); - } - } - else { - pic_dict_set(pic, dict, key, val); - } + pic_dict_set(pic, dict, key, val); + return pic_undef_value(pic); +} + +static pic_value +pic_dict_dictionary_delete(pic_state *pic) +{ + pic_value dict, key; + + pic_get_args(pic, "dm", &dict, &key); + + pic_dict_del(pic, dict, key); return pic_undef_value(pic); } @@ -262,8 +273,10 @@ pic_init_dict(pic_state *pic) pic_defun(pic, "make-dictionary", pic_dict_make_dictionary); pic_defun(pic, "dictionary?", pic_dict_dictionary_p); pic_defun(pic, "dictionary", pic_dict_dictionary); + pic_defun(pic, "dictionary-has?", pic_dict_dictionary_has_p); pic_defun(pic, "dictionary-ref", pic_dict_dictionary_ref); pic_defun(pic, "dictionary-set!", pic_dict_dictionary_set); + pic_defun(pic, "dictionary-delete!", pic_dict_dictionary_delete); pic_defun(pic, "dictionary-size", pic_dict_dictionary_size); pic_defun(pic, "dictionary-map", pic_dict_dictionary_map); pic_defun(pic, "dictionary-for-each", pic_dict_dictionary_for_each); diff --git a/lib/ext/eval.c b/lib/ext/eval.c index ead9e944..009b4f44 100644 --- a/lib/ext/eval.c +++ b/lib/ext/eval.c @@ -272,7 +272,7 @@ optimize_beta(pic_state *pic, pic_value expr) pic_protect(pic, expr); functor = pic_list_ref(pic, expr, 0); - if (pic_pair_p(pic, functor) && EQ(pic_car(pic, functor), "lambda")) { + if (pic_pair_p(pic, functor) && pic_sym_p(pic, pic_car(pic, functor)) && EQ(pic_car(pic, functor), "lambda")) { formals = pic_list_ref(pic, functor, 1); if (! pic_list_p(pic, formals)) goto exit; /* TODO: support ((lambda args x) 1 2) */ diff --git a/lib/include/picrin.h b/lib/include/picrin.h index 2defbee3..3bcde2cc 100644 --- a/lib/include/picrin.h +++ b/lib/include/picrin.h @@ -97,7 +97,6 @@ typedef struct { void (*dtor)(pic_state *, void *); } pic_data_type; -bool pic_undef_p(pic_state *, pic_value); /* deprecated */ bool pic_int_p(pic_state *, pic_value); bool pic_float_p(pic_state *, pic_value); bool pic_char_p(pic_state *, pic_value);