Skip to content

Commit edd8ff3

Browse files
committed
implement [let]-bound function support
Signed-off-by: David Vulakh <[email protected]>
1 parent a98a38a commit edd8ff3

File tree

2 files changed

+21
-8
lines changed

2 files changed

+21
-8
lines changed

src/analysis/stack_or_heap_enclosing.ml

Lines changed: 17 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -11,7 +11,11 @@ type stack_or_heap =
1111
type stack_or_heap_enclosings = (Location.t * stack_or_heap) list
1212

1313
let from_nodes ~pos ~path =
14-
let aux (_env, node, _tail) =
14+
let[@tail_mod_cons] rec tails = function
15+
| hd :: tl -> (hd, tl) :: tails tl
16+
| [] -> []
17+
in
18+
let aux node parent =
1519
let open Browse_raw in
1620
let ret mode_result = Some (Mbrowse.node_loc node, mode_result) in
1721
let ret_alloc alloc_mode = ret (Alloc_mode alloc_mode) in
@@ -20,8 +24,13 @@ let from_nodes ~pos ~path =
2024
| Some alloc_mode -> ret_alloc alloc_mode
2125
| None -> ret_no_alloc reason
2226
in
23-
match node with
24-
| Expression { exp_desc; _ } -> (
27+
match (node, parent) with
28+
| ( Pattern { pat_desc = Tpat_var _; _ },
29+
Some
30+
(Value_binding
31+
{ vb_expr = { exp_desc = Texp_function { alloc_mode; _ }; _ }; _ })
32+
) -> ret (Alloc_mode alloc_mode.mode)
33+
| Expression { exp_desc; _ }, _ -> (
2534
match exp_desc with
2635
| Texp_function { alloc_mode; body; _ } ->
2736
let body_loc =
@@ -90,4 +99,8 @@ let from_nodes ~pos ~path =
9099
| _ -> None)
91100
| _ -> None
92101
in
93-
List.filter_map ~f:aux path
102+
path
103+
|> List.map ~f:(fun (_, node, _) -> node)
104+
|> tails
105+
|> List.filter_map ~f:(fun (node, ancestors) ->
106+
aux node (List.nth_opt ancestors 0))

tests/test-dirs/stack-or-heap.t/run.t

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -407,31 +407,31 @@ escape characters in string literals, so we use the revert-newlines script.
407407
|let f g x y =
408408
| ^
409409

410-
"no relevant allocation to show"
410+
"heap"
411411

412412
|and h g x y =
413413
| ^
414414

415415
|and h g x y =
416416
| ^
417417

418-
"no relevant allocation to show"
418+
"heap"
419419

420420
| let f g x y =
421421
| ^
422422

423423
| let f g x y =
424424
| ^
425425

426-
"no relevant allocation to show"
426+
"stack"
427427

428428
| and h g x y =
429429
| ^
430430

431431
| and h g x y =
432432
| ^
433433

434-
"no relevant allocation to show"
434+
"stack"
435435

436436
|let x = Some 5
437437
| ^

0 commit comments

Comments
 (0)