andrius
/
mes
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

core: Fix internal define bug. 

* src/eval-apply.c (eval_apply): When evaluating 'define', recompute
the 'global_p' and 'local_p' flags; when evaluating a local
definition, set the closure directly instead of using 'set_x'.
* tests/base.test: Add a test.
This commit is contained in:
Timothy Sample 2022-03-31 17:55:06 -06:00
parent aab9e925ac
commit 84a4169428
2 changed files with 25 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
src/eval-apply.c
View File

@ -688,6 +688,15 @@ eval:
goto eval;
}
eval_define:
/* These may have been clobbered by an inline define
during evaluation, so they must be recomputed. */
global_p = 0;
if (R0->car->car != cell_closure)
global_p = 1;
macro_p = 0;
if (R2->car == cell_symbol_define_macro)
macro_p = 1;
name = R2->cdr->car;
aa = R2->cdr->car;
if (aa->type == TPAIR)
@ -706,9 +715,13 @@ eval:
{
entry = cons (name, R1);
aa = cons (entry, cell_nil);
/* Push the definition onto the current lexical
environment, but keep the first element (named
'*closure*') pointing to the rest of the
environment. */
set_cdr_x (aa, cdr (R0));
set_cdr_x (R0, aa);
set_x (cell_closure, aa);
set_cdr_x (car (R0), aa);
}
R1 = cell_unspecified;
goto vm_return;

11
tests/base.test
View File

@ -94,6 +94,17 @@ exec ${MES-bin/mes} --no-auto-compile -L ${0%/*} -L module -C module -e '(tests
(let () (define *top-let-define-a* '*top-let-define-a*) #t)
(pass-if-not "top let define " (defined? '*top-let-define-a*))
(define (lookup-toplevel name)
(if guile?
(module-variable (current-module) name)
(hashq-ref (initial-module) name)))
(define (nested-define-value) (define x 12) x)
(define *top-nested-define* (nested-define-value))
(pass-if "top nested define"
(let ((v (lookup-toplevel '*top-nested-define*)))
(and v (equal? (variable-ref v) 12))))
(pass-if "apply" (sequal? (apply list '(1)) '(1)))
(pass-if "apply 2" (sequal? (apply list 1 '(2)) '(1 2)))
(pass-if "apply 3" (sequal? (apply list 1 2 '(3)) '(1 2 3)))