Experiment for untagged pattern matching.

First step: remove the distinction between cases with and without payload in the toplevel algorithm.

On this test:
```res
@unboxed
type rec t =
  | Boolean(bool)
  | @as(null) Null
  | String(string)
  | Number(float)
  | Object(Dict.t<t>)
  | Array(array<t>)

type group = {
  id: string,
  name: string,
}

let decodeGroup = group => {
  switch group {
  | (dict{"id": String(id), "name": String(name)}) =>
  (id, name)
  | _ => ("e", "f")
  }
}
```

Before:
```js
function decodeGroup(group) {
  let match = group.id;
  if (match === undefined) {
    return [
      "e",
      "f"
    ];
  }
  if (match === null) {
    return [
      "e",
      "f"
    ];
  }
  if (typeof match !== "string") {
    return [
      "e",
      "f"
    ];
  }
  let match$1 = group.name;
  if (match$1 !== undefined && !(match$1 === null || typeof match$1 !== "string")) {
    return [
      match,
      match$1
    ];
  } else {
    return [
      "e",
      "f"
    ];
  }
}
```

After:
```
function decodeGroup(group) {
  let match = group.id;
  if (match === undefined) {
    return [
      "e",
      "f"
    ];
  }
  if (typeof match !== "string") {
    return [
      "e",
      "f"
    ];
  }
  let match$1 = group.name;
  if (match$1 !== undefined && typeof match$1 === "string") {
    return [
      match,
      match$1
    ];
  } else {
    return [
      "e",
      "f"
    ];
  }
}

```

The 3 cases have become 2: check for optional fields and check for which case it is.

Author: cristianoc

compiler/core/lam_compile.ml

@@ -673,6 +673,8 @@ let compile output_prefix =
               also if last statement is throw -- should we drop remaining
               statement?
     *)
+    Printf.eprintf "XXX switch_arg: %s\n\n"
+      (Lam_print.lambda_to_string switch_arg);
     let ({
            sw_consts_full;
            sw_consts;
@@ -713,40 +715,66 @@ let compile output_prefix =
         block
         @
         if sw_consts_full && sw_consts = [] then
+          let _ = Printf.eprintf "QQQ sw_consts_full\n\n" in
           compile_cases ~block_cases ~untagged ~cxt
             ~switch_exp:(if untagged then e else E.tag ~name:tag_name e)
             ~default:sw_blocks_default ~get_tag:get_block_tag sw_blocks
         else if sw_blocks_full && sw_blocks = [] then
+          let _ = Printf.eprintf "QQQ sw_blocks_full\n\n" in
           compile_cases ~cxt ~switch_exp:e ~block_cases ~default:sw_num_default
             ~get_tag:get_const_tag sw_consts
         else
+          let _ = Printf.eprintf "QQQ else\n\n" in
           (* [e] will be used twice  *)
           let dispatch e =
             let is_a_literal_case =
-              if block_cases <> [] then
-                E.is_a_literal_case
-                  ~literal_cases:(get_literal_cases sw_names)
-                  ~block_cases e
+              if untagged then (
+                let literal_case =
+                  E.is_a_literal_case
+                    ~literal_cases:(get_literal_cases sw_names)
+                    ~block_cases e
+                in
+                Printf.eprintf "LLL literal_case: %s\n\n"
+                  (Js_dump.string_of_expression literal_case);
+                literal_case)
               else
                 E.is_int_tag
                   ~has_null_undefined_other:(has_null_undefined_other sw_names)
                   e
             in
-            S.if_ is_a_literal_case
-              (compile_cases ~cxt ~switch_exp:e ~block_cases
-                 ~default:sw_num_default ~get_tag:get_const_tag sw_consts)
-              ~else_:
-                (compile_cases ~untagged ~cxt
-                   ~switch_exp:(if untagged then e else E.tag ~name:tag_name e)
-                   ~block_cases ~default:sw_blocks_default
-                   ~get_tag:get_block_tag sw_blocks)
+            let qconsts =
+              use_compile_literal_cases sw_consts ~get_tag:get_const_tag
+            in
+            let qblocks =
+              use_compile_literal_cases sw_blocks ~get_tag:get_block_tag
+            in
+            match (qconsts, qblocks) with
+            | Some consts_cases, Some blocks_cases when false ->
+              let untagged_cases = consts_cases @ blocks_cases in
+              let z =
+                compile_untagged_cases ~cxt ~switch_exp:e ~block_cases
+                  ~default:sw_num_default untagged_cases
+              in
+              z
+            | _ ->
+              [
+                S.if_ is_a_literal_case
+                  (compile_cases ~cxt ~switch_exp:e ~block_cases
+                     ~default:sw_num_default ~get_tag:get_const_tag sw_consts)
+                  ~else_:
+                    (compile_cases ~untagged ~cxt
+                       ~switch_exp:
+                         (if untagged then e else E.tag ~name:tag_name e)
+                       ~block_cases ~default:sw_blocks_default
+                       ~get_tag:get_block_tag sw_blocks);
+              ]
           in
           match e.expression_desc with
-          | J.Var _ -> [dispatch e]
+          | J.Var _ -> dispatch e
           | _ ->
             let v = Ext_ident.create_tmp () in
             (* Necessary avoid duplicated computation*)
-            [S.define_variable ~kind:Variable v e; dispatch (E.var v)])
+            [S.define_variable ~kind:Variable v e] @ dispatch (E.var v))
     in
     match lambda_cxt.continuation with
     (* Needs declare first *)
