370.3

svn: r6545

collects/mzlib/for.ss

@@ -27,7 +27,7 @@
            stop-after
            (rename *in-indexed in-indexed)
            
-           sequence-generator
+           sequence-generate
            
            define-sequence-syntax
            make-do-sequence
@@ -520,9 +520,9 @@
   ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   ;;  runnign sequences outside of a loop:
 
-  (define (sequence-generator g)
+  (define (sequence-generate g)
     (unless (sequence? g)
-      (raise-type-error 'sequence-generator "sequence" g))
+      (raise-type-error 'sequence-generate "sequence" g))
     (let-values ([(pos->val pos-next init pos-cont? pre-cont? post-cont?)
                   (make-sequence #f g)])
       (let ([pos init])

collects/tests/mzscheme/basic.ss

@@ -2015,9 +2015,18 @@
 	     h1))])
 
     (let ([check-tables-equal
-	   (lambda (mode t1 t2)
+	   (lambda (mode t1 t2 flag)
 	     (test #t equal? t1 t2)
-	     (test (equal-hash-code t1) equal-hash-code t2)
+             (test (equal-hash-code t1) equal-hash-code t2)
+	     (test #t equal? t1 (hash-table-copy t1))
+             (let ([again (apply make-hash-table 'equal flag)])
+               (let loop ([i (hash-table-iterate-first t1)])
+                 (when i
+                   (hash-table-put! again
+                                    (hash-table-iterate-key t1 i)
+                                    (hash-table-iterate-value t1 i))
+                   (loop (hash-table-iterate-next t1 i))))
+               (test #t equal? t1 again))
 	     (let ([meta-ht (make-hash-table 'equal)])
 	       (hash-table-put! meta-ht t1 mode)
 	       (test mode hash-table-get meta-ht t2 (lambda () #f)))
@@ -2025,10 +2034,12 @@
 
       (check-tables-equal 'the-norm-table
                           (check-hash-tables null #f)
-			  (check-hash-tables null #t))
+			  (check-hash-tables null #t)
+                          null)
       (check-tables-equal 'the-weak-table
                           (check-hash-tables (list 'weak) #f)
-			  (check-hash-tables (list 'weak) #t)))
+			  (check-hash-tables (list 'weak) #t)
+                           (list 'weak)))
 
     (save))) ; prevents gcing of the ht-registered values
 
@@ -2104,6 +2115,21 @@
 (test 2 hash-table-get (hash-table-copy #hasheq((1 . 2))) 1)
 (test (void) hash-table-put! (hash-table-copy #hasheq((1 . 2))) 3 4)
 
+(test #f hash-table-iterate-first (make-hash-table))
+(test #f hash-table-iterate-first (make-hash-table 'weak))
+(err/rt-test (hash-table-iterate-next (make-hash-table) 0))
+(err/rt-test (hash-table-iterate-next (make-hash-table 'weak) 0))
+
+(let ([check-all-bad
+       (lambda (op)
+         (err/rt-test (op #f 0))
+         (err/rt-test (op (make-hash-table) -1))
+         (err/rt-test (op (make-hash-table) (- (expt 2 100))))
+         (err/rt-test (op (make-hash-table) 1.0)))])
+  (check-all-bad hash-table-iterate-next)
+  (check-all-bad hash-table-iterate-key)
+  (check-all-bad hash-table-iterate-value))
+
 (arity-test make-hash-table 0 2)
 (arity-test make-immutable-hash-table 1 2)
 (arity-test hash-table-count 1 1)

collects/tests/mzscheme/optimize.ss

@@ -434,6 +434,59 @@
            '(let ([x (random)])
               x))
 
+(test-comp '(let-values ([(x y) (values 1 2)])
+              (+ x y))
+           3)
+
+(test-comp '(letrec ([x 3]
+                     [f (lambda (y) x)])
+              f)
+           '(letrec ([f (lambda (y) 3)])
+              f))
+
+(test-comp '(letrec ([x 3]
+                     [f (lambda (y) x)])
+              (f 10))
+           3)
+
+(test-comp '(letrec ([f (lambda (y) (f y))])
+              3)
+           3)
+
+(test-comp '(letrec ([len (lambda (l)
+                            (if (null? l)
+                                0
+                                (len (cdr l))))])
+              (len null))
+           0)
+
+(test-comp '(letrec ([foo (lambda ()
+                            (set! foo 10))])
+              0)
+           0)
+
+(test-comp '(letrec ([foo (lambda () 12)]
+                     [goo (lambda () foo)])
+              goo)
+           '(let* ([foo (lambda () 12)]
+                   [goo (lambda () foo)])
+              goo))
+
+(test-comp '(let* ([foo (lambda () 12)]
+                   [goo (lambda () foo)])
+              11)
+           11)
+
+(test-comp '(letrec ([foo (lambda () 12)]
+                     [goo (lambda () foo)])
+              11)
+           11)
+
+(test-comp '(letrec ([goo (lambda () foo)]
+                     [foo (lambda () goo)])
+              15)
+           15)
+
 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Check bytecode verification of lifted functions
 

collects/tests/mzscheme/sync.ss

@@ -872,17 +872,21 @@
 		(break-enabled #f))
 	      (init ;; init function gets to decide whether to do the normal body:
 	       (lambda ()
+           (printf "here ~s\n"  (procedure? capture-pre))
 		 (dynamic-wind
 		     (lambda ()
+           (printf "here3 ~s\n" (procedure? capture-pre))
 		       (capture-pre
 			reset
 			(lambda ()
+           (printf "here4\n")
 			  (set! did-pre1 #t)
 			  (semaphore-post p)
 			  (pre-thunk)
 			  (pre-semaphore-wait s)
 			  (set! did-pre2 #t))))
 		     (lambda () 
+           (printf "here2\n")
 		       (capture-act
 			reset
 			(lambda ()
@@ -930,6 +934,7 @@
       ;; create fresh semaphores
       (set! s (make-semaphore))
       (set! p (make-semaphore))
+      (printf "mk ~s\n" mk-t*)
       ;; create the thread
       (let ([t (mk-t* break-off?
 		      pre-thunk act-thunk post-thunk
@@ -1016,6 +1021,9 @@
 					      (body))])
 			      ;; Grab a continuation for the dyn-wind's pre/act/post
 			      (go (lambda args
+                                    (printf "here???\n")
+                                    (printf "??? ~s\n" k+reset)
+                                    (printf "??? ~s\n" capture)
 				    (apply mk-t 
 					   (lambda (f) (f))
 					   (if (eq? which 'pre) capture no-capture)

doc/release-notes/mzscheme/HISTORY

@@ -1,3 +1,6 @@
+Version 370.2
+Added hash-table-iterate-{first,next,key,value}
+
 Version 370.2
 Added make-sibling-inspector
 Added graph? argument to read[-syntax]/recursive

src/mzscheme/src/env.c

@@ -29,6 +29,7 @@
 
 #include "schpriv.h"
 #include "schminc.h"
+#include "schmach.h"
 #include "schexpobs.h"
 
 #if defined(UNIX_LIMIT_STACK) || defined(UNIX_LIMIT_FDSET_SIZE)
@@ -2650,6 +2651,8 @@ Optimize_Info *scheme_optimize_info_create()
   return info;
 }
 
+static void register_transitive_use(Optimize_Info *info, int pos, int j);
+
 static void register_stat_dist(Optimize_Info *info, int i, int j)
 {
   if (!info->stat_dists) {
@@ -2681,16 +2684,81 @@ static void register_stat_dist(Optimize_Info *info, int i, int j)
     info->sd_depths[i] = j + 1;
   }
 
+  if (info->transitive_use && info->transitive_use[i]) {
+    /* We're using a procedure that we weren't sure would be used.
+       Transitively mark everything that the procedure uses --- unless
+       a transitive accumulation is in effect, in which case we
+       don't for this one now, leaving it to be triggered when
+       the one we're accumulating is triggered. */
+    if (!info->transitive_use_pos) {
+      mzshort *map = info->transitive_use[i];
+      int len = info->transitive_use_len[i];
+      int k;
+
+      info->transitive_use[i] = NULL;
+
+      for (k = 0; k < len; k++) {
+        register_transitive_use(info, map[k], 0);
+      }
+    }
+  }
+
   info->stat_dists[i][j] = 1;
 }
 
+static Scheme_Object *transitive_k(void)
+{
+  Scheme_Thread *p = scheme_current_thread;
+  Optimize_Info *info = (Optimize_Info *)p->ku.k.p1;
+
+  p->ku.k.p1 = NULL;
+
+  register_transitive_use(info, p->ku.k.i1, p->ku.k.i2);
+
+  return scheme_false;
+}
+
+static void register_transitive_use(Optimize_Info *info, int pos, int j)
+{
+#ifdef DO_STACK_CHECK
+# include "mzstkchk.h"
+  {
+    Scheme_Thread *p = scheme_current_thread;
+
+    p->ku.k.p1 = (void *)info;
+    p->ku.k.i1 = pos;
+    p->ku.k.i2 = j;
+
+    scheme_handle_stack_overflow(transitive_k);
+
+    return;
+  }
+#endif
+
+  while (info) {
+    if (info->flags & SCHEME_LAMBDA_FRAME)
+      j++;
+    if (pos < info->new_frame)
+      break;
+    pos -= info->new_frame;
+    info = info->next;
+  }
+
+  if (info->sd_depths[pos] <= j) {
+    scheme_signal_error("bad transitive position depth: %d vs. %d",
+                        info->sd_depths[pos], j);
+  }
+
+  register_stat_dist(info, pos, j);
+}
+
 void scheme_env_make_closure_map(Optimize_Info *info, mzshort *_size, mzshort **_map)
 {
   /* A closure map lists the captured variables for a closure; the
      indices are resolved two new indicies in the second phase of
      compilation. */
   Optimize_Info *frame;
-  int i, j, pos = 0, lpos = 0;
+  int i, j, pos = 0, lpos = 0, tu;
   mzshort *map, size;
 
   /* Count vars used by this closure (skip args): */
@@ -2715,6 +2783,13 @@ void scheme_env_make_closure_map(Optimize_Info *info, mzshort *_size, mzshort **
   map = MALLOC_N_ATOMIC(mzshort, size);
   *_map = map;
 
+  if (info->next && info->next->transitive_use_pos) {
+    info->next->transitive_use[info->next->transitive_use_pos - 1] = map;
+    info->next->transitive_use_len[info->next->transitive_use_pos - 1] = size;
+    tu = 1;
+  } else
+    tu = 0;
+
   /* Build map, unmarking locals and marking deeper in parent frame */
   j = 1; pos = 0;
   for (frame = info->next; frame; frame = frame->next) {
@@ -2727,7 +2802,8 @@ void scheme_env_make_closure_map(Optimize_Info *info, mzshort *_size, mzshort **
 	  if (frame->stat_dists[i][j]) {
 	    map[pos++] = lpos;
 	    frame->stat_dists[i][j] = 0; /* This closure's done with these vars... */
-	    frame->stat_dists[i][j - 1] = 1; /* ... but ensure previous keeps */
+            if (!tu)
+              frame->stat_dists[i][j - 1] = 1; /* ... but ensure previous keeps */
 	  }
 	}
 	lpos++;
@@ -2829,6 +2905,34 @@ int scheme_optimize_is_used(Optimize_Info *info, int pos)
   return 0;
 }
 
+int scheme_optimize_any_uses(Optimize_Info *info, int start_pos, int end_pos)
+{
+  int j, i;
+
+  if (info->stat_dists) {
+    for (i = start_pos; i < end_pos; i++) {
+      for (j = info->sd_depths[i]; j--; ) {
+        if (info->stat_dists[i][j])
+          return 1;
+      }
+    }
+  }
+
+  if (info->transitive_use) {
+    for (i = info->new_frame; i--; ) {
+      if (info->transitive_use[i]) {
+        for (j = info->transitive_use_len[i]; j--; ) {
+          if ((info->transitive_use[i][j] >= start_pos)
+              && (info->transitive_use[i][j] < end_pos))
+            return 1;
+        }
+      }
+    }
+  }
+
+  return 0;
+}
+
 static Scheme_Object *do_optimize_info_lookup(Optimize_Info *info, int pos, int j, int *closure_offset)
 {
   Scheme_Object *p, *n;

src/mzscheme/src/list.c

@@ -94,6 +94,10 @@ static Scheme_Object *hash_table_get(int argc, Scheme_Object *argv[]);
 static Scheme_Object *hash_table_remove(int argc, Scheme_Object *argv[]);
 static Scheme_Object *hash_table_map(int argc, Scheme_Object *argv[]);
 static Scheme_Object *hash_table_for_each(int argc, Scheme_Object *argv[]);
+static Scheme_Object *hash_table_iterate_start(int argc, Scheme_Object *argv[]);
+static Scheme_Object *hash_table_iterate_next(int argc, Scheme_Object *argv[]);
+static Scheme_Object *hash_table_iterate_value(int argc, Scheme_Object *argv[]);
+static Scheme_Object *hash_table_iterate_key(int argc, Scheme_Object *argv[]);
 static Scheme_Object *eq_hash_code(int argc, Scheme_Object *argv[]);
 static Scheme_Object *equal_hash_code(int argc, Scheme_Object *argv[]);
 
@@ -465,6 +469,27 @@ scheme_init_list (Scheme_Env *env)
 						    2, 2),
 			     env);
 
+  scheme_add_global_constant("hash-table-iterate-first",
+			     scheme_make_noncm_prim(hash_table_iterate_start,
+						    "hash-table-iterate-first",
+                                                    1, 1),
+			     env);
+  scheme_add_global_constant("hash-table-iterate-next",
+			     scheme_make_noncm_prim(hash_table_iterate_next,
+						    "hash-table-iterate-next",
+                                                    2, 2),
+			     env);
+  scheme_add_global_constant("hash-table-iterate-value",
+			     scheme_make_noncm_prim(hash_table_iterate_value,
+						    "hash-table-iterate-value",
+                                                    2, 2),
+			     env);
+  scheme_add_global_constant("hash-table-iterate-key",
+			     scheme_make_noncm_prim(hash_table_iterate_key,
+						    "hash-table-iterate-key",
+                                                    2, 2),
+			     env);
+
   scheme_add_global_constant("eq-hash-code",
 			     scheme_make_noncm_prim(eq_hash_code,
 						    "eq-hash-code",
@@ -1701,6 +1726,167 @@ static Scheme_Object *hash_table_for_each(int argc, Scheme_Object *argv[])
   return do_map_hash_table(argc, argv, "hash-table-for-each", 0);
 }
 
+static Scheme_Object *hash_table_next(const char *name, int start, int argc, Scheme_Object *argv[])
+{
+  if (SCHEME_HASHTP(argv[0])) {
+    Scheme_Hash_Table *hash;
+    int i, sz;
+
+    hash = (Scheme_Hash_Table *)argv[0];
+
+    sz = hash->size;
+    if (start >= 0) {
+      if ((start >= sz) || !hash->vals[start])
+        return NULL;
+    }
+    for (i = start + 1; i < sz; i++) {
+      if (hash->vals[i])
+        return scheme_make_integer(i);
+    }
+
+    return scheme_false;
+  } else if (SCHEME_BUCKTP(argv[0])) {
+    Scheme_Bucket_Table *hash;
+    Scheme_Bucket *bucket;
+    int i, sz;
+
+    hash = (Scheme_Bucket_Table *)argv[0];
+
+    sz = hash->size;
+    
+    if (start >= 0) {
+      bucket = ((start < sz) ? hash->buckets[start] : NULL);
+      if (!bucket || !bucket->val || !bucket->key) 
+        return NULL;      
+    }
+    for (i = start + 1; i < sz; i++) {
+      bucket = hash->buckets[i];
+      if (bucket && bucket->val && bucket->key) {
+        return scheme_make_integer(i);
+      }
+    }
+
+    return scheme_false;
+  } else {
+    scheme_wrong_type(name, "hash table", 0, argc, argv);
+    return NULL;
+  }
+}
+
+static Scheme_Object *hash_table_iterate_start(int argc, Scheme_Object *argv[])
+{
+  return hash_table_next("hash-table-iterate-first", -1, argc, argv);
+}
+
+static Scheme_Object *hash_table_iterate_next(int argc, Scheme_Object *argv[])
+{
+  Scheme_Object *p = argv[1], *v;
+  int pos;
+
+  if (SCHEME_INTP(p)) {
+    pos = SCHEME_INT_VAL(p);
+    if (pos < 0)
+      pos = 0x7FFFFFFE;
+  } else {
+    pos = 0x7FFFFFFE;
+  }
+
+  v = hash_table_next("hash-table-iterate-next", pos, argc, argv);
+
+  if (v)
+    return v;
+
+  if (SCHEME_INTP(p)) {
+    if (SCHEME_INT_VAL(p) >= 0)
+      p = NULL;
+  } else if (SCHEME_BIGNUMP(p)) {
+    if (SCHEME_BIGPOS(p))
+      p = NULL;
+  }
+
+  if (p)
+    scheme_wrong_type("hash-table-iterate-next", "exact non-negative integer", 1, argc, argv);  
+
+  scheme_arg_mismatch("hash-table-iterate-next", "no element at index: ", argv[1]);
+
+  return NULL;
+}
+
+static Scheme_Object *hash_table_index(const char *name, int argc, Scheme_Object *argv[], int get_val)
+{
+  Scheme_Object *p = argv[1];
+  int pos, sz;
+
+  if (SCHEME_INTP(p)) {
+    pos = SCHEME_INT_VAL(p);
+    if (pos < 0)
+      pos = 0x7FFFFFFF;
+  } else {
+    pos = 0x7FFFFFFF;
+  }
+
+  if (SCHEME_HASHTP(argv[0])) {
+    Scheme_Hash_Table *hash;
+
+    hash = (Scheme_Hash_Table *)argv[0];
+
+    sz = hash->size;
+    if (pos < sz) {
+      if (hash->vals[pos]) {
+        if (get_val)
+          return hash->vals[pos];
+        else
+          return hash->keys[pos];
+      }
+    }
+  } else if (SCHEME_BUCKTP(argv[0])) {
+    Scheme_Bucket_Table *hash;
+    int sz;
+    Scheme_Bucket *bucket;
+
+    hash = (Scheme_Bucket_Table *)argv[0];
+
+    sz = hash->size;
+    if (pos < sz) {
+      bucket = hash->buckets[pos];
+      if (bucket && bucket->val && bucket->key) {
+        if (get_val)
+          return (Scheme_Object *)bucket->val;
+        else {
+          if (hash->weak)
+            return (Scheme_Object *)HT_EXTRACT_WEAK(bucket->key);
+          else
+            return (Scheme_Object *)bucket->key;
+        }
+      }
+    }
+  } else {
+    scheme_wrong_type(name, "hash table", 0, argc, argv);
+    return NULL;
+  }
+
+  if ((SCHEME_INTP(p)
+       && (SCHEME_INT_VAL(p) >= 0))
+      || (SCHEME_BIGNUMP(p)
+          && SCHEME_BIGPOS(p))) {
+    scheme_arg_mismatch(name, "no element at index: ", p);
+    return NULL;
+  }
+
+  scheme_wrong_type(name, "exact non-negative integer", 1, argc, argv);  
+  return NULL;
+}
+
+static Scheme_Object *hash_table_iterate_value(int argc, Scheme_Object *argv[])
+{
+  return hash_table_index("hash-table-iterate-value", argc, argv, 1);
+}
+
+static Scheme_Object *hash_table_iterate_key(int argc, Scheme_Object *argv[])
+{
+  return hash_table_index("hash-table-iterate-key", argc, argv, 0);
+}
+
 static Scheme_Object *eq_hash_code(int argc, Scheme_Object *argv[])
 {
   long v;

src/mzscheme/src/mzmark.c

@@ -2688,6 +2688,8 @@ static int mark_optimize_info_MARK(void *p) {
   gcMARK(i->use);
   gcMARK(i->consts);
   gcMARK(i->top_level_consts);
+  gcMARK(i->transitive_use);
+  gcMARK(i->transitive_use_len);
 
   return
   gcBYTES_TO_WORDS(sizeof(Optimize_Info));
@@ -2702,6 +2704,8 @@ static int mark_optimize_info_FIXUP(void *p) {
   gcFIXUP(i->use);
   gcFIXUP(i->consts);
   gcFIXUP(i->top_level_consts);
+  gcFIXUP(i->transitive_use);
+  gcFIXUP(i->transitive_use_len);
 
   return
   gcBYTES_TO_WORDS(sizeof(Optimize_Info));

src/mzscheme/src/mzmarksrc.c

@@ -1075,6 +1075,8 @@ mark_optimize_info {
   gcMARK(i->use);
   gcMARK(i->consts);
   gcMARK(i->top_level_consts);
+  gcMARK(i->transitive_use);
+  gcMARK(i->transitive_use_len);
 
  size:
   gcBYTES_TO_WORDS(sizeof(Optimize_Info));

src/mzscheme/src/schminc.h

@@ -13,7 +13,7 @@
 
 #define USE_COMPILED_STARTUP 1
 
-#define EXPECTED_PRIM_COUNT 898
+#define EXPECTED_PRIM_COUNT 902
 
 #ifdef MZSCHEME_SOMETHING_OMITTED
 # undef USE_COMPILED_STARTUP

src/mzscheme/src/schpriv.h

@@ -1744,6 +1744,10 @@ typedef struct Optimize_Info
   int *sd_depths;
   int used_toplevel;
   char *use;
+
+  int transitive_use_pos; /* set to pos + 1 when optimizing a letrec-bound procedure */
+  mzshort **transitive_use;
+  int *transitive_use_len;
 } Optimize_Info;
 
 typedef struct Scheme_Object *(*Scheme_Syntax_Optimizer)(Scheme_Object *data, Optimize_Info *info);
@@ -1991,6 +1995,7 @@ void scheme_optimize_info_used_top(Optimize_Info *info);
 void scheme_optimize_mutated(Optimize_Info *info, int pos);
 Scheme_Object *scheme_optimize_reverse(Optimize_Info *info, int pos, int unless_mutated);
 int scheme_optimize_is_used(Optimize_Info *info, int pos);
+int scheme_optimize_any_uses(Optimize_Info *info, int start_pos, int end_pos);
 
 Scheme_Object *scheme_optimize_clone(int dup_ok, Scheme_Object *obj, Optimize_Info *info, int delta, int closure_depth);
 Scheme_Object *scheme_optimize_shift(Scheme_Object *obj, int delta, int after_depth);

src/mzscheme/src/schvers.h

@@ -9,6 +9,6 @@
 
 
 #define MZSCHEME_VERSION_MAJOR 370
-#define MZSCHEME_VERSION_MINOR 2
+#define MZSCHEME_VERSION_MINOR 3
 
-#define MZSCHEME_VERSION "370.2" _MZ_SPECIAL_TAG
+#define MZSCHEME_VERSION "370.3" _MZ_SPECIAL_TAG

src/mzscheme/src/syntax.c

@@ -2559,6 +2559,42 @@ int scheme_compiled_propagate_ok(Scheme_Object *value, Optimize_Info *info)
   return 0;
 }
 
+static int is_values_apply(Scheme_Object *e)
+{
+  if (SAME_TYPE(SCHEME_TYPE(e), scheme_application_type)) {
+    Scheme_App_Rec *app = (Scheme_App_Rec *)e;
+    return SAME_OBJ(scheme_values_func, app->args[0]);
+  } else if (SAME_TYPE(SCHEME_TYPE(e), scheme_application2_type)) {
+    Scheme_App2_Rec *app = (Scheme_App2_Rec *)e;
+    return SAME_OBJ(scheme_values_func, app->rator);
+  } else if (SAME_TYPE(SCHEME_TYPE(e), scheme_application3_type)) {
+    Scheme_App3_Rec *app = (Scheme_App3_Rec *)e;
+    return SAME_OBJ(scheme_values_func, app->rator);
+  }
+
+  return 0;
+}
+
+static void unpack_values_application(Scheme_Object *e, Scheme_Compiled_Let_Value *naya)
+{
+  if (SAME_TYPE(SCHEME_TYPE(e), scheme_application_type)) {
+    Scheme_App_Rec *app = (Scheme_App_Rec *)e;
+    int i;
+    for (i = 0; i < app->num_args; i++) {
+      naya->value = app->args[i + 1];
+      naya = (Scheme_Compiled_Let_Value *)naya->body;
+    }
+  } else if (SAME_TYPE(SCHEME_TYPE(e), scheme_application2_type)) {
+    Scheme_App2_Rec *app = (Scheme_App2_Rec *)e;
+    naya->value = app->rand;
+  } else if (SAME_TYPE(SCHEME_TYPE(e), scheme_application3_type)) {
+    Scheme_App3_Rec *app = (Scheme_App3_Rec *)e;
+    naya->value = app->rand1;
+    naya = (Scheme_Compiled_Let_Value *)naya->body;
+    naya->value = app->rand2;
+  }
+}
+
 static Scheme_Object *make_clones(Scheme_Compiled_Let_Value *retry_start,
                                   Scheme_Compiled_Let_Value *pre_body,
                                   Optimize_Info *body_info)
@@ -2597,6 +2633,7 @@ static int set_code_flags(Scheme_Compiled_Let_Value *retry_start,
   Scheme_Compiled_Let_Value *clv;
   Scheme_Object *value, *first;
   int flags = CLOS_SINGLE_RESULT | CLOS_PRESERVES_MARKS;
+  Scheme_Closure_Data *data;
 
   /* The first in a clone pair is the one that is consulted for
      references. The second one is the clone, and its the one whose
@@ -2606,16 +2643,21 @@ static int set_code_flags(Scheme_Compiled_Let_Value *retry_start,
   clv = retry_start;
   while (clones) {
     value = retry_start->value;
-    first = SCHEME_CAR(clones);
+
-    if (SAME_OBJ(value, SCHEME_CAR(first))) {
+    if (SAME_TYPE(scheme_compiled_unclosed_procedure_type, SCHEME_TYPE(value))) {
-      Scheme_Closure_Data *data;
+      data = (Scheme_Closure_Data *)value;
-      data = (Scheme_Closure_Data *)SCHEME_CDR(first);
       flags = (flags & SCHEME_CLOSURE_DATA_FLAGS(data));
+
+      first = SCHEME_CAR(clones);
+
+      data = (Scheme_Closure_Data *)SCHEME_CDR(first);
       SCHEME_CLOSURE_DATA_FLAGS(data) = set_flags | (SCHEME_CLOSURE_DATA_FLAGS(data) & mask_flags);
       data = (Scheme_Closure_Data *)SCHEME_CAR(first);
       SCHEME_CLOSURE_DATA_FLAGS(data) = set_flags | (SCHEME_CLOSURE_DATA_FLAGS(data) & mask_flags);
+
       clones = SCHEME_CDR(clones);
     }
+
     if (clv == pre_body)
       break;
     clv = (Scheme_Compiled_Let_Value *)clv->body;
@@ -2629,9 +2671,9 @@ scheme_optimize_lets(Scheme_Object *form, Optimize_Info *info, int for_inline)
 {
   Optimize_Info *body_info, *rhs_info;
   Scheme_Let_Header *head = (Scheme_Let_Header *)form;
-  Scheme_Compiled_Let_Value *clv, *pre_body, *retry_start;
+  Scheme_Compiled_Let_Value *clv, *pre_body, *retry_start, *prev_body;
   Scheme_Object *body, *value;
-  int i, j, pos, is_rec, all_simple = 1;
+  int i, j, pos, is_rec, not_simply_let_star = 0;
   int size_before_opt, did_set_value;
 
   /* Special case: (let ([x E]) x) where E is lambda, case-lambda, or
@@ -2671,8 +2713,6 @@ scheme_optimize_lets(Scheme_Object *form, Optimize_Info *info, int for_inline)
     rhs_info = body_info;
 
   is_rec = (SCHEME_LET_FLAGS(head) & SCHEME_LET_RECURSIVE);
-  if (is_rec)
-    all_simple = 0;
 
   body = head->body;
   pos = 0;
@@ -2681,13 +2721,13 @@ scheme_optimize_lets(Scheme_Object *form, Optimize_Info *info, int for_inline)
     for (j = pre_body->count; j--; ) {
       if (pre_body->flags[j] & SCHEME_WAS_SET_BANGED) {
 	scheme_optimize_mutated(body_info, pos + j);
-	all_simple = 0;
       }
     }
     pos += pre_body->count;
     body = pre_body->body;
   }
 
+  prev_body = NULL;
   body = head->body;
   pre_body = NULL;
   retry_start = NULL;
@@ -2696,21 +2736,75 @@ scheme_optimize_lets(Scheme_Object *form, Optimize_Info *info, int for_inline)
   for (i = head->num_clauses; i--; ) {
     pre_body = (Scheme_Compiled_Let_Value *)body;
 
-    if (!retry_start)
-      retry_start = pre_body;
-
     size_before_opt = body_info->size;
 
-    value = scheme_optimize_expr(pre_body->value, rhs_info);
+    if ((pre_body->count == 1)
+        && SAME_TYPE(scheme_compiled_unclosed_procedure_type, SCHEME_TYPE(pre_body->value))
+        && !scheme_optimize_is_used(body_info, pos)) {
+      if (!body_info->transitive_use) {
+        mzshort **tu;
+        int *tu_len;
+        tu = (mzshort **)scheme_malloc(sizeof(mzshort *) * head->count);
+        tu_len = (int *)scheme_malloc_atomic(sizeof(int) * head->count);        
+        memset(tu_len, 0, sizeof(int) * head->count);
+        body_info->transitive_use = tu;
+        body_info->transitive_use_len = tu_len;
+      }
+      body_info->transitive_use_pos = pos + 1;
+    }
 
+    value = scheme_optimize_expr(pre_body->value, rhs_info);
     pre_body->value = value;
 
+    body_info->transitive_use_pos = 0;
+
+    if (is_rec && !not_simply_let_star) {
+      /* Keep track of whether we can simplify to let*: */
+      if (scheme_optimize_any_uses(rhs_info, pos, head->count))
+        not_simply_let_star = 1;
+    }
+
+    /* Change (let-values ([(id ...) (values e ...)]) body)
+       to (let-values ([id e] ...) body) for simple e. */
+    if ((pre_body->count != 1)
+        && is_values_apply(value)
+        && scheme_omittable_expr(value, pre_body->count)) {
+      Scheme_Compiled_Let_Value *naya;
+      Scheme_Object *rest = pre_body->body;
+      int *new_flags;
+      int cnt = pre_body->count;
+
+      while (cnt--) {
+        naya = MALLOC_ONE_TAGGED(Scheme_Compiled_Let_Value);
+        naya->so.type = scheme_compiled_let_value_type;
+        naya->body = rest;
+        naya->count = 1;
+        naya->position = pre_body->position + cnt;
+        new_flags = (int *)scheme_malloc_atomic(sizeof(int));
+        new_flags[0] = pre_body->flags[cnt];
+        naya->flags = new_flags;
+        rest = (Scheme_Object *)naya;
+      }
+
+      naya = (Scheme_Compiled_Let_Value *)rest;
+      unpack_values_application(value, naya);
+      if (prev_body)
+        prev_body->body = (Scheme_Object *)naya;
+      else
+        head->body = (Scheme_Object *)naya;
+      head->num_clauses += (pre_body->count - 1);
+      i += (pre_body->count - 1);
+      pre_body = naya;
+      body = (Scheme_Object *)naya;
+      value = pre_body->value;
+    }
+  
     if ((pre_body->count == 1)
 	&& !(pre_body->flags[0] & SCHEME_WAS_SET_BANGED)) {
 
       if (SAME_TYPE(SCHEME_TYPE(value), scheme_local_type)) {
 	/* Don't optimize reference to a local binding
-	   that's not available yet, or that mutable. */
+	   that's not available yet, or that's mutable. */
 	int vpos;
 	vpos = SCHEME_LOCAL_POS(value);
 	if ((vpos < head->count) && (vpos >= pos))
@@ -2729,6 +2823,9 @@ scheme_optimize_lets(Scheme_Object *form, Optimize_Info *info, int for_inline)
       }
     }
 
+    if (!retry_start)
+      retry_start = pre_body;
+
     /* Re-optimize to inline letrec bindings? */
     if (is_rec
 	&& !body_info->letrec_not_twice
@@ -2761,6 +2858,13 @@ scheme_optimize_lets(Scheme_Object *form, Optimize_Info *info, int for_inline)
 	    Scheme_Object *self_value;
             int sz;
 
+            if ((clv->count == 1)
+                && body_info->transitive_use
+                && !scheme_optimize_is_used(body_info, clv->position)) {
+              body_info->transitive_use[clv->position] = NULL;
+              body_info->transitive_use_pos = clv->position + 1;
+            }
+
             cl = SCHEME_CDR(cl);
 	    self_value = SCHEME_CDR(cl_first);
 
@@ -2779,6 +2883,12 @@ scheme_optimize_lets(Scheme_Object *form, Optimize_Info *info, int for_inline)
             body_info->letrec_not_twice = 0;
             
             clv->value = value;
+
+            if (!(clv->flags[0] & SCHEME_WAS_SET_BANGED)) {
+              scheme_optimize_propagate(body_info, clv->position, value);
+            }
+
+            body_info->transitive_use_pos = 0;
 	  }
 	  if (clv == pre_body)
 	    break;
@@ -2796,6 +2906,7 @@ scheme_optimize_lets(Scheme_Object *form, Optimize_Info *info, int for_inline)
     }
 
     pos += pre_body->count;
+    prev_body = pre_body;
     body = pre_body->body;
     info->size += 1;
   }
@@ -2812,37 +2923,41 @@ scheme_optimize_lets(Scheme_Object *form, Optimize_Info *info, int for_inline)
   info->preserves_marks = body_info->preserves_marks;
 
   /* Clear used flags where possible */
-  if (all_simple) {    
+  body = head->body;
-    body = head->body;
+  pos = 0;
-    pos = 0;
+  for (i = head->num_clauses; i--; ) {
-    for (i = head->num_clauses; i--; ) {
+    int used = 0, j;
-      int used = 0, j;
+    pre_body = (Scheme_Compiled_Let_Value *)body;
-      pre_body = (Scheme_Compiled_Let_Value *)body;
+    for (j = pre_body->count; j--; ) {
-      for (j = pre_body->count; j--; ) {
+      if (scheme_optimize_is_used(body_info, pos+j)) {
-        if (scheme_optimize_is_used(body_info, pos+j)) {
+        used = 1;
-          used = 1;
+        break;
-          break;
-        }
       }
-      if (!used
-	  && scheme_omittable_expr(pre_body->value, pre_body->count)) {
-        for (j = pre_body->count; j--; ) {
-          if (pre_body->flags[j] & SCHEME_WAS_USED) {
-            pre_body->flags[j] -= SCHEME_WAS_USED;
-          }
-        }
-      } else {
-        for (j = pre_body->count; j--; ) {
-          pre_body->flags[j] |= SCHEME_WAS_USED;
-        }
-      }
-      pos += pre_body->count;
-      body = pre_body->body;
     }
+    if (!used
+        && scheme_omittable_expr(pre_body->value, pre_body->count)) {
+      for (j = pre_body->count; j--; ) {
+        if (pre_body->flags[j] & SCHEME_WAS_USED) {
+          pre_body->flags[j] -= SCHEME_WAS_USED;
+        }
+      }
+    } else {
+      for (j = pre_body->count; j--; ) {
+        pre_body->flags[j] |= SCHEME_WAS_USED;
+      }
+    }
+    pos += pre_body->count;
+    body = pre_body->body;
   }
 
   scheme_optimize_info_done(body_info);
 
+  if (is_rec && !not_simply_let_star) {
+    /* We can simplify letrec to let* */
+    SCHEME_LET_FLAGS(head) -= SCHEME_LET_RECURSIVE;
+    SCHEME_LET_FLAGS(head) |= SCHEME_LET_STAR;
+  }
+
   return form;
 }
 
@@ -2974,7 +3089,7 @@ scheme_resolve_lets(Scheme_Object *form, Resolve_Info *info)
   int i, pos, opos, rpos, recbox, num_rec_procs = 0, extra_alloc;
   int rec_proc_nonapply = 0;
   int max_let_depth = 0;
-  int resolve_phase;
+  int resolve_phase, num_skips;
   Scheme_Object **lifted_recs;
 
   /* Find body: */
@@ -2992,35 +3107,44 @@ scheme_resolve_lets(Scheme_Object *form, Resolve_Info *info)
     for (i = head->num_clauses; i--; clv = (Scheme_Compiled_Let_Value *)clv->body) {
       int is_proc, is_lift;
 
-      is_proc = scheme_is_compiled_procedure(clv->value, 1, 1);
+      if ((clv->count == 1) 
-      if (is_proc)
+          && !(clv->flags[0] & SCHEME_WAS_USED)) {
-	is_lift = 0;
+        /* skip */
-      else
-	is_lift = is_liftable(clv->value, head->count, 5);
-      
-      if (!is_proc && !is_lift) {
-	recbox = 1;
-	break;
       } else {
-	if (!is_lift) {
+        if (clv->count == 1) 
-	  /* is_proc must be true ... */
+          is_proc = scheme_is_compiled_procedure(clv->value, 1, 1);
-	  int j;
+        else
+          is_proc = 0;
 
-	  for (j = 0; j < clv->count; j++) {
+        if (is_proc)
-	    if (clv->flags[j] & SCHEME_WAS_SET_BANGED) {
+          is_lift = 0;
-	      recbox = 1;
+        else
-	      break;
+          is_lift = is_liftable(clv->value, head->count, 5);
-	    }
-	  }
-	  if (recbox)
-	    break;
       
-	  if (scheme_is_compiled_procedure(clv->value, 0, 0)) {
+        if (!is_proc && !is_lift) {
-	    num_rec_procs++;
+          recbox = 1;
-            if (!(clv->flags[0] & SCHEME_WAS_ONLY_APPLIED))
+          break;
-              rec_proc_nonapply = 1;
+        } else {
+          if (!is_lift) {
+            /* is_proc must be true ... */
+            int j;
+
+            for (j = 0; j < clv->count; j++) {
+              if (clv->flags[j] & SCHEME_WAS_SET_BANGED) {
+                recbox = 1;
+                break;
+              }
+            }
+            if (recbox)
+              break;
+
+            if (scheme_is_compiled_procedure(clv->value, 0, 0)) {
+              num_rec_procs++;
+              if (!(clv->flags[0] & SCHEME_WAS_ONLY_APPLIED))
+                rec_proc_nonapply = 1;
+            }
           }
-	}
+        }
       }
     }
 
@@ -3084,11 +3208,15 @@ scheme_resolve_lets(Scheme_Object *form, Resolve_Info *info)
 	}
         lifts_frame_size = frame_size;
 
-        if ((clv->flags[0] & SCHEME_WAS_ONLY_APPLIED)
+        if (skips[i]) {
-            && SAME_TYPE(SCHEME_TYPE(clv->value), scheme_compiled_unclosed_procedure_type))
+          le = scheme_void;
-          le = scheme_resolve_closure_compilation(clv->value, linfo, 1, 1, 0, NULL);
+        } else {
-        else
+          if ((clv->flags[0] & SCHEME_WAS_ONLY_APPLIED)
-          le = scheme_resolve_expr(clv->value, linfo);
+              && SAME_TYPE(SCHEME_TYPE(clv->value), scheme_compiled_unclosed_procedure_type))
+            le = scheme_resolve_closure_compilation(clv->value, linfo, 1, 1, 0, NULL);
+          else
+            le = scheme_resolve_expr(clv->value, linfo);
+        }
 
         if (max_let_depth < linfo->max_let_depth + frame_size)
           max_let_depth = linfo->max_let_depth + frame_size;
@@ -3189,6 +3317,13 @@ scheme_resolve_lets(Scheme_Object *form, Resolve_Info *info)
     }
   }
 
+  num_skips = 0;
+  clv = (Scheme_Compiled_Let_Value *)head->body;
+  for (i = head->num_clauses; i--; clv = (Scheme_Compiled_Let_Value *)clv->body) {
+    if ((clv->count == 1) && !(clv->flags[0] & SCHEME_WAS_USED))
+      num_skips++;
+  }
+
   /* First assume that all letrec-bound procedures can be lifted to empty closures.
      Then try assuming that all letrec-bound procedures can be at least lifted.
      Then fall back to assuming no lifts. */
@@ -3201,10 +3336,10 @@ scheme_resolve_lets(Scheme_Object *form, Resolve_Info *info)
       resolve_phase = 2;
 
     if (resolve_phase < 2) {
-      linfo = scheme_resolve_info_extend(info, head->count - num_rec_procs, head->count, head->count);
+      linfo = scheme_resolve_info_extend(info, head->count - num_rec_procs - num_skips, head->count, head->count);
       lifted_recs = MALLOC_N(Scheme_Object *, num_rec_procs);
     } else {
-      linfo = scheme_resolve_info_extend(info, head->count, head->count, head->count);
+      linfo = scheme_resolve_info_extend(info, head->count - num_skips, head->count, head->count);
       lifted_recs = NULL;
     }
 
@@ -3218,38 +3353,46 @@ scheme_resolve_lets(Scheme_Object *form, Resolve_Info *info)
     for (i = head->num_clauses; i--; clv = (Scheme_Compiled_Let_Value *)clv->body) {
       int j;
 
-      for (j = 0; j < clv->count; j++) {
+      if ((clv->count == 1) && !(clv->flags[0] & SCHEME_WAS_USED)) {
-        int p, skip;
+        /* skipped */
-        Scheme_Object *lift;
+        scheme_resolve_info_add_mapping(linfo, opos, 0, 0, NULL);
-
-        skip = 0;
-        if (num_rec_procs && scheme_is_compiled_procedure(clv->value, 0, 0)) {
-          if (resolve_phase == 0) {
-            lift = scheme_resolve_generate_stub_closure();
-            lifted_recs[rpos] = lift;
-            p = 0;
-          } else if (resolve_phase == 1) {
-            lift = scheme_resolve_generate_stub_lift();
-            lifted_recs[rpos] = lift;
-            p = 0;
-          } else {
-            lift = NULL;
-            p = rpos;
-          }
-          rpos++;
-        } else {
-          p = pos++;
-          lift = NULL;
-        }
-      
-        scheme_resolve_info_add_mapping(linfo, opos, p,
-                                        ((recbox 
-                                          || (clv->flags[j] & SCHEME_WAS_SET_BANGED))
-                                         ? SCHEME_INFO_BOXED
-                                         : 0),
-                                        lift);
-
         opos++;
+      } else {
+        for (j = 0; j < clv->count; j++) {
+          int p, skip;
+          Scheme_Object *lift;
+
+          skip = 0;
+          if (num_rec_procs 
+              && (clv->count == 1)
+              && scheme_is_compiled_procedure(clv->value, 0, 0)) {
+            if (resolve_phase == 0) {
+              lift = scheme_resolve_generate_stub_closure();
+              lifted_recs[rpos] = lift;
+              p = 0;
+            } else if (resolve_phase == 1) {
+              lift = scheme_resolve_generate_stub_lift();
+              lifted_recs[rpos] = lift;
+              p = 0;
+            } else {
+              lift = NULL;
+              p = rpos;
+            }
+            rpos++;
+          } else {
+            p = pos++;
+            lift = NULL;
+          }
+      
+          scheme_resolve_info_add_mapping(linfo, opos, p,
+                                          ((recbox 
+                                            || (clv->flags[j] & SCHEME_WAS_SET_BANGED))
+                                           ? SCHEME_INFO_BOXED
+                                           : 0),
+                                          lift);
+
+          opos++;
+        }
       }
     }
 
@@ -3265,7 +3408,10 @@ scheme_resolve_lets(Scheme_Object *form, Resolve_Info *info)
         rpos = 0; opos = 0;
         converted = 0;
         for (i = head->num_clauses; i--; clv = (Scheme_Compiled_Let_Value *)clv->body) {
-          if (scheme_is_compiled_procedure(clv->value, 0, 0)) {
+          if ((clv->count == 1) && !(clv->flags[0] & SCHEME_WAS_USED)) {
+            /* skipped */
+          } else if ((clv->count == 1)
+                     && scheme_is_compiled_procedure(clv->value, 0, 0)) {
             Scheme_Object *lift, *old_lift;
             int old_convert_count;
 
@@ -3310,7 +3456,9 @@ scheme_resolve_lets(Scheme_Object *form, Resolve_Info *info)
         clv = (Scheme_Compiled_Let_Value *)head->body;
         rpos = 0; opos = 0;
         for (i = head->num_clauses; i--; clv = (Scheme_Compiled_Let_Value *)clv->body) {
-          if (scheme_is_compiled_procedure(clv->value, 0, 0)) {
+          if ((clv->count == 1) && !(clv->flags[0] & SCHEME_WAS_USED)) {
+            /* skipped */
+          } else if ((clv->count == 1) && scheme_is_compiled_procedure(clv->value, 0, 0)) {
             Scheme_Object *lift;
             lift = lifted_recs[rpos];
             if (is_closed_reference(lift)) {
@@ -3360,72 +3508,78 @@ scheme_resolve_lets(Scheme_Object *form, Resolve_Info *info)
   clv = (Scheme_Compiled_Let_Value *)head->body;
   rpos = 0; opos = 0;
   for (i = head->num_clauses; i--; clv = (Scheme_Compiled_Let_Value *)clv->body) {
-    int isproc;
+    if ((clv->count == 1) && !(clv->flags[0] & SCHEME_WAS_USED)) {
-    Scheme_Object *expr;
+      /* skipped */
-    if (!clv->value)
-      isproc = 1;
-    else
-      isproc = scheme_is_compiled_procedure(clv->value, 0, 0);
-    if (num_rec_procs && isproc) {
-      if (!lifted_recs) {
-        expr = scheme_resolve_closure_compilation(clv->value, val_linfo, 0, 0, 0, NULL);
-        letrec->procs[rpos++] = expr;
-      } else {
-        if (!is_closed_reference(lifted_recs[rpos])) {
-          /* Side-effect is to install lifted function: */
-          (void)scheme_resolve_closure_compilation(clv->value, val_linfo, 1, 1, 0, lifted_recs[rpos]);
-        }
-        rpos++;
-      }
     } else {
-      int j;
+      int isproc;
-      Scheme_Object *one_lifted;
+      Scheme_Object *expr;
-
+      if (!clv->value)
-      expr = scheme_resolve_expr(clv->value, val_linfo);
+        isproc = 1;
-
+      else if (clv->count == 1)
-      lv = MALLOC_ONE_TAGGED(Scheme_Let_Value);
+        isproc = scheme_is_compiled_procedure(clv->value, 0, 0);
-      if (last)
-	last->body = (Scheme_Object *)lv;
-      else if (last_body)
-        SCHEME_CDR(last_body) = (Scheme_Object *)lv;
       else
-	first = (Scheme_Object *)lv;
+        isproc = 0;
-      last = lv;
+      if (num_rec_procs && isproc) {
-      last_body = NULL;
+        if (!lifted_recs) {
-      
+          expr = scheme_resolve_closure_compilation(clv->value, val_linfo, 0, 0, 0, NULL);
-      lv->iso.so.type = scheme_let_value_type;
+          letrec->procs[rpos++] = expr;
-      lv->value = expr;
+        } else {
-      if (clv->count) {
+          if (!is_closed_reference(lifted_recs[rpos])) {
-	int li;
+            /* Side-effect is to install lifted function: */
-	li = scheme_resolve_info_lookup(linfo, clv->position, NULL, NULL, 0);
+            (void)scheme_resolve_closure_compilation(clv->value, val_linfo, 1, 1, 0, lifted_recs[rpos]);
-	lv->position = li;
-      } else
-	lv->position = 0;
-      lv->count = clv->count;
-      SCHEME_LET_AUTOBOX(lv) = recbox;
-
-      for (j = lv->count; j--; ) {
-	if (!recbox
-	    && (scheme_resolve_info_flags(linfo, opos + j, &one_lifted) & SCHEME_INFO_BOXED)) {
-          GC_CAN_IGNORE Scheme_Object *pos;
-          pos = scheme_make_integer(lv->position + j);
-          if (SCHEME_LET_FLAGS(head) & (SCHEME_LET_STAR | SCHEME_LET_RECURSIVE)) {
-            /* For let* or a let*-like letrec, we need to insert the boxes after each evaluation. */
-            Scheme_Object *boxenv, *pr;
-            pr = scheme_make_pair(pos, scheme_false);
-            boxenv = scheme_make_syntax_resolved(BOXENV_EXPD, pr);
-            if (last)
-              last->body = boxenv;
-            else
-              SCHEME_CDR(last_body) = boxenv;
-            last = NULL;
-            last_body = pr;
-          } else {
-            /* For regular let, delay the boxing until all RHSs are
-               evaluated. */
-            boxes = scheme_make_pair(pos, boxes);
           }
-	}
+          rpos++;
+        }
+      } else {
+        int j;
+        Scheme_Object *one_lifted;
+
+        expr = scheme_resolve_expr(clv->value, val_linfo);
+
+        lv = MALLOC_ONE_TAGGED(Scheme_Let_Value);
+        if (last)
+          last->body = (Scheme_Object *)lv;
+        else if (last_body)
+          SCHEME_CDR(last_body) = (Scheme_Object *)lv;
+        else
+          first = (Scheme_Object *)lv;
+        last = lv;
+        last_body = NULL;
+      
+        lv->iso.so.type = scheme_let_value_type;
+        lv->value = expr;
+        if (clv->count) {
+          int li;
+          li = scheme_resolve_info_lookup(linfo, clv->position, NULL, NULL, 0);
+          lv->position = li;
+        } else
+          lv->position = 0;
+        lv->count = clv->count;
+        SCHEME_LET_AUTOBOX(lv) = recbox;
+
+        for (j = lv->count; j--; ) {
+          if (!recbox
+              && (scheme_resolve_info_flags(linfo, opos + j, &one_lifted) & SCHEME_INFO_BOXED)) {
+            GC_CAN_IGNORE Scheme_Object *pos;
+            pos = scheme_make_integer(lv->position + j);
+            if (SCHEME_LET_FLAGS(head) & (SCHEME_LET_STAR | SCHEME_LET_RECURSIVE)) {
+              /* For let* or a let*-like letrec, we need to insert the boxes after each evaluation. */
+              Scheme_Object *boxenv, *pr;
+              pr = scheme_make_pair(pos, scheme_false);
+              boxenv = scheme_make_syntax_resolved(BOXENV_EXPD, pr);
+              if (last)
+                last->body = boxenv;
+              else
+                SCHEME_CDR(last_body) = boxenv;
+              last = NULL;
+              last_body = pr;
+            } else {
+              /* For regular let, delay the boxing until all RHSs are
+                 evaluated. */
+              boxes = scheme_make_pair(pos, boxes);
+            }
+          }
+        }
       }
     }
     opos += clv->count;
@@ -3457,20 +3611,20 @@ scheme_resolve_lets(Scheme_Object *form, Resolve_Info *info)
   else
     first = body;
 
-  if (head->count + extra_alloc) {
+  if (head->count + extra_alloc - num_skips) {
     Scheme_Let_Void *lvd;
 
     lvd = MALLOC_ONE_TAGGED(Scheme_Let_Void);
     lvd->iso.so.type = scheme_let_void_type;
     lvd->body = first;
-    lvd->count = head->count + extra_alloc;
+    lvd->count = head->count + extra_alloc - num_skips;
     SCHEME_LET_AUTOBOX(lvd) = recbox;
 
     first = (Scheme_Object *)lvd;
   }
 
-  if (info->max_let_depth < linfo->max_let_depth + head->count)
+  if (info->max_let_depth < linfo->max_let_depth + head->count - num_skips + extra_alloc)
-    info->max_let_depth = linfo->max_let_depth + head->count;
+    info->max_let_depth = linfo->max_let_depth + head->count - num_skips + extra_alloc;
   
   return first;
 }