add dictionary-delete! and dictionary-has?

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)

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);

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) */

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);