Make variant pattern matching not rely on tags being int

There are several ways in which the compilation of variants relies on tags being integers:
- Sometimes it uses booleans `if x` to mean `x !=0` to mean: not the first variant (i.e. tag 0)
- Sometimes it uses intervals `if (x > 3 || x < 1)`

Care is required not to change the compilation of variants with special compilation:
- true and false
- lists have constructors "[]" and "::"
- options have a specific definition for  "Some" and "None"

See #6077

Author: cristianoc

CHANGELOG.md

@@ -74,6 +74,7 @@ These are only breaking changes for unformatted code.
 - New internal representation for uncurried functions using built-in type `function$<fun_type, arity>` this avoids having to declare all the possible arities ahead of time https://github.com/rescript-lang/rescript-compiler/pull/5870
 - PPX V3: allow uncurried `make` function and treat it like a curried one https://github.com/rescript-lang/rescript-compiler/pull/6081
 - Add support for `|>` in uncurried mode by desugaring it https://github.com/rescript-lang/rescript-compiler/pull/6083
+- Change the compilation of pattern matching for variants so it does not depends on variats being integers https://github.com/rescript-lang/rescript-compiler/pull/6085
 
 # 10.1.4
 

jscomp/core/js_exp_make.ml

@@ -760,6 +760,9 @@ let string_equal ?comment (e0 : t) (e1 : t) : t =
 let is_type_number ?comment (e : t) : t =
   string_equal ?comment (typeof e) (str "number")
 
+let is_tag (e : t) : t =
+  string_equal ~comment:"tag" (typeof e) (str "number")
+
 let is_type_string ?comment (e : t) : t =
   string_equal ?comment (typeof e) (str "string")
 

jscomp/core/js_exp_make.mli

@@ -199,6 +199,7 @@ val eq_null_undefined_boolean : ?comment:string -> t -> t -> t
 val neq_null_undefined_boolean : ?comment:string -> t -> t -> t
 
 val is_type_number : ?comment:string -> t -> t
+val is_tag : t -> t
 
 val is_type_string : ?comment:string -> t -> t
 

jscomp/core/lam_compile.ml

@@ -616,7 +616,7 @@ and compile_switch (switch_arg : Lam.t) (sw : Lam.lambda_switch)
         else
           (* [e] will be used twice  *)
           let dispatch e =
-            S.if_ (E.is_type_number e)
+            S.if_ (E.is_tag e)
               (compile_cases cxt e sw_consts sw_num_default get_const_name)
               (* default still needed, could simplified*)
               ~else_:

jscomp/ml/matching.ml

@@ -2348,19 +2348,25 @@ let combine_constructor sw_names loc arg ex_pat cstr partial ctx def
           match
             (cstr.cstr_consts, cstr.cstr_nonconsts, consts, nonconsts)
           with
-          | (1, 1, [0, act1], [0, act2]) ->
-           (* Typically, match on lists, will avoid isint primitive in that
-              case *)
+          | (1, 1, [0, act1], [0, act2])
+            when cstr.cstr_name = "::" || cstr.cstr_name = "[]" || Datarepr.constructor_has_optional_shape cstr
+           ->
+              (* Typically, match on lists, will avoid isint primitive in that
+                case *)
               let arg = 
                 if !Config.bs_only && Datarepr.constructor_has_optional_shape cstr then
                   Lprim(is_not_none_bs_primitve , [arg], loc)
                 else arg
               in 
                 Lifthenelse(arg, act2, act1)
           | (2,0, [(i1,act1); (_,act2)],[]) ->
-            if i1 = 0 then Lifthenelse(arg, act2, act1)
-            else Lifthenelse (arg,act1,act2)                
-          | (n,0,_,[])  -> (* The type defines constant constructors only *)
+              let arg = match act1 with
+                | Lconst (Const_pointer (_, Pt_constructor _ )) ->
+                  Lprim (Pintcomp(Ceq), [arg; act1], loc)
+                | _ -> arg in
+              if i1 = 0 then Lifthenelse(arg, act2, act1)
+              else Lifthenelse (arg, act1, act2)                
+          | (n,0,_,[]) when false (* relies on tag being an int *) -> (* The type defines constant constructors only *)
               call_switcher loc fail_opt arg 0 (n-1) consts sw_names
           | (n, _, _, _) ->
               let act0  =
@@ -2373,15 +2379,15 @@ let combine_constructor sw_names loc arg ex_pat cstr partial ctx def
                     else None
                 | None,_ -> same_actions nonconsts in
               match act0 with
-              | Some act ->
+              | Some act when false (* relies on tag being an int *) ->
                   Lifthenelse
                     (Lprim (Pisint, [arg], loc),
                      call_switcher loc
                        fail_opt arg
                        0 (n-1) consts sw_names,
                      act)
 (* Emit a switch, as bytecode implements this sophisticated instruction *)
