From 53a08c065e97d6f42a7c6f72ecac14f1e174da5f Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Wed, 22 Aug 2018 06:40:57 -0600
Subject: [PATCH] bytecode compiler: fix order of `set!` undefined checking

Evaluate the right-hand side of the assignment first.
---
 .../racket-test-core/tests/racket/letrec.rktl | 23 +++++++++
 racket/src/racket/src/letrec_check.c          | 47 +++++++++++++++++--
 2 files changed, 66 insertions(+), 4 deletions(-)

diff --git a/pkgs/racket-test-core/tests/racket/letrec.rktl b/pkgs/racket-test-core/tests/racket/letrec.rktl
index a00c49b983..75613d25b1 100644
--- a/pkgs/racket-test-core/tests/racket/letrec.rktl
+++ b/pkgs/racket-test-core/tests/racket/letrec.rktl
@@ -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)
diff --git a/racket/src/racket/src/letrec_check.c b/racket/src/racket/src/letrec_check.c
index 45657773de..d1d08a2544 100644
--- a/racket/src/racket/src/letrec_check.c
+++ b/racket/src/racket/src/letrec_check.c
@@ -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;
+      }
     }
   }