Skip to content

Commit 76ee6a9

Browse files
cknittclaude
cknitt
and
claude
committed
Register an inline functor's parameters before applying it
Codex review on #9084: an immediately applied inline functor was no longer walked, so its parameters and declarations were missing and `O.compare` in its body had no definition. The functor is walked again before its application. The results of curried applications now take the body's identifiers from the functor applied first, as the compiler had already renamed those of the inner application. Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com> Claude-Session: https://claude.ai/code/session_01Kbf3gGkPma9LAZimuQjnrP Claude-Session: https://claude.ai/code/session_01Kr4cjoUi2f5VpMvE6wT9bo Signed-off-by: Christoph Knittel <ck@cca.io>
1 parent d7d3c96 commit 76ee6a9

3 files changed

Lines changed: 198 additions & 10 deletions

File tree

‎analysis/src/process_cmt.ml‎

Lines changed: 20 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -248,6 +248,21 @@ let rec record_renamed_stamps table (original : Types.module_type)
248248
record_renamed_stamps table result renamed_result
249249
| _ -> ()
250250

251+
(* The type of an applied functor with the identifiers of the body's
252+
declarations. The functor's result signature has them; an application's
253+
has them only when the argument is not a path, else the compiler already
254+
renamed them, so the results of curried applications are taken from the
255+
functor applied first. *)
256+
let rec body_type (mod_expr : Typedtree.module_expr) =
257+
match mod_expr.mod_desc with
258+
| Tmod_apply (functor_, _arg, _coercion) -> (
259+
match body_type functor_ with
260+
| Types.Mty_functor (_, _, result) -> result
261+
| mty -> mty)
262+
| Tmod_ident _ | Tmod_structure _ | Tmod_functor _ | Tmod_constraint _
263+
| Tmod_unpack _ ->
264+
mod_expr.mod_type
265+
251266
let get_module_type_path mod_desc =
252267
match mod_desc with
253268
| Typedtree.Tmty_ident (path, _) | Tmty_alias (path, _) -> Some path
@@ -734,7 +749,10 @@ and for_module ~env (mod_expr : Typedtree.module_expr) module_name =
734749
body, whose stamps are already taken, so they are renamed first,
735750
with stamps above any that a compilation hands out. Their locations
736751
are in the functor's body, so they are marked as coming from the
737-
functor, like included items, for definitions to find its file. *)
752+
functor, like included items, for definitions to find its file.
753+
An inline functor's parameters and declarations are registered
754+
first, for uses inside its body to resolve. *)
755+
ignore (for_module ~env functor_ module_name);
738756
let env = env |> Env.add_module ~name:module_name in
739757
let env =
740758
match get_module_path functor_.mod_desc with
@@ -745,15 +763,7 @@ and for_module ~env (mod_expr : Typedtree.module_expr) module_name =
745763
if Ident.current_time () < renamed_stamp_floor then
746764
Ident.set_current_time renamed_stamp_floor;
747765
let renamed = Subst.modtype Subst.identity mod_expr.mod_type in
748-
(* The functor's result signature has the identifiers of the body's
749-
declarations; the application's has them only when the argument is
750-
not a path, else the compiler already renamed them. *)
751-
let functor_result =
752-
match functor_.mod_type with
753-
| Mty_functor (_, _, result) -> result
754-
| mty -> mty
755-
in
756-
record_renamed_stamps env.renamed_stamps functor_result renamed;
766+
record_renamed_stamps env.renamed_stamps (body_type mod_expr) renamed;
757767
for_type_module ~name:module_name ~env renamed
758768
| Tmod_unpack (_expr, module_type) ->
759769
let env = env |> Env.add_module ~name:module_name in

‎tests/analysis_tests/tests/src/AppliedFunctorShapes.res‎

Lines changed: 64 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,64 @@
1+
module type Ord = {
2+
type t
3+
let compare: (t, t) => int
4+
}
5+
6+
module IntOrd = {
7+
type t = int
8+
let compare = (a: int, b) => a - b
9+
}
10+
11+
module Inline = ((O: Ord) => {
12+
let cmp = O.compare
13+
// ^def
14+
let one = 1
15+
})(IntOrd)
16+
17+
let one = Inline.one
18+
// ^def
19+
20+
module InlineCurried = ((A: Ord, B: Ord) => {
21+
let both = (A.compare, B.compare)
22+
// ^hov
23+
})(IntOrd, IntOrd)
24+
25+
let both = InlineCurried.both
26+
// ^ref
27+
28+
module Generative = (() => {
29+
let fresh = 1
30+
})()
31+
32+
let fresh = Generative.fresh
33+
// ^def
34+
35+
module MakeTwo = (A: Ord, B: Ord) => {
36+
let pair = (A.compare, B.compare)
37+
}
38+
39+
module Two = MakeTwo(IntOrd, IntOrd)
40+
41+
let pair = Two.pair
42+
// ^ref
43+
44+
module Constrained = ((O: Ord) => {
45+
let c = O.compare
46+
// ^def
47+
}: (O: Ord) => {
48+
let c: (O.t, O.t) => int
49+
})(IntOrd)
50+
51+
let c = Constrained.c
52+
// ^def
53+
54+
module ToIdent = (O: Ord) => IntOrd
55+
56+
module Ident = ToIdent(IntOrd)
57+
58+
let ic = Ident.compare
59+
// ^def
60+
61+
module Nest = MakeTwo(ToIdent(IntOrd), IntOrd)
62+
63+
let np = Nest.pair
64+
// ^def

