@@ -1274,6 +1274,10 @@ let typestate_verify_visitor
1274
1274
Walk. visit_block_pre = visit_block_pre }
1275
1275
;;
1276
1276
1277
+ type slots_stack = node_id Stack .t ;;
1278
+ type block_slots_stack = slots_stack Stack .t ;;
1279
+ type frame_block_slots_stack = block_slots_stack Stack .t ;;
1280
+
1277
1281
let lifecycle_visitor
1278
1282
(cx :ctxt )
1279
1283
(tables_stack :typestate_tables Stack.t )
@@ -1291,14 +1295,14 @@ let lifecycle_visitor
1291
1295
let tables _ = Stack. top tables_stack in
1292
1296
1293
1297
let (live_block_slots:(node_id, unit) Hashtbl. t ) = Hashtbl. create 0 in
1294
- let (block_slots:(node_id Stack.t) Stack. t ) = Stack. create () in
1298
+ let (frame_blocks: frame_block_slots_stack ) = Stack. create () in
1295
1299
1296
1300
let (implicit_init_block_slots:(node_id,node_id) Hashtbl. t ) =
1297
1301
Hashtbl. create 0
1298
1302
in
1299
1303
1300
1304
let push_slot sl =
1301
- Stack. push sl (Stack. top block_slots )
1305
+ Stack. push sl (Stack. top ( Stack. top frame_blocks) )
1302
1306
in
1303
1307
1304
1308
let mark_slot_live sl =
@@ -1307,7 +1311,7 @@ let lifecycle_visitor
1307
1311
1308
1312
1309
1313
let visit_block_pre b =
1310
- Stack. push (Stack. create() ) block_slots ;
1314
+ Stack. push (Stack. create() ) ( Stack. top frame_blocks) ;
1311
1315
begin
1312
1316
match htab_search implicit_init_block_slots b.id with
1313
1317
None -> ()
@@ -1335,7 +1339,7 @@ let lifecycle_visitor
1335
1339
1336
1340
let visit_block_post b =
1337
1341
inner.Walk. visit_block_post b;
1338
- let blk_slots = Stack. pop block_slots in
1342
+ let block_slots = Stack. pop ( Stack. top frame_blocks) in
1339
1343
let stmts = b.node in
1340
1344
let len = Array. length stmts in
1341
1345
if len > 0
@@ -1355,7 +1359,7 @@ let lifecycle_visitor
1355
1359
* slots that actually got initialized (went live) at some
1356
1360
* point in the block.
1357
1361
*)
1358
- let slots = stk_elts_from_top blk_slots in
1362
+ let slots = stk_elts_from_top block_slots in
1359
1363
let live =
1360
1364
List. filter
1361
1365
(fun i -> Hashtbl. mem live_block_slots i)
@@ -1443,8 +1447,8 @@ let lifecycle_visitor
1443
1447
match s.node with
1444
1448
Ast. STMT_ret _
1445
1449
| Ast. STMT_be _ ->
1446
- let stks = stk_elts_from_top block_slots in
1447
- let slots = List. concat (List. map stk_elts_from_top stks ) in
1450
+ let blocks = stk_elts_from_top ( Stack. top frame_blocks) in
1451
+ let slots = List. concat (List. map stk_elts_from_top blocks ) in
1448
1452
let live =
1449
1453
List. filter
1450
1454
(fun i -> Hashtbl. mem live_block_slots i)
@@ -1454,11 +1458,57 @@ let lifecycle_visitor
1454
1458
| _ -> ()
1455
1459
in
1456
1460
1461
+ let enter_frame _ =
1462
+ Stack. push (Stack. create() ) frame_blocks
1463
+ in
1464
+
1465
+ let leave_frame _ =
1466
+ ignore (Stack. pop frame_blocks)
1467
+ in
1468
+
1469
+ let visit_mod_item_pre n p i =
1470
+ enter_frame() ;
1471
+ inner.Walk. visit_mod_item_pre n p i
1472
+ in
1473
+
1474
+ let visit_mod_item_post n p i =
1475
+ inner.Walk. visit_mod_item_post n p i;
1476
+ leave_frame()
1477
+ in
1478
+
1479
+ let visit_obj_fn_pre obj ident fn =
1480
+ enter_frame() ;
1481
+ inner.Walk. visit_obj_fn_pre obj ident fn
1482
+ in
1483
+
1484
+ let visit_obj_fn_post obj ident fn =
1485
+ inner.Walk. visit_obj_fn_post obj ident fn;
1486
+ leave_frame()
1487
+ in
1488
+
1489
+ let visit_obj_drop_pre obj b =
1490
+ enter_frame() ;
1491
+ inner.Walk. visit_obj_drop_pre obj b
1492
+ in
1493
+
1494
+ let visit_obj_drop_post obj b =
1495
+ inner.Walk. visit_obj_drop_post obj b;
1496
+ leave_frame()
1497
+ in
1498
+
1457
1499
{ inner with
1458
1500
Walk. visit_block_pre = visit_block_pre;
1459
1501
Walk. visit_block_post = visit_block_post;
1460
1502
Walk. visit_stmt_pre = visit_stmt_pre;
1461
- Walk. visit_stmt_post = visit_stmt_post
1503
+ Walk. visit_stmt_post = visit_stmt_post;
1504
+
1505
+ Walk. visit_mod_item_pre = visit_mod_item_pre;
1506
+ Walk. visit_mod_item_post = visit_mod_item_post;
1507
+ Walk. visit_obj_fn_pre = visit_obj_fn_pre;
1508
+ Walk. visit_obj_fn_post = visit_obj_fn_post;
1509
+ Walk. visit_obj_drop_pre = visit_obj_drop_pre;
1510
+ Walk. visit_obj_drop_post = visit_obj_drop_post;
1511
+
1462
1512
}
1463
1513
;;
1464
1514
0 commit comments