Ensure that Lifthenelse has a boolean-valued condition (#63)

Author: mshinwell

lambda/matching.ml

@@ -2744,9 +2744,10 @@ let combine_constructor loc arg pat_env cstr partial ctx def
             match
               (cstr.cstr_consts, cstr.cstr_nonconsts, consts, nonconsts)
             with
-            | 1, 1, [ (0, act1) ], [ (0, act2) ] ->
+            | 1, 1, [ (0, act1) ], [ (0, act2) ]
+              when not (Clflags.is_flambda2 ()) ->
                 (* Typically, match on lists, will avoid isint primitive in that
-              case *)
+                   case *)
                 Lifthenelse (arg, act2, act1)
             | n, 0, _, [] ->
                 (* The type defines constant constructors only *)

lambda/simplif.ml

@@ -706,7 +706,22 @@ and list_emit_tail_infos is_tail =
 let split_default_wrapper ~id:fun_id ~kind ~params ~return ~body ~attr ~loc =
   let rec aux map = function
     | Llet(Strict, k, id, (Lifthenelse(Lvar optparam, _, _) as def), rest) when
-        Ident.name optparam = "*opt*" && List.mem_assoc optparam params
+        (not (Clflags.is_flambda2 ()))
+          && Ident.name optparam = "*opt*" && List.mem_assoc optparam params
+          && not (List.mem_assoc optparam map)
+      ->
+        let wrapper_body, inner = aux ((optparam, id) :: map) rest in
+        Llet(Strict, k, id, def, wrapper_body), inner
+    | Llet(Strict, k, id,
+        (Lswitch(Lvar optparam,
+           {sw_numconsts = 1;
+            sw_consts = [_];
+            sw_numblocks = 1;
+            sw_blocks = [_];
+            sw_failaction = None}, _dbg)
+         as def), rest) when
+        Clflags.is_flambda2 ()
+          && Ident.name optparam = "*opt*" && List.mem_assoc optparam params
           && not (List.mem_assoc optparam map)
       ->
         let wrapper_body, inner = aux ((optparam, id) :: map) rest in

lambda/switch.ml

@@ -187,6 +187,9 @@ let prerr_inter i = Printf.fprintf stderr
   and get_low cases i =
     let r,_,_ = cases.(i) in
     r
+  and get_high cases i =
+    let _,r,_ = cases.(i) in
+    r
 
   type ctests = {
     mutable n : int ;
@@ -660,9 +663,14 @@ let rec pkey chan  = function
           and right = {s with cases=right} in
 
           if i=1 && (lim+ctx.off)=1 && get_low cases 0+ctx.off=0 then
-            Arg.make_if
-              ctx.arg
-              (c_test ctx right) (c_test ctx left)
+            if lcases = 2 && get_high cases 1+ctx.off = 1 then
+              Arg.make_if
+                ctx.arg
+                (c_test ctx right) (c_test ctx left)
+            else
+              make_if_ne
+                ctx.arg 0
+                (c_test ctx right) (c_test ctx left)
           else if less_tests cright cleft then
             make_if_lt
               ctx.arg (lim+ctx.off)