artemist/mes
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

core: eval_apply: Prepare for M2-Planet.

Browse source 
* src/eval-apply.c (eval_apply): Prepare for M2-Planet.
This commit is contained in:
Jan (janneke) Nieuwenhuizen 2020-07-16 21:10:27 +02:00
parent c2e80904ad
commit 5bae8803b2
No known key found for this signature in database
GPG key ID: F3C1A0D9C1D65273
1 changed files with 106 additions and 89 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

39
src/eval-apply.c
View file

@ -612,7 +612,8 @@ eval:
}
else
{
if (TYPE (R1) == TPAIR && (CAR (R1) == cell_symbol_define || CAR (R1) == cell_symbol_define_macro))
if (TYPE (R1) == TPAIR)
if (CAR (R1) == cell_symbol_define || CAR (R1) == cell_symbol_define_macro)
{
global_p = CAAR (R0) != cell_closure;
macro_p = CAR (R1) == cell_symbol_define_macro;
@ -728,12 +729,16 @@ macro_expand:
goto vm_return;
}
if (TYPE (R1) == TPAIR && (macro = get_macro (CAR (R1))) != cell_f)
if (TYPE (R1) == TPAIR)
{
macro = get_macro (CAR (R1));
if (macro != cell_f)
{
R1 = cons (macro, CDR (R1));
push_cc (R1, cell_nil, R0, cell_vm_macro_expand);
goto apply;
}
}
if (CAR (R1) == cell_symbol_define || CAR (R1) == cell_symbol_define_macro)
{
@ -762,12 +767,18 @@ macro_expand:
goto vm_return;
}
if (TYPE (R1) == TPAIR
&& TYPE (CAR (R1)) == TSYMBOL
&& CAR (R1) != cell_symbol_begin
&& ((macro = macro_get_handle (cell_symbol_portable_macro_expand)) != cell_f)
&& ((expanders = module_ref (R0, cell_symbol_sc_expander_alist)) != cell_undefined)
&& ((macro = assq (CAR (R1), expanders)) != cell_f))
if (TYPE (R1) == TPAIR)
{
if (TYPE (CAR (R1)) == TSYMBOL && CAR (R1) != cell_symbol_begin)
{
macro = macro_get_handle (cell_symbol_portable_macro_expand);
if (macro != cell_f)
{
expanders = module_ref (R0, cell_symbol_sc_expander_alist);
if (expanders != cell_undefined)
{
macro = assq (CAR (R1), expanders);
if (macro != cell_f)
{
sc_expand = module_ref (R0, cell_symbol_macro_expand);
R2 = R1;
@ -777,6 +788,10 @@ macro_expand:
goto apply;
}
}
}
}
}
}
push_cc (CAR (R1), R1, R0, cell_vm_macro_expand_car);
goto macro_expand;
@ -814,7 +829,8 @@ begin:
}
}
if (TYPE (R1) == TPAIR && TYPE (CAR (R1)) == TPAIR)
if (TYPE (R1) == TPAIR)
if (TYPE (CAR (R1)) == TPAIR)
{
if (CAAR (R1) == cell_symbol_begin)
R1 = append2 (CDAR (R1), CDR (R1));
@ -842,14 +858,15 @@ begin_expand:
if (TYPE (R1) == TPAIR)
{
if (TYPE (CAR (R1)) == TPAIR && CAAR (R1) == cell_symbol_begin)
if (TYPE (CAR (R1)) == TPAIR)
if (CAAR (R1) == cell_symbol_begin)
R1 = append2 (CDAR (R1), CDR (R1));
if (CAAR (R1) == cell_symbol_primitive_load)
{
push_cc (CADR (CAR (R1)), R1, R0, cell_vm_begin_expand_primitive_load);
goto eval;
begin_expand_primitive_load:
if (TYPE (R1) == TNUMBER && VALUE (R1) == 0)
if ((TYPE (R1) == TNUMBER) && VALUE (R1) == 0)
0;
else if (TYPE (R1) == TSTRING)
input = set_current_input_port (open_input_file (R1));