‎tests/analysis_tests/tests/src/expected/AppliedFunctorShapes.res.txt‎

Lines changed: 114 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,114 @@
1+
Definition src/AppliedFunctorShapes.res 11:14
2+
{
3+
"range": {
4+
"end": { "character": 28, "line": 2 },
5+
"start": { "character": 2, "line": 2 }
6+
},
7+
"uri": "file:///AppliedFunctorShapes.res"
8+
}
9+
10+
Definition src/AppliedFunctorShapes.res 16:17
11+
{
12+
"range": {
13+
"end": { "character": 9, "line": 13 },
14+
"start": { "character": 6, "line": 13 }
15+
},
16+
"uri": "file:///AppliedFunctorShapes.res"
17+
}
18+
19+
Hover src/AppliedFunctorShapes.res 20:27
20+
{
21+
"contents": {
22+
"kind": "markdown",
23+
"value": "```rescript\n(B.t, B.t) => int\n```\n\n---\n\n```\n \n```\n```rescript\ntype B.t\n```\nGo to: [Type definition](AppliedFunctorShapes.res#L2,3)\n"
24+
}
25+
}
26+
27+
References src/AppliedFunctorShapes.res 24:25
28+
[
29+
{
30+
"range": {
31+
"end": { "character": 10, "line": 20 },
32+
"start": { "character": 6, "line": 20 }
33+
},
34+
"uri": "file:///AppliedFunctorShapes.res"
35+
},
36+
{
37+
"range": {
38+
"end": { "character": 29, "line": 24 },
39+
"start": { "character": 25, "line": 24 }
40+
},
41+
"uri": "file:///AppliedFunctorShapes.res"
42+
}
43+
]
44+
45+
Definition src/AppliedFunctorShapes.res 31:23
46+
{
47+
"range": {
48+
"end": { "character": 11, "line": 28 },
49+
"start": { "character": 6, "line": 28 }
50+
},
51+
"uri": "file:///AppliedFunctorShapes.res"
52+
}
53+
54+
References src/AppliedFunctorShapes.res 40:15
55+
[
56+
{
57+
"range": {
58+
"end": { "character": 10, "line": 35 },
59+
"start": { "character": 6, "line": 35 }
60+
},
61+
"uri": "file:///AppliedFunctorShapes.res"
62+
},
63+
{
64+
"range": {
65+
"end": { "character": 19, "line": 40 },
66+
"start": { "character": 15, "line": 40 }
67+
},
68+
"uri": "file:///AppliedFunctorShapes.res"
69+
},
70+
{
71+
"range": {
72+
"end": { "character": 18, "line": 62 },
73+
"start": { "character": 14, "line": 62 }
74+
},
75+
"uri": "file:///AppliedFunctorShapes.res"
76+
}
77+
]
78+
79+
Definition src/AppliedFunctorShapes.res 44:12
80+
{
81+
"range": {
82+
"end": { "character": 28, "line": 2 },
83+
"start": { "character": 2, "line": 2 }
84+
},
85+
"uri": "file:///AppliedFunctorShapes.res"
86+
}
87+
88+
Definition src/AppliedFunctorShapes.res 50:20
89+
{
90+
"range": {
91+
"end": { "character": 26, "line": 47 },
92+
"start": { "character": 2, "line": 47 }
93+
},
94+
"uri": "file:///AppliedFunctorShapes.res"
95+
}
96+
97+
Definition src/AppliedFunctorShapes.res 57:15
98+
{
99+
"range": {
100+
"end": { "character": 13, "line": 7 },
101+
"start": { "character": 6, "line": 7 }
102+
},
103+
"uri": "file:///AppliedFunctorShapes.res"
104+
}
105+
106+
Definition src/AppliedFunctorShapes.res 62:14
107+
{
108+
"range": {
109+
"end": { "character": 10, "line": 35 },
110+
"start": { "character": 6, "line": 35 }
111+
},
112+
"uri": "file:///AppliedFunctorShapes.res"
113+
}
114+

0 commit comments

Comments
 (0)