@@ -756,15 +784,19 @@ let compile output_prefix =
          when branches are minimial (less than 2)
       *)
       let v = Ext_ident.create_tmp () in
+      let res = compile_whole {lambda_cxt with continuation = Assign v} in
+      Printf.eprintf "XXX res 1: %s\n\n" (Js_dump.string_of_block res);
       Js_output.make
-        (S.declare_variable ~kind:Variable v
-        :: compile_whole {lambda_cxt with continuation = Assign v})
+        (S.declare_variable ~kind:Variable v :: res)
         ~value:(E.var v)
     | Declare (kind, id) ->
-      Js_output.make
-        (S.declare_variable ~kind id
-        :: compile_whole {lambda_cxt with continuation = Assign id})
-    | EffectCall _ | Assign _ -> Js_output.make (compile_whole lambda_cxt)
+      let res = compile_whole {lambda_cxt with continuation = Assign id} in
+      Printf.eprintf "XXX res 2: %s\n\n" (Js_dump.string_of_block res);
+      Js_output.make (S.declare_variable ~kind id :: res) ~value:(E.var id)
+    | EffectCall _ | Assign _ ->
+      let res = compile_whole lambda_cxt in
+      Printf.eprintf "XXX res 3: %s\n\n" (Js_dump.string_of_block res);
+      Js_output.make res
   and compile_string_cases ~cxt ~switch_exp ~default cases : initialization =
     cases
     |> compile_general_cases ~make_exp:E.tag_type

lib/es6/Intl_NumberFormat_Grouping.js

