body in parameterize is now a tail position

This commit is contained in:
Yuichi Nishiwaki 2017-04-25 12:38:46 +09:00
parent 0788b78336
commit 26ee94dd19
3 changed files with 3702 additions and 3568 deletions

File diff suppressed because it is too large Load Diff

View File

@ -67,25 +67,24 @@ pic_var_make_parameter(pic_state *pic)
}
static pic_value
pic_var_with_dynamic_environment(pic_state *pic)
pic_var_current_dynamic_environment(pic_state *pic)
{
pic_value alist, thunk, env, it, elt, val;
pic_value dyn_env;
int n;
pic_get_args(pic, "ol", &alist, &thunk);
n = pic_get_args(pic, "|o", &dyn_env);
env = pic_make_weak(pic);
pic_for_each(elt, alist, it) {
pic_weak_set(pic, env, pic_car(pic, elt), pic_cdr(pic, elt));
if (n == 0) {
return pic->dyn_env;
} else {
pic->dyn_env = dyn_env;
return pic_undef_value(pic);
}
pic->dyn_env = pic_cons(pic, env, pic->dyn_env);
val = pic_call(pic, thunk, 0);
pic->dyn_env = pic_cdr(pic, pic->dyn_env);
return val;
}
void
pic_init_var(pic_state *pic)
{
pic_defun(pic, "make-parameter", pic_var_make_parameter);
pic_defun(pic, "with-dynamic-environment", pic_var_with_dynamic_environment);
pic_defun(pic, "current-dynamic-environment", pic_var_current_dynamic_environment);
}

View File

@ -586,9 +586,16 @@
(lambda (form env)
(let ((formal (car (cdr form)))
(body (cdr (cdr form))))
`(,(the 'with-dynamic-environment)
(,(the 'list) ,@(map (lambda (x) `(,(the 'cons) ,(car x) ,(cadr x))) formal))
(,the-lambda () ,@body)))))
(let ((table (the 'table))
(prev (the 'prev))
(it (the 'it)))
`(,(the 'let) ((,table (,(the 'make-ephemeron-table)))
(,prev (,(the 'current-dynamic-environment))))
(,(the 'current-dynamic-environment) (,(the 'cons) ,table ,prev))
(,the-begin . ,formal)
(,(the 'let) ((,it (,the-begin . ,body)))
(,(the 'current-dynamic-environment) ,prev)
,it))))))
(define-transformer 'define-record-type
(lambda (form env)