suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

bytecode compiler: fix order of set! undefined checking

Browse Source 
Evaluate the right-hand side of the assignment first.
This commit is contained in:
Matthew Flatt 2018-08-22 06:40:57 -06:00
parent 974988fe3c
commit 53a08c065e
2 changed files with 66 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
pkgs/racket-test-core/tests/racket/letrec.rktl
View File

@ -179,4 +179,27 @@
0))
letrec-exn?)
(err/rt-test
(letrec ((x (set! x (/ 0)))) 'ok)
exn:fail:contract:divide-by-zero?)
(err/rt-test
(letrec ((x (set! x (values 1 0)))) 'ok)
exn:fail:contract:arity?)
(err/rt-test
(let ([indirect (lambda (f) (f))])
(letrec ((x (indirect (lambda () (set! x (+ 1 0)) x))))
'ok))
letrec-exn?)
(test 8
'ok
(let ([save #f])
(let ([indirect (lambda (f) (set! save f))]
[also-indirect (lambda () 8)])
(letrec ((x (indirect (lambda () (set! x (also-indirect)) x))))
'ok)
(save))))
(report-errs)

47
racket/src/racket/src/letrec_check.c
View File

@ -864,22 +864,61 @@ static Scheme_Object *letrec_check_set(Scheme_Object *o, Letrec_Check_Frame *fra
Scheme_App3_Rec *app3;
Scheme_Object *name;
Scheme_Sequence *seq;
Scheme_IR_Let_Header *head;
Scheme_IR_Let_Value *lv;
Scheme_IR_Local *var, **vars;
/* Change
(set! <id> <rhs>)
to
(let ([<tmp> <rhs>])
(begin
<check>
(set! <id> <tmp>)))
*/
name = record_checked((Scheme_IR_Local *)sb->var, frame);
app3 = MALLOC_ONE_TAGGED(Scheme_App3_Rec);
app3->iso.so.type = scheme_application3_type;
app3->rator = scheme_check_assign_not_undefined_proc;
app3->rand1 = sb->var;
app3->rand2 = name;
seq = scheme_malloc_sequence(2);
seq->so.type = scheme_sequence_type;
seq->count = 2;
seq->array[0] = (Scheme_Object *)app3;
seq->array[1] = (Scheme_Object *)sb;
return (Scheme_Object *)seq;
if (SCHEME_TYPE(sb->val) > _scheme_ir_values_types_) {
/* obviously simple enough to not need a `let` wrapper */
return (Scheme_Object *)seq;
} else {
var = scheme_make_ir_local(scheme_intern_symbol("tmp"));
vars = MALLOC_N(Scheme_IR_Local*, 1);
vars[0] = var;
var->use_count = 1;
lv = MALLOC_ONE_TAGGED(Scheme_IR_Let_Value);
lv->iso.so.type = scheme_ir_let_value_type;
lv->count = 1;
lv->value = sb->val;
lv->body = (Scheme_Object *)seq;
lv->vars = vars;
head = MALLOC_ONE_TAGGED(Scheme_IR_Let_Header);
head->iso.so.type = scheme_ir_let_header_type;
head->count = 1;
head->num_clauses = 1;
head->body = (Scheme_Object *)lv;
sb->val = (Scheme_Object *)var;
return (Scheme_Object *)head;
}
}
}