odoc: fix cmti loader for jkind extraction and return mode elision

A fork of mtelver's day10 project

Fix two bugs in the cmti (typedtree) loader path that were already
fixed in the cmi (Types) loader:

1. Extract jkind annotations from Ttyp_poly binding sites instead of
discarding them. Previously the OxCaml Ttyp_poly handler had
`(fun (s, _) -> (s, None))` which dropped the jkind annotation.
Now extracts Pjk_abbreviation names, matching the cmi path.

2. Suppress return modes on inner arrow types. When the return type
of an arrow is itself an arrow, the return mode is always implied
(a closure capturing a local value is necessarily local). This
matches the elision logic in cmi.cppo.ml and Printtyp.

Add integration test case with Poly quantifier carrying value_or_null
jkind. Update expected output: jkind at binding site only, return
mode elision on inner arrows, @ keyword count updated from 8 to 12.

Co-Authored-By: Claude Opus 4.6 <noreply@anthropic.com>

Jon Ludlam's Agent 1 week ago 18401a94 cff65a2f

+36 -4

3 changed files

expand all

unified split

odoc

src

loader

cmti.cppo.ml

test

integration

oxcaml_modes.t

run.t

test_modes.mli

+16 -3

odoc/src/loader/cmti.cppo.ml

··· 77 77 #if defined OXCAML 78 78 let arg_modes, ret_modes = match Types.get_desc ctyp.ctyp_type with 79 79 | Tarrow((_lbl, marg, mret), _arg, _res, _) -> 80 - (Cmi.extract_arg_modes marg, Cmi.extract_arg_modes mret) 80 + let arg_modes = Cmi.extract_arg_modes marg in 81 + (* Suppress return modes when the return type is itself a function. 82 + A closure capturing a local argument is necessarily local, so 83 + the return mode is always implied. Showing it is redundant. 84 + This matches the elision logic in cmi.cppo.ml and Printtyp. *) 85 + let ret_modes = match Types.get_desc _res with 86 + | Tarrow _ -> [] 87 + | _ -> Cmi.extract_arg_modes mret 88 + in 89 + (arg_modes, ret_modes) 81 90 | _ -> ([], []) 82 91 in 83 92 Arrow(lbl, arg, res, arg_modes, ret_modes) ··· 181 190 | Ttyp_poly([], typ) -> read_core_type env container typ 182 191 #if defined OXCAML 183 192 | Ttyp_poly(vars, typ) -> 184 - (* TODO: presumably want the layouts, eventually *) 185 - Poly(List.map (fun (s, _) -> (s, None)) vars, read_core_type env container typ) 193 + let extract_jkind_annot = function 194 + | Some { Parsetree.pjkind_desc = Pjk_abbreviation name; _ } -> 195 + if name = "value" then None else Some name 196 + | _ -> None 197 + in 198 + Poly(List.map (fun (s, jk) -> (s, extract_jkind_annot jk)) vars, read_core_type env container typ) 186 199 #else 187 200 | Ttyp_poly(vars, typ) -> Poly(List.map (fun s -> (s, None)) vars, read_core_type env container typ) 188 201 #endif

+11 -1

odoc/test/integration/oxcaml_modes.t/run.t

··· 25 25 $ grep 'keyword.*@.*local' html/test/Test_modes/index.html | grep -v 'string' | sed 's/ *$//' 26 26 @ local 27 27 int @ local 28 + @ local 29 + @ local 30 + @ local 31 + @ local 28 32 29 33 Value modalities with @@ syntax: 30 34 ··· 37 41 $ grep 'val-normal_fun' html/test/Test_modes/index.html | head -1 38 42 <div class="spec value anchored" id="val-normal_fun"> 39 43 $ grep -c 'keyword.*@' html/test/Test_modes/index.html 40 - 8 44 + 12 41 45 42 46 Type parameter jkinds: 43 47 ··· 45 49 ('a : float64) float_box 46 50 $ grep 'immediate' html/test/Test_modes/index.html 47 51 ('a : immediate) imm_box 52 + 53 + Polymorphic with jkind at quantifier (value_or_null at binding site only): 54 + 55 + $ grep 'value_or_null' html/test/Test_modes/index.html | sed 's/ *$//' 56 + ('a : value_or_null) box 57 + ('a : value_or_null).

odoc/test/integration/oxcaml_modes.t/test_modes.mli

··· 29 29 type ('a : float64) float_box 30 30 31 31 type ('a : immediate) imm_box 32 + 33 + (** {1 Polymorphic with jkind quantifier} *) 34 + 35 + type ('a : value_or_null) box 36 + 37 + val local_compare : 38 + ('a : value_or_null). 39 + ('a @ local -> 'a @ local -> int) -> 40 + 'a box @ local -> 'a box @ local -> int