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

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7236
lib/ext/eval.c
View File

File diff suppressed because it is too large Load Diff

21
lib/var.c
View File

@ -67,25 +67,24 @@ pic_var_make_parameter(pic_state *pic)
} }
static pic_value 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); if (n == 0) {
pic_for_each(elt, alist, it) { return pic->dyn_env;
pic_weak_set(pic, env, pic_car(pic, elt), pic_cdr(pic, elt)); } 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 void
pic_init_var(pic_state *pic) pic_init_var(pic_state *pic)
{ {
pic_defun(pic, "make-parameter", pic_var_make_parameter); 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);
} }

13
piclib/eval.scm
View File

@ -586,9 +586,16 @@
(lambda (form env) (lambda (form env)
(let ((formal (car (cdr form))) (let ((formal (car (cdr form)))
(body (cdr (cdr form)))) (body (cdr (cdr form))))
`(,(the 'with-dynamic-environment) (let ((table (the 'table))
(,(the 'list) ,@(map (lambda (x) `(,(the 'cons) ,(car x) ,(cadr x))) formal)) (prev (the 'prev))
(,the-lambda () ,@body))))) (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 (define-transformer 'define-record-type
(lambda (form env) (lambda (form env)