Fix Parmatch crash on empty record head patterns

Author: fhammerschmidt

compiler/ml/parmatch.ml

@@ -512,6 +512,7 @@ let extract_fields omegas arg =
 
 let all_record_args lbls =
   match lbls with
+  | [] -> []
   | (_, {lbl_all}, _, opt) :: _ ->
     let t =
       Array.map
@@ -560,7 +561,6 @@ let all_record_args lbls =
         t.(lbl.lbl_pos) <- x)
       lbls;
     Array.to_list t
-  | _ -> fatal_error "Parmatch.all_record_args"
 
 (* Build argument list when p2 >= p1, where p1 is a simple pattern *)
 let rec simple_match_args p1 p2 =

tests/build_tests/parmatch_empty_record_pattern/input.js

@@ -0,0 +1,7 @@
+// @ts-check
+
+import { setup } from "#dev/process";
+
+const { execBuild } = setup(import.meta.dirname);
+
+await execBuild();

tests/build_tests/parmatch_empty_record_pattern/rescript.json

@@ -0,0 +1,5 @@
+{
+  "name": "parmatch_empty_record_pattern",
+  "sources": ["src"],
+  "dependencies": []
+}

tests/build_tests/parmatch_empty_record_pattern/src/repro.js

@@ -0,0 +1,27 @@
+type method_ = Post | Get
+
+type body = Json(JSON.t)
+
+type request = {
+  method: method_,
+  url: string,
+  headers: dict<string>,
+  body: body,
+}
+
+let classify = request =>
+  switch request {
+  | {
+      method: Post,
+      url,
+      headers: dict{"Authorization": "Token"},
+      body: Json(JSON.Object(dict{
+        "request": JSON.String("READ"),
+        "payload": JSON.Object(dict{
+          "list-a": JSON.Object(dict{"last_known_events": JSON.Object(dict{})}),
+        }),
+      })),
+    } if url->String.includes("/todo/events") =>
+    1
+  | _ => 0
+  }