From 146322baf0206f5237c27846ae15ff6885784c92 Mon Sep 17 00:00:00 2001
From: Oscar Spencer <oscar@grain-lang.org>
Date: Tue, 26 Apr 2022 23:33:15 -0400
Subject: [PATCH] fix(compiler): Supply correct error for unbound record labels

---
 compiler/src/typed/env.re       | 2 ++
 compiler/src/typed/env.rei      | 2 ++
 compiler/src/typed/typetexp.re  | 6 +++++-
 compiler/test/suites/records.re | 5 +++++
 4 files changed, 14 insertions(+), 1 deletion(-)

diff --git a/compiler/src/typed/env.re b/compiler/src/typed/env.re
index c00848a96f..47428e07c6 100644
--- a/compiler/src/typed/env.re
+++ b/compiler/src/typed/env.re
@@ -2586,6 +2586,8 @@ let fold_modules = (f, lid, env, acc) =>
 let fold_values = f => find_all(env => env.values, sc => sc.comp_values, f)
 and fold_constructors = f =>
   find_all_simple_list(env => env.constructors, sc => sc.comp_constrs, f)
+and fold_labels = f =>
+  find_all_simple_list(env => env.labels, sc => sc.comp_labels, f)
 and fold_types = f => find_all(env => env.types, sc => sc.comp_types, f)
 and fold_modtypes = f =>
   find_all(env => env.modtypes, sc => sc.comp_modtypes, f);
diff --git a/compiler/src/typed/env.rei b/compiler/src/typed/env.rei
index daa5c05d50..24c3bb27c0 100644
--- a/compiler/src/typed/env.rei
+++ b/compiler/src/typed/env.rei
@@ -275,6 +275,8 @@ let fold_types:
     'a
   ) =>
   'a;
+let fold_labels:
+  ((label_description, 'a) => 'a, option(Identifier.t), t, 'a) => 'a;
 /** Persistent structures are only traversed if they are already loaded. */
 
 let fold_constructors:
diff --git a/compiler/src/typed/typetexp.re b/compiler/src/typed/typetexp.re
index 9bb65ef4ea..9f41c03653 100644
--- a/compiler/src/typed/typetexp.re
+++ b/compiler/src/typed/typetexp.re
@@ -581,6 +581,7 @@ let fold_values = fold_simple(Env.fold_values);
 let fold_types = fold_simple(Env.fold_types);
 let fold_modules = fold_persistent(Env.fold_modules);
 let fold_constructors = fold_descr(Env.fold_constructors, d => d.cstr_name);
+let fold_labels = fold_descr(Env.fold_labels, l => l.lbl_name);
 let fold_modtypes = fold_simple(Env.fold_modtypes);
 
 let type_attributes = attrs => {
@@ -743,7 +744,10 @@ let report_error = (env, ppf) =>
       fprintf(ppf, "Unbound constructor %a", identifier, lid);
       spellcheck(ppf, fold_constructors, env, lid);
     }
-  | Unbound_label(_)
+  | Unbound_label(lid) => {
+      fprintf(ppf, "Unbound record label %a", identifier, lid);
+      spellcheck(ppf, fold_labels, env, lid);
+    }
   | Unbound_class(_)
   | Unbound_cltype(_) =>
     failwith("Impossible: deprecated error type in typetexp")
diff --git a/compiler/test/suites/records.re b/compiler/test/suites/records.re
index 8821be8f36..21df0d6c20 100644
--- a/compiler/test/suites/records.re
+++ b/compiler/test/suites/records.re
@@ -46,6 +46,11 @@ describe("records", ({test, testSkip}) => {
     "record Rec {foo: Number}; {foo: 4, bar: 4}",
     "Unbound record label bar",
   );
+  assertCompileError(
+    "record_err_3",
+    "let foo = \"\"; foo.charAt(0)",
+    "Unbound record label charAt",
+  );
   assertRun(
     "record_get_1",
     "record Rec {foo: Number}; let bar = {foo: 4}; print(bar.foo)",