--- cmmgen.ml.orig	2008-06-02 15:35:14.000626000 -0400
+++ cmmgen.ml	2008-06-02 16:32:42.000314000 -0400
@@ -173,22 +173,26 @@
 
 let test_bool = function
     Cop(Caddi, [Cop(Clsl, [c; Cconst_int 1]); Cconst_int 1]) -> c
   | Cop(Clsl, [c; Cconst_int 1]) -> c
   | c -> Cop(Ccmpi Cne, [c; Cconst_int 1])
 
 (* Float *)
 
 let box_float c = Cop(Calloc, [alloc_float_header; c])
 
-let unbox_float = function
+let rec unbox_float = function
     Cop(Calloc, [header; c]) -> c
+  | Clet(id, exp, body) -> Clet(id, exp, unbox_float body)
+  | Cifthenelse(cond, e1, e2) -> Cifthenelse(cond, unbox_float e1, unbox_float e2)
+  | Csequence(e1, e2) -> Csequence(e1, unbox_float e2)
+      (* do we need to push through more constructs ? *)
   | c -> Cop(Cload Double_u, [c])
 
 (* Complex *)
 
 let box_complex c_re c_im =
   Cop(Calloc, [alloc_floatarray_header 2; c_re; c_im])
 
 let complex_re c = Cop(Cload Double_u, [c])
 let complex_im c = Cop(Cload Double_u,
                        [Cop(Cadda, [c; Cconst_int size_float])])

--- cmmgen.ml.orig	2008-06-02 15:35:14.000626000 -0400
+++ cmmgen.ml	2008-06-02 16:32:42.000314000 -0400
@@ -173,22 +173,26 @@
 
 let test_bool = function
     Cop(Caddi, [Cop(Clsl, [c; Cconst_int 1]); Cconst_int 1]) -> c
   | Cop(Clsl, [c; Cconst_int 1]) -> c
   | c -> Cop(Ccmpi Cne, [c; Cconst_int 1])
 
 (* Float *)
 
 let box_float c = Cop(Calloc, [alloc_float_header; c])
 
-let unbox_float = function
+let rec unbox_float = function
     Cop(Calloc, [header; c]) -> c
+  | Clet(id, exp, body) -> Clet(id, exp, unbox_float body)
+  | Cifthenelse(cond, e1, e2) -> Cifthenelse(cond, unbox_float e1, unbox_float e2)
+  | Csequence(e1, e2) -> Csequence(e1, unbox_float e2)
+      (* do we need to push through more constructs ? *)
   | c -> Cop(Cload Double_u, [c])
 
 (* Complex *)
 
 let box_complex c_re c_im =
   Cop(Calloc, [alloc_floatarray_header 2; c_re; c_im])
 
 let complex_re c = Cop(Cload Double_u, [c])
 let complex_im c = Cop(Cload Double_u,
                        [Cop(Cadda, [c; Cconst_int size_float])])
@@ -731,50 +735,80 @@
         | Pasrbint bi -> Boxed_integer bi
         | Pbigarrayref(_, (Pbigarray_float32 | Pbigarray_float64), _) ->
             Boxed_float
         | Pbigarrayref(_, Pbigarray_int32, _) -> Boxed_integer Pint32
         | Pbigarrayref(_, Pbigarray_int64, _) -> Boxed_integer Pint64
         | Pbigarrayref(_, Pbigarray_native_int, _) -> Boxed_integer Pnativeint
         | _ -> No_unboxing
       end
   | _ -> No_unboxing
 
+type zero_one_many = Zero | One | Many
+
 let subst_boxed_number unbox_fn boxed_id unboxed_id exp =
-  let need_boxed = ref false in
+  let num_needed_boxes = ref Zero in
   let assigned = ref false in
   let rec subst = function
       Cvar id as e ->
-        if Ident.same id boxed_id then need_boxed := true; e
+        if Ident.same id boxed_id
+        then num_needed_boxes := (if !num_needed_boxes = Zero then One else Many);
+        e
     | Clet(id, arg, body) -> Clet(id, subst arg, subst body)
     | Cassign(id, arg) ->
         if Ident.same id boxed_id then begin
           assigned := true;
           Cassign(unboxed_id, subst(unbox_fn arg))
         end else
           Cassign(id, subst arg)
     | Ctuple argv -> Ctuple(List.map subst argv)
     | Cop(Cload _, [Cvar id]) as e ->
         if Ident.same id boxed_id then Cvar unboxed_id else e
     | Cop(Cload _, [Cop(Cadda, [Cvar id; _])]) as e ->
         if Ident.same id boxed_id then Cvar unboxed_id else e
     | Cop(op, argv) -> Cop(op, List.map subst argv)
     | Csequence(e1, e2) -> Csequence(subst e1, subst e2)
     | Cifthenelse(e1, e2, e3) -> Cifthenelse(subst e1, subst e2, subst e3)
     | Cswitch(arg, index, cases) ->
         Cswitch(subst arg, index, Array.map subst cases)