-              | None ->
+              | _ ->
                   let sw =
                     {sw_numconsts = cstr.cstr_consts; sw_consts = consts;
                      sw_numblocks = cstr.cstr_nonconsts; sw_blocks = nonconsts;

jscomp/test/adt_optimize_test.js

@@ -26,7 +26,7 @@ function f4(param) {
 }
 
 function f5(param) {
-  if (typeof param === "number") {
+  if (/* tag */typeof param === "number") {
     switch (param) {
       case /* A */0 :
           return 1;
@@ -49,19 +49,21 @@ function f5(param) {
 }
 
 function f6(param) {
-  if (typeof param === "number") {
-    if (param >= 2) {
-      return 2;
-    } else {
-      return 0;
-    }
-  } else {
+  if (/* tag */typeof param !== "number") {
     return 1;
   }
+  switch (param) {
+    case /* A */0 :
+    case /* B */1 :
+        return 0;
+    case /* F */2 :
+        return 2;
+    
+  }
 }
 
 function f7(param) {
-  if (typeof param === "number") {
+  if (/* tag */typeof param === "number") {
     switch (param) {
       case /* A */0 :
           return 1;
@@ -85,7 +87,7 @@ function f7(param) {
 }
 
 function f8(param) {
-  if (typeof param === "number") {
+  if (/* tag */typeof param === "number") {
     switch (param) {
       case /* T60 */0 :
       case /* T61 */1 :
@@ -105,7 +107,7 @@ function f8(param) {
 }
 
 function f9(param) {
-  if (typeof param === "number") {
+  if (/* tag */typeof param === "number") {
     if (param === /* T63 */3) {
       return 3;
     } else {
@@ -124,7 +126,7 @@ function f9(param) {
 }
 
 function f10(param) {
-  if (typeof param === "number") {
+  if (/* tag */typeof param === "number") {
     switch (param) {
       case /* T60 */0 :
           return 0;
@@ -150,7 +152,7 @@ function f10(param) {
 }
 
 function f11(x) {
-  if (typeof x === "number") {
+  if (/* tag */typeof x === "number") {
     return 2;
   }
   if (x.TAG === /* D */0) {

jscomp/test/bal_set_mini.js

@@ -2,10 +2,10 @@
 
 
 function height(param) {
-  if (param) {
-    return param._3;
-  } else {
+  if (/* tag */typeof param === "number") {
     return 0;
+  } else {
+    return param._3;
   }
 }
 
@@ -24,18 +24,18 @@ function bal(l, v, r) {
   var hl = height(l);
   var hr = height(r);
   if (hl > (hr + 2 | 0)) {
-    if (!l) {
+    if (/* tag */typeof l === "number") {
       return /* Empty */0;
     }
     var lr = l._2;
     var lv = l._1;
     var ll = l._0;
     if (height(ll) >= height(lr)) {
       return create(ll, lv, create(lr, v, r));
-    } else if (lr) {
-      return create(create(ll, lv, lr._0), lr._1, create(lr._2, v, r));
-    } else {
+    } else if (/* tag */typeof lr === "number") {
       return /* Empty */0;
+    } else {
+      return create(create(ll, lv, lr._0), lr._1, create(lr._2, v, r));
     }
   }
   if (hr <= (hl + 2 | 0)) {
@@ -46,18 +46,18 @@ function bal(l, v, r) {
             _3: hl >= hr ? hl + 1 | 0 : hr + 1 | 0
           };
   }
-  if (!r) {
+  if (/* tag */typeof r === "number") {
     return /* Empty */0;
   }
   var rr = r._2;
   var rv = r._1;
   var rl = r._0;
   if (height(rr) >= height(rl)) {
     return create(create(l, v, rl), rv, rr);
-  } else if (rl) {
-    return create(create(l, v, rl._0), rl._1, create(rl._2, rv, rr));
-  } else {
+  } else if (/* tag */typeof rl === "number") {
     return /* Empty */0;
+  } else {
+    return create(create(l, v, rl._0), rl._1, create(rl._2, rv, rr));
   }
 }
 
@@ -72,7 +72,7 @@ function compare_int(x, y) {
 }
 
 function add(x, t) {
-  if (!t) {
+  if (/* tag */typeof t === "number") {
     return /* Node */{
             _0: /* Empty */0,
             _1: x,
@@ -97,11 +97,11 @@ function min_elt(_def, _param) {
   while(true) {
     var param = _param;
     var def = _def;
-    if (!param) {
+    if (/* tag */typeof param === "number") {
       return def;
     }
     var l = param._0;
-    if (!l) {
+    if (/* tag */typeof l === "number") {
       return param._1;
     }
     _param = l;
@@ -111,26 +111,26 @@ function min_elt(_def, _param) {
 }
 
 function remove_min_elt(l, v, r) {
-  if (l) {
-    return bal(remove_min_elt(l._0, l._1, l._2), v, r);
-  } else {
+  if (/* tag */typeof l === "number") {
     return r;
+  } else {
+    return bal(remove_min_elt(l._0, l._1, l._2), v, r);
   }
 }
 
 function internal_merge(l, r) {
-  if (!l) {
+  if (/* tag */typeof l === "number") {
     return r;
   }
-  if (!r) {
+  if (/* tag */typeof r === "number") {
     return l;
   }
   var rv = r._1;
   return bal(l, min_elt(rv, r), remove_min_elt(r._0, rv, r._2));
 }
 
 function remove(x, tree) {
-  if (!tree) {
+  if (/* tag */typeof tree === "number") {
     return /* Empty */0;
   }
   var r = tree._2;
@@ -149,7 +149,7 @@ function remove(x, tree) {
 function mem(x, _param) {
   while(true) {
     var param = _param;
-    if (!param) {
+    if (/* tag */typeof param === "number") {
       return false;
     }
     var c = compare_int(x, param._1);
@@ -180,7 +180,7 @@ for(var i$2 = 0; i$2 <= 100000; ++i$2){
 
 var match = v;
 
-if (match) {
+if (/* tag */typeof match !== "number") {
   console.log("impossible");
 }