conservatory
/
picrin
4
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

[prepare] dictionary is to be changed to have only symbols for its keys

This commit is contained in:
Yuichi Nishiwaki 2015-01-17 21:01:13 +09:00
parent 2652d9724d
commit 3e9da6d3e3
2 changed files with 18 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
extlib/benz/boot.c
View File

@ -308,13 +308,10 @@ my $src = <<'EOL';
(let* ((old-bindings (let* ((old-bindings
(current-dynamic-environment)) (current-dynamic-environment))
(binding (binding
(let ((dict (dictionary))) (map (lambda (parameter value)
(for-each (cons parameter (parameter value #f)))
(lambda (parameter value) parameters
(dictionary-set! dict parameter (list (parameter value #f)))) values))
parameters
values)
dict))
(new-bindings (new-bindings
(cons binding old-bindings))) (cons binding old-bindings)))
(dynamic-wind (dynamic-wind
@ -709,13 +706,10 @@ const char pic_boot[] =
" (let* ((old-bindings\n" " (let* ((old-bindings\n"
" (current-dynamic-environment))\n" " (current-dynamic-environment))\n"
" (binding\n" " (binding\n"
" (let ((dict (dictionary)))\n" " (map (lambda (parameter value)\n"
" (for-each\n" " (cons parameter (parameter value #f)))\n"
" (lambda (parameter value)\n" " parameters\n"
" (dictionary-set! dict parameter (list (parameter value #f))))\n" " values))\n"
" parameters\n"
" values)\n"
" dict))\n"
" (new-bindings\n" " (new-bindings\n"
" (cons binding old-bindings)))\n" " (cons binding old-bindings)))\n"
" (dynamic-wind\n" " (dynamic-wind\n"

20
extlib/benz/var.c
View File

@ -5,13 +5,11 @@
#include "picrin.h" #include "picrin.h"
#include "picrin/pair.h" #include "picrin/pair.h"
#include "picrin/proc.h" #include "picrin/proc.h"
#include "picrin/dict.h"
static pic_value static pic_value
var_lookup(pic_state *pic, pic_value var) var_lookup(pic_state *pic, pic_value var)
{ {
pic_value val, env; pic_value val, env, binding;
struct pic_dict *binding;
val = pic_ref(pic, pic->PICRIN_BASE, "current-dynamic-environment"); val = pic_ref(pic, pic->PICRIN_BASE, "current-dynamic-environment");
if (pic_eq_p(val, var)) { if (pic_eq_p(val, var)) {
@ -20,11 +18,13 @@ var_lookup(pic_state *pic, pic_value var)
env = pic_apply0(pic, pic_proc_ptr(val)); env = pic_apply0(pic, pic_proc_ptr(val));
while (! pic_nil_p(env)) { while (! pic_nil_p(env)) {
pic_assert_type(pic, pic_car(pic, env), dict); binding = pic_car(pic, env);
binding = pic_dict_ptr(pic_car(pic, env)); while (! pic_nil_p(binding)) {
if (pic_dict_has(pic, binding, var)) { if (pic_eq_p(pic_caar(pic, binding), var)) {
return pic_dict_ref(pic, binding, var); return pic_car(pic, binding);
}
binding = pic_cdr(pic, binding);
} }
env = pic_cdr(pic, env); env = pic_cdr(pic, env);
} }
@ -48,7 +48,7 @@ var_call(pic_state *pic)
switch (n) { switch (n) {
case 0: case 0:
return pic_car(pic, box); return pic_cdr(pic, box);
case 1: case 1:
conv = pic_attr_ref(pic, pic_obj_value(self), "@@converter"); conv = pic_attr_ref(pic, pic_obj_value(self), "@@converter");
@ -57,7 +57,7 @@ var_call(pic_state *pic)
val = pic_apply1(pic, pic_proc_ptr(conv), val); val = pic_apply1(pic, pic_proc_ptr(conv), val);
} }
pic_set_car(pic, box, val); pic_set_cdr(pic, box, val);
return pic_none_value(); return pic_none_value();
@ -82,7 +82,7 @@ pic_make_var(pic_state *pic, pic_value init, struct pic_proc *conv)
struct pic_proc *var; struct pic_proc *var;
var = pic_make_proc(pic, var_call, "<var-call>"); var = pic_make_proc(pic, var_call, "<var-call>");
pic_attr_set(pic, pic_obj_value(var), "@@box", pic_list1(pic, init)); pic_attr_set(pic, pic_obj_value(var), "@@box", pic_cons(pic, pic_false_value(), init));
pic_attr_set(pic, pic_obj_value(var), "@@converter", conv ? pic_obj_value(conv) : pic_false_value()); pic_attr_set(pic, pic_obj_value(var), "@@converter", conv ? pic_obj_value(conv) : pic_false_value());
return var; return var;