[minor] switch.ml: distinguish types for arguments, tests and actions

Changes

@@ -200,6 +200,9 @@ Working version
 - #10637: Outcometree: introduce a record type for constructors
   (Gabriel Scherer, review by Thomas Refis)
 
+- #10516: refactor the compilation of the 'switch' construct
+  (Gabriel Scherer, review by Wiktor Kuchta and Luc Maranget)
+
 ### Build system:
 
 ### Bug fixes:

asmcomp/cmm_helpers.ml

@@ -1504,8 +1504,10 @@ struct
   let geint = Ccmpi Cge
   let gtint = Ccmpi Cgt
 
-  type act = expression
   type loc = Debuginfo.t
+  type arg = expression
+  type test = expression
+  type act = expression
 
   (* CR mshinwell: GPR#2294 will fix the Debuginfo here *)
 
@@ -1514,6 +1516,7 @@ struct
   let make_offset arg n = add_const arg n Debuginfo.none
   let make_isout h arg = Cop (Ccmpa Clt, [h ; arg], Debuginfo.none)
   let make_isin h arg = Cop (Ccmpa Cge, [h ; arg], Debuginfo.none)
+  let make_is_nonzero arg = arg
   let make_if cond ifso ifnot =
     Cifthenelse (cond, Debuginfo.none, ifso, Debuginfo.none, ifnot,
       Debuginfo.none)

lambda/matching.ml

@@ -2329,9 +2329,10 @@ module SArg = struct
 
   let gtint = Pintcomp Cgt
 
-  type act = Lambda.lambda
-
   type loc = Lambda.scoped_location
+  type arg = Lambda.lambda
+  type test = Lambda.lambda
+  type act = Lambda.lambda
 
   let make_prim p args = Lprim (p, args, Loc_unknown)
 
@@ -2356,6 +2357,8 @@ module SArg = struct
 
   let make_isin h arg = Lprim (Pnot, [ make_isout h arg ], Loc_unknown)
 
+  let make_is_nonzero arg = arg
+
   let make_if cond ifso ifnot = Lifthenelse (cond, ifso, ifnot)
 
   let make_switch loc arg cases acts =

lambda/switch.ml

@@ -113,17 +113,23 @@ sig
   val ltint : primitive
   val geint : primitive
   val gtint : primitive
-  type act
+
   type loc
+  type arg
+  type test
+  type act
+
+  val bind : arg -> (arg -> act) -> act
+  val make_const : int -> arg
+  val make_offset : arg -> int -> arg
+  val make_prim : primitive -> arg list -> test
+  val make_isout : arg -> arg -> test
+  val make_isin : arg -> arg -> test
+  val make_is_nonzero : arg -> test
+
+  val make_if : test -> act -> act -> act
+  val make_switch : loc -> arg -> int array -> act array -> act
 
-  val bind : act -> (act -> act) -> act
-  val make_const : int -> act
-  val make_offset : act -> int -> act
-  val make_prim : primitive -> act list -> act
-  val make_isout : act -> act -> act
-  val make_isin : act -> act -> act
-  val make_if : act -> act -> act -> act
-  val make_switch : loc -> act -> int array -> act array -> act
   val make_catch : act -> int * (act -> act)
   val make_exit : int -> act
 end
@@ -569,6 +575,9 @@ let rec pkey chan  = function
   and make_if_ne  arg i ifso ifnot =
     make_if_test Arg.neint arg i ifso ifnot
 
+  let make_if_nonzero arg ifso ifnot =
+    Arg.make_if (Arg.make_is_nonzero arg) ifso ifnot
+
   let do_make_if_out h arg ifso ifno =
     Arg.make_if (Arg.make_isout h arg) ifso ifno
 
@@ -658,7 +667,7 @@ 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
+            make_if_nonzero
               ctx.arg
               (c_test ctx right) (c_test ctx left)
           else if less_tests cright cleft then

lambda/switch.mli

@@ -72,28 +72,35 @@ module type S =
     val ltint : primitive
     val geint : primitive
     val gtint : primitive
-    (* type of actions *)
-    type act
+
     (* type of source locations *)
     type loc
+    (* type of switch scrutinees *)
+    type arg
+    (* type of tests on scrutinees *)
+    type test
+    (* type of actions *)
+    type act
 
     (* Various constructors, for making a binder,
         adding one integer, etc. *)
-    val bind : act -> (act -> act) -> act
-    val make_const : int -> act
-    val make_offset : act -> int -> act
-    val make_prim : primitive -> act list -> act
-    val make_isout : act -> act -> act
-    val make_isin : act -> act -> act
-    val make_if : act -> act -> act -> act
+    val bind : arg -> (arg -> act) -> act
+    val make_const : int -> arg
+    val make_offset : arg -> int -> arg
+    val make_prim : primitive -> arg list -> test
+    val make_isout : arg -> arg -> test
+    val make_isin : arg -> arg -> test
+    val make_is_nonzero : arg -> test
+
+    val make_if : test -> act -> act -> act
    (* construct an actual switch :
       make_switch arg cases acts
       NB:  cases is in the value form *)
-    val make_switch : loc -> act -> int array -> act array -> act
+    val make_switch : loc -> arg -> int array -> act array -> act
+
    (* Build last minute sharing of action stuff *)
    val make_catch : act -> int * (act -> act)
    val make_exit : int -> act
-
   end
 
 
@@ -114,14 +121,14 @@ module Make :
       val zyva :
           Arg.loc ->
           (int * int) ->
-           Arg.act ->
+           Arg.arg ->
            (int * int * int) array ->
            (Arg.act, _) t_store ->
            Arg.act
 
 (* Output test sequence, sharing tracked *)
      val test_sequence :
-           Arg.act ->
+           Arg.arg ->
            (int * int * int) array ->
            (Arg.act, _) t_store ->
            Arg.act