@@ -4,10 +4,7 @@ import * as Type from "./Type.js";
 
 function parseJsValue(value) {
   let value$1 = Type.Classify.classify(value);
-  if (typeof value$1 !== "object") {
-    return;
-  }
-  switch (value$1.TAG) {
+  switch (typeof value$1) {
     case "Bool" :
       return {
         NAME: "bool",

lib/es6/Primitive_module.js

@@ -10,35 +10,32 @@ function init(loc, shape) {
     };
   };
   let loop = (shape, struct_, idx) => {
-    if (typeof shape !== "object") {
-      switch (shape) {
-        case "Function" :
-        case "Lazy" :
-          struct_[idx] = undef_module;
-          return;
-        case "Class" :
-          struct_[idx] = [
-            undef_module,
-            undef_module,
-            undef_module,
-            0
-          ];
-          return;
-      }
-    } else {
-      if (shape.TAG !== "Module") {
+    switch (typeof shape) {
+      case "Function" :
+      case "Lazy" :
+        struct_[idx] = undef_module;
+        return;
+      case "Class" :
+        struct_[idx] = [
+          undef_module,
+          undef_module,
+          undef_module,
+          0
+        ];
+        return;
+      case "Module" :
+        let comps = shape._0;
+        let v = {};
+        struct_[idx] = v;
+        let len = comps.length;
+        for (let i = 0; i < len; ++i) {
+          let match = comps[i];
+          loop(match[0], v, match[1]);
+        }
+        return;
+      case "Value" :
         struct_[idx] = shape._0;
         return;
-      }
-      let comps = shape._0;
-      let v = {};
-      struct_[idx] = v;
-      let len = comps.length;
-      for (let i = 0; i < len; ++i) {
-        let match = comps[i];
-        loop(match[0], v, match[1]);
-      }
-      return;
     }
   };
   let res = {};
@@ -49,41 +46,27 @@ function init(loc, shape) {
 
 function update(shape, o, n) {
   let aux = (shape, o, n, parent, i) => {
-    if (typeof shape !== "object") {
-      switch (shape) {
-        case "Function" :
-          parent[i] = n;
-          return;
-        case "Lazy" :
-        case "Class" :
-          Object.assign(o, n);
-          return;
-      }
-    } else {
-      if (shape.TAG !== "Module") {
+    switch (typeof shape) {
+      case "Function" :
+        parent[i] = n;
+        return;
+      case "Lazy" :
+      case "Class" :
+        Object.assign(o, n);
+        return;
+      case "Module" :
+        let comps = shape._0;
+        for (let i$1 = 0, i_finish = comps.length; i$1 < i_finish; ++i$1) {
+          let match = comps[i$1];
+          let name = match[1];
+          aux(match[0], o[name], n[name], o, name);
+        }
+        return;
+      case "Value" :
         return;
-      }
-      let comps = shape._0;
-      for (let i$1 = 0, i_finish = comps.length; i$1 < i_finish; ++i$1) {
-        let match = comps[i$1];
-        let name = match[1];
-        aux(match[0], o[name], n[name], o, name);
-      }
-      return;
     }
   };
-  if (typeof shape !== "object") {
-    throw {
-      RE_EXN_ID: "Assert_failure",
-      _1: [
-        "Primitive_module.res",
-        68,
-        9
-      ],
-      Error: new Error()
-    };
-  }
-  if (shape.TAG === "Module") {
+  if ("Module") {
     let comps = shape._0;
     for (let i = 0, i_finish = comps.length; i < i_finish; ++i) {
       let match = comps[i];

lib/js/Intl_NumberFormat_Grouping.js

@@ -4,10 +4,7 @@ let Type = require("./Type.js");
 
 function parseJsValue(value) {
   let value$1 = Type.Classify.classify(value);
-  if (typeof value$1 !== "object") {
-    return;
-  }
-  switch (value$1.TAG) {
+  switch (typeof value$1) {
     case "Bool" :
       return {
         NAME: "bool",

lib/js/Primitive_module.js

@@ -10,35 +10,32 @@ function init(loc, shape) {
     };
   };
   let loop = (shape, struct_, idx) => {
-    if (typeof shape !== "object") {
-      switch (shape) {
-        case "Function" :
-        case "Lazy" :
-          struct_[idx] = undef_module;
-          return;
-        case "Class" :
-          struct_[idx] = [
-            undef_module,
-            undef_module,
-            undef_module,
-            0
-          ];
-          return;
-      }
-    } else {
-      if (shape.TAG !== "Module") {
+    switch (typeof shape) {
+      case "Function" :
+      case "Lazy" :
+        struct_[idx] = undef_module;
+        return;
+      case "Class" :
+        struct_[idx] = [
+          undef_module,
+          undef_module,
+          undef_module,
+          0
+        ];
+        return;
+      case "Module" :
+        let comps = shape._0;
+        let v = {};
+        struct_[idx] = v;
+        let len = comps.length;
+        for (let i = 0; i < len; ++i) {
+          let match = comps[i];
+          loop(match[0], v, match[1]);
+        }
+        return;
+      case "Value" :
         struct_[idx] = shape._0;
         return;
-      }
-      let comps = shape._0;
-      let v = {};
-      struct_[idx] = v;
-      let len = comps.length;
-      for (let i = 0; i < len; ++i) {
-        let match = comps[i];
-        loop(match[0], v, match[1]);
-      }
-      return;
     }
   };
   let res = {};
@@ -49,41 +46,27 @@ function init(loc, shape) {
 
 function update(shape, o, n) {
   let aux = (shape, o, n, parent, i) => {
-    if (typeof shape !== "object") {
-      switch (shape) {
-        case "Function" :
-          parent[i] = n;
-          return;
-        case "Lazy" :
-        case "Class" :
-          Object.assign(o, n);
-          return;
-      }
-    } else {
-      if (shape.TAG !== "Module") {
+    switch (typeof shape) {
+      case "Function" :
+        parent[i] = n;
+        return;
+      case "Lazy" :
+      case "Class" :
+        Object.assign(o, n);
+        return;
+      case "Module" :
+        let comps = shape._0;
+        for (let i$1 = 0, i_finish = comps.length; i$1 < i_finish; ++i$1) {
+          let match = comps[i$1];
+          let name = match[1];
+          aux(match[0], o[name], n[name], o, name);
+        }
+        return;
+      case "Value" :
         return;
-      }
-      let comps = shape._0;
-      for (let i$1 = 0, i_finish = comps.length; i$1 < i_finish; ++i$1) {
-        let match = comps[i$1];
-        let name = match[1];
-        aux(match[0], o[name], n[name], o, name);
-      }
-      return;
     }
   };
-  if (typeof shape !== "object") {
-    throw {
-      RE_EXN_ID: "Assert_failure",
-      _1: [
-        "Primitive_module.res",
-        68,
-        9
-      ],
-      Error: new Error()
-    };
-  }
-  if (shape.TAG === "Module") {
+  if ("Module") {
     let comps = shape._0;
     for (let i = 0, i_finish = comps.length; i < i_finish; ++i) {
       let match = comps[i];