-    | Cloop e -> Cloop(subst e)
+    | Cloop e ->
+        let num_before = !num_needed_boxes in
+        let e2 = subst e in
+        let num_after = !num_needed_boxes in
+        if num_after <> num_before
+        then num_needed_boxes := Many;
+        Cloop e2
     | Ccatch(nfail, ids, e1, e2) -> Ccatch(nfail, ids, subst e1, subst e2)
     | Cexit (nfail, el) -> Cexit (nfail, List.map subst el)
     | Ctrywith(e1, id, e2) -> Ctrywith(subst e1, id, subst e2)
     | e -> e in
   let res = subst exp in
-  (res, !need_boxed, !assigned)
+  (res, !num_needed_boxes, !assigned)
+
+let plain_subst subst_id subst_exp exp =
+  let rec subst = function
+    | Cvar id as e ->
+        if Ident.same id subst_id then subst_exp else e
+    | Clet(id, arg, body) -> Clet(id, subst arg, subst body)
+    | Cassign(id, arg) -> Cassign(id, subst arg)
+    | Ctuple argv -> Ctuple(List.map subst argv)
+    | Cop(op, argv) -> Cop(op, List.map subst argv)
+    | Csequence(e1, e2) -> Csequence(subst e1, subst e2)
+    | Cifthenelse(e1, e2, e3) -> Cifthenelse(subst e1, subst e2, subst e3)
+    | Cswitch(arg, index, cases) ->
+        Cswitch(subst arg, index, Array.map subst cases)
+    | Cloop e -> Cloop(subst e)
+    | Ccatch(nfail, ids, e1, e2) -> Ccatch(nfail, ids, subst e1, subst e2)
+    | Cexit(nfail, el) -> Cexit(nfail, List.map subst el)
+    | Ctrywith(e1, id, e2) -> Ctrywith(subst e1, id, subst e2)
+    | e -> e
+  in
+  subst exp
 
 (* Translate an expression *)
 
 let functions = (Queue.create() : (string * Ident.t list * ulambda) Queue.t)
 
 let rec transl = function
     Uvar id ->
       Cvar id
   | Uconst sc ->
       transl_constant sc
@@ -1357,29 +1391,31 @@
       Cconst_natint n
   | Uconst(Const_base(Const_int64 n)) ->
       assert (size_int = 8); Cconst_natint (Int64.to_nativeint n)
   | Uprim(Pbintofint bi', [Uconst(Const_base(Const_int i))], _) when bi = bi' ->
       Cconst_int i
   | exp -> unbox_int bi (transl exp)
 
 and transl_unbox_let box_fn unbox_fn transl_unbox_fn id exp body =
   let unboxed_id = Ident.create (Ident.name id) in
   let trbody1 = transl body in
-  let (trbody2, need_boxed, is_assigned) =
+  let (trbody2, num_needed_boxes, is_assigned) =
     subst_boxed_number unbox_fn id unboxed_id trbody1 in
-  if need_boxed && is_assigned then
+  if num_needed_boxes <> Zero && is_assigned then
     Clet(id, transl exp, trbody1)
   else
     Clet(unboxed_id, transl_unbox_fn exp,
-         if need_boxed
-         then Clet(id, box_fn(Cvar unboxed_id), trbody2)
-         else trbody2)
+        match num_needed_boxes with
+        | Zero -> trbody2
+        | One -> plain_subst id (box_fn(Cvar unboxed_id)) trbody2
+        | Many -> Clet(id, box_fn(Cvar unboxed_id), trbody2)
+    )
 
 and make_catch ncatch body handler = match body with
 | Cexit (nexit,[]) when nexit=ncatch -> handler
 | _ ->  Ccatch (ncatch, [], body, handler)
 
 and make_catch2 mk_body handler = match handler with
 | Cexit (_,[])|Ctuple []|Cconst_int _|Cconst_pointer _ ->
     mk_body handler
 | _ ->
     let nfail = next_raise_count () in