Merge pull request #2457 from Zhuoxi2000/fix-haskell-infix-def-name

fix(haskell): name infix-form definitions after the operator

internal/cbm/extract_defs.c

@@ -416,6 +416,33 @@ static TSNode resolve_lean_func_name(TSNode node, TSNode name) {
     return cbm_find_child_by_kind(node, "ident");
 }
 
+// Haskell infix-form definition head (`a <+> b`, ``x `plus` y``): the defined
+// name is the operator, not the left operand that is the head's first child. A
+// backticked `infix_id` yields its inner variable (`plus`); a symbolic `operator`
+// is returned as-is and parenthesised by cbm_func_name_node_text, matching the
+// prefix form `(<+>) a b = ...` (#2440).
+static TSNode resolve_haskell_infix_head_name(TSNode head) {
+    enum { INFIX_MIN_CHILDREN = 3, INFIX_OP_IDX = 1 };
+    TSNode op = ts_node_child_by_field_name(head, TS_FIELD("operator"));
+    if (ts_node_is_null(op) && ts_node_child_count(head) >= INFIX_MIN_CHILDREN) {
+        op = ts_node_child(head, INFIX_OP_IDX);
+    }
+    if (!ts_node_is_null(op)) {
+        const char *ok = ts_node_type(op);
+        if (strcmp(ok, "operator") == 0) {
+            return op;
+        }
+        if (strcmp(ok, "infix_id") == 0) {
+            TSNode v = cbm_find_child_by_kind(op, "variable");
+            if (!ts_node_is_null(v)) {
+                return v;
+            }
+        }
+    }
+    TSNode null_node = {0};
+    return null_node;
+}
+
 // Haskell: resolve function name from first named child (variable/name).
 static TSNode resolve_haskell_func_name(TSNode node) {
     if (ts_node_named_child_count(node) > 0) {
@@ -424,6 +451,9 @@ static TSNode resolve_haskell_func_name(TSNode node) {
         if (strcmp(hk, "variable") == 0 || strcmp(hk, "name") == 0) {
             return head;
         }
+        if (strcmp(hk, "infix") == 0) {
+            return resolve_haskell_infix_head_name(head);
+        }
         if (ts_node_named_child_count(head) > 0) {
             TSNode v = ts_node_named_child(head, 0);
             const char *vk = ts_node_type(v);

internal/cbm/helpers.c

@@ -1213,6 +1213,14 @@ char *cbm_func_name_node_text(CBMArena *a, TSNode name_node, const char *source,
     if (text && lang == CBM_LANG_NIX) {
         cbm_nix_strip_attr_quotes(text);
     }
+    /* Haskell infix-form operator definition: `a <+> b = …` resolves to the bare
+     * `operator` node `<+>`, while the prefix form `(<+>) a b = …` is named by its
+     * `prefix_id` text `(<+>)`. Parenthesise here, not in the resolver, so both
+     * forms mint the same name and the def name and the call-scope QN, which both
+     * route through this function, cannot disagree (#2440). */
+    if (text && lang == CBM_LANG_HASKELL && strcmp(ts_node_type(name_node), "operator") == 0) {
+        return cbm_arena_sprintf(a, "(%s)", text);
+    }
     return text;
 }
 

tests/test_extraction.c

@@ -1777,6 +1777,33 @@ TEST(haskell_function) {
     PASS();
 }
 
+/* #2440: an infix-form definition (`a <+> b = ...`, ``x `plus` y = ...``) has
+ * no `name` field; its first named child is an `infix` node whose first child
+ * is the LEFT OPERAND, so the def was named `a` / `x`. It must be named after
+ * the operator, consistent with the prefix form `(<+>) a b = ...`. */
+TEST(haskell_infix_definition_name) {
+    CBMFileResult *r = extract("module M where\n"
+                               "\n"
+                               "(<+>) :: Int -> Int -> Int\n"
+                               "a <+> b = a + b\n"
+                               "\n"
+                               "plus :: Int -> Int -> Int\n"
+                               "x `plus` y = x + y\n"
+                               "\n"
+                               "f :: Int\n"
+                               "f = 1 <+> 2\n",
+                               CBM_LANG_HASKELL, "t", "M.hs");
+    ASSERT_NOT_NULL(r);
+    ASSERT_FALSE(r->has_error);
+    ASSERT(has_def(r, "Function", "f"));
+    ASSERT(has_def(r, "Function", "plus"));
+    ASSERT(has_def(r, "Function", "(<+>)"));
+    ASSERT_FALSE(has_def(r, "Function", "a"));
+    ASSERT_FALSE(has_def(r, "Function", "x"));
+    cbm_free_result(r);
+    PASS();
+}
+
 /* --- OCaml --- */
 TEST(ocaml_function) {
     CBMFileResult *r =
@@ -13177,6 +13204,7 @@ SUITE(extraction) {
     RUN_TEST(elixir_function);
     RUN_TEST(elixir_call_string_argument);
     RUN_TEST(haskell_function);
+    RUN_TEST(haskell_infix_definition_name);
     RUN_TEST(ocaml_function);
     RUN_TEST(erlang_function);