From 93bf500c9278284fb02d5019e54f173eecb2fcd3 Mon Sep 17 00:00:00 2001
From: Alasdair <alasdair.armstrong@cl.cam.ac.uk>
Date: Tue, 17 Dec 2024 16:16:14 +0000
Subject: [PATCH] TC: Fix missing location in mapping patterns

Reported in PR 834
---
 src/lib/type_check.ml                   |  4 +++-
 test/typecheck/fail/mp_tuple_loc.expect |  5 +++++
 test/typecheck/fail/mp_tuple_loc.sail   | 16 ++++++++++++++++
 3 files changed, 24 insertions(+), 1 deletion(-)
 create mode 100644 test/typecheck/fail/mp_tuple_loc.expect
 create mode 100644 test/typecheck/fail/mp_tuple_loc.sail

diff --git a/src/lib/type_check.ml b/src/lib/type_check.ml
index 021d85de0..40eb0df86 100644
--- a/src/lib/type_check.ml
+++ b/src/lib/type_check.ml
@@ -4194,7 +4194,9 @@ and bind_mpat allow_unknown other_env env (MP_aux (mpat_aux, (l, uannot)) as mpa
       | _ -> Reporting.unreachable l __POS__ "unifying mapping type, expanded synonyms to non-mapping type!"
     end
   | MP_app (other, mpats) when Env.is_mapping other env ->
-      bind_mpat allow_unknown other_env env (MP_aux (MP_app (other, [mk_mpat (MP_tuple mpats)]), (l, uannot))) typ
+      bind_mpat allow_unknown other_env env
+        (MP_aux (MP_app (other, [mk_mpat ~loc:l (MP_tuple mpats)]), (l, uannot)))
+        typ
   | MP_app (f, _) when not (Env.is_union_constructor f env || Env.is_mapping f env) ->
       typ_error l (string_of_id f ^ " is not a union constructor or mapping in mapping-pattern " ^ string_of_mpat mpat)
   | MP_as (mpat, id) ->
diff --git a/test/typecheck/fail/mp_tuple_loc.expect b/test/typecheck/fail/mp_tuple_loc.expect
new file mode 100644
index 000000000..f944f3f91
--- /dev/null
+++ b/test/typecheck/fail/mp_tuple_loc.expect
@@ -0,0 +1,5 @@
+Type error:
+fail/mp_tuple_loc.sail:9.9-24:
+9 |  () <-> foo((), (), ()),
+  |         ^-------------^
+  | Tuple mapping-pattern and tuple type have different length
diff --git a/test/typecheck/fail/mp_tuple_loc.sail b/test/typecheck/fail/mp_tuple_loc.sail
new file mode 100644
index 000000000..ebbf0f7f6
--- /dev/null
+++ b/test/typecheck/fail/mp_tuple_loc.sail
@@ -0,0 +1,16 @@
+
+enum E = A
+
+mapping foo : (unit, unit) <-> E = {
+  ((), ()) <-> A,
+}
+
+mapping bar : unit <-> E = {
+  () <-> foo((), (), ()),
+}
+
+val main : unit -> unit
+
+function main() = {
+  let _ : E = bar();
+}