diff --git a/internal/cbm/extract_defs.c b/internal/cbm/extract_defs.c index ddad886af..55596732d 100644 --- a/internal/cbm/extract_defs.c +++ b/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); diff --git a/internal/cbm/helpers.c b/internal/cbm/helpers.c index 0a770804f..9e310bc6c 100644 --- a/internal/cbm/helpers.c +++ b/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; } diff --git a/tests/test_extraction.c b/tests/test_extraction.c index 7bfda63fc..e1c1e4491 100644 --- a/tests/test_extraction.c +++ b/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);