promote

src/README.md

@@ -576,9 +576,12 @@ let reachable_words v =
         let fields_size =
           if Tag.should_be_scanned tag then begin
             let fields_size = ref 0 in
-            for i = 0 to size - 1 do
+            let start = match tag with
+            | Closure -> 2
+            | _ -> 0
+            in
+            for i = start to size - 1 do
               let field = Obj.field (Obj.repr v) i in
-              (* if Obj.is_block field then decr fields_size; *)
               fields_size := !fields_size + aux field
             done;
             !fields_size
@@ -626,41 +629,98 @@ type 'a tree =
   | Leaf
   | Node of 'a * 'a tree * 'a tree
 
+type cycle = {
+  mutable next : cycle;
+  v : int;
+}
+
 let () =
 
   let l = List.init 10 (fun n -> n) in
 
   let t1 = Node (l, Leaf, Leaf) in
+  print_info "t1" t1;
   let t2 = Node (l, t1, t1) in
   let t3 = Node (l, t2, t2) in
 
   let rw_l = reachable_words l in
+  Format.eprintf "rw_l = %d@." rw_l;
   let rw_t1 = reachable_words t1 in
   let rw_t2 = reachable_words t2 in
   let rw_t3 = reachable_words t3 in
 
-  let assert_rw s rw_me v =
-    let rw_obj = Obj.reachable_words (Obj.repr l) in
+  let assert_rw s v =
+    let rw_me = reachable_words v in
+    Format.printf "reachable_words(%s) = %d@." s rw_me;
+    let rw_obj = Obj.reachable_words (Obj.repr v) in
     if not @@ Int.equal rw_me rw_obj then begin
-      Format.eprintf "for %s, I computed %d but Obj says it's %d" s rw_me rw_obj;
+      Format.eprintf "for %s, I computed %d but Obj says it's %d@." s rw_me rw_obj;
       exit 1
     end
     else ()
   in
 
-  assert_rw "l" rw_l l;
-  assert_rw "t1" rw_t1 t1;
-  assert_rw "t2" rw_t2 t2;
-  assert_rw "t3" rw_t3 t3;
+  assert_rw "l" l;
+  assert_rw "t1" t1;
+  assert_rw "t2" t2;
+  assert_rw "t3" t3;
+
+  let rec c = {
+    next = c;
+    v = 42;
+  } in
+
+  assert_rw "cycle" c;
+
+  let f x = c.v + x in
+
+  let z = 434 in
+
+  let _f x = x + z in
 
-  Format.printf "reachable_words(l) = %d@." (rw_l);
-  Format.printf "reachable_words(t1) = %d@." (rw_t1);
-  Format.printf "reachable_words(t2) = %d@." (rw_t2);
-  Format.printf "reachable_words(t3) = %d@." (rw_t3)
+  let rec f x =
+    1 + g x * c.v
+  and g x =
+    2 + f x + c.v
+  in
+
+  let f = "fseljfseljflksej fkeljslfj " in
+
+  let f = [|1. ; 2.3 ; 4.5432 |] in
+
+  assert_rw "fun" f
 ```
 
 ```sh
 $ ocamlopt unsafe.ml
+File "unsafe.ml", line 203, characters 6-11:
+203 |   let rw_t1 = reachable_words t1 in
+            ^^^^^
+Warning 26 [unused-var]: unused variable rw_t1.
+File "unsafe.ml", line 204, characters 6-11:
+204 |   let rw_t2 = reachable_words t2 in
+            ^^^^^
+Warning 26 [unused-var]: unused variable rw_t2.
+File "unsafe.ml", line 205, characters 6-11:
+205 |   let rw_t3 = reachable_words t3 in
+            ^^^^^
+Warning 26 [unused-var]: unused variable rw_t3.
+File "unsafe.ml", line 230, characters 6-7:
+230 |   let f x = c.v + x in
+            ^
+Warning 26 [unused-var]: unused variable f.
+File "unsafe.ml", line 236, characters 10-11:
+236 |   let rec f x =
+                ^
+Warning 26 [unused-var]: unused variable f.
+File "unsafe.ml", line 238, characters 6-7:
+238 |   and g x =
+            ^
+Warning 26 [unused-var]: unused variable g.
+File "unsafe.ml", line 242, characters 6-7:
+242 |   let f = "fseljfseljflksej fkeljslfj " in
+            ^
+Warning 26 [unused-var]: unused variable f.
 $ ./a.out
 testing `()`
 it's an int !
@@ -734,7 +794,7 @@ it's stored as 1 !
 
 testing `(E 51)`
 it's a block !
-it's pointing to 0x2aaaaab0b9dc !
+it's pointing to 0x2aaaaab0b9f8 !
 it has tag 0 (0) !
 it has size 1 !
 
@@ -745,19 +805,19 @@ it's stored as 103 !
 
 testing `(F 8.6)`
 it's a block !
-it's pointing to 0x2aaaaab0b9c4 !
+it's pointing to 0x2aaaaab0b9e0 !
 it has tag 1 (1) !
 it has size 1 !
 
 testing `field 0 of (F 8.6)`
 it's a block !
-it's pointing to 0x2aaaaab0b9cc !
+it's pointing to 0x2aaaaab0b9e8 !
 it has tag double (253) !
 it has size 1 !
 
 testing `[1; 2; 3]`
 it's a block !
-it's pointing to 0x2aaaaab0b98c !
+it's pointing to 0x2aaaaab0b9a8 !
 it has tag 0 (0) !
 it has size 2 !
 
@@ -768,7 +828,7 @@ it's stored as 3 !
 
 testing `field 1 of [1; 2; 3]`
 it's a block !
-it's pointing to 0x2aaaaab0b998 !
+it's pointing to 0x2aaaaab0b9b4 !
 it has tag 0 (0) !
 it has size 2 !
 
@@ -779,7 +839,7 @@ it's stored as 5 !
 
 testing `field 1 of field 1 of [1; 2; 3]`
 it's a block !
-it's pointing to 0x2aaaaab0b9a4 !
+it's pointing to 0x2aaaaab0b9c0 !
 it has tag 0 (0) !
 it has size 2 !
 
@@ -795,13 +855,13 @@ it's stored as 1 !
 
 testing `"coucou"`
 it's a block !
-it's pointing to 0x2aaaaab0b978 !
+it's pointing to 0x2aaaaab0b994 !
 it has tag string (252) !
 it has size 1 !
 
 testing `(`Sava "ui&twa")`
 it's a block !
-it's pointing to 0x2aaaaab0b954 !
+it's pointing to 0x2aaaaab0b970 !
 it has tag 0 (0) !
 it has size 2 !
 
@@ -812,13 +872,13 @@ it's stored as 1850568371 !
 
 testing `field 1 of (`Sava "ui&twa")`
 it's a block !
-it's pointing to 0x2aaaaab0b960 !
+it's pointing to 0x2aaaaab0b97c !
 it has tag string (252) !
 it has size 1 !
 
 testing `(5, 1)`
 it's a block !
-it's pointing to 0x2aaaaab0b940 !
+it's pointing to 0x2aaaaab0b95c !
 it has tag 0 (0) !
 it has size 2 !
 
@@ -834,7 +894,7 @@ it's stored as 3 !
 
 testing `{ x = 1685 }`
 it's a block !
-it's pointing to 0x2aaaaab0bf7c !
+it's pointing to 0x2aaaaab0bf58 !
 it has tag 0 (0) !
 it has size 1 !
 
@@ -902,7 +962,7 @@ it has size 2 !
 
 testing `field 0 of (fun x -> print_info "x" x)`
 it's a block !
-it's pointing to 0x2aaaaaad0b18 !
+it's pointing to 0x2aaaaaad0b28 !
 it has tag out of heap (1001) !
 it has size 8537321242624 !
 
@@ -911,8 +971,144 @@ it's an int !
 it's 36028797018963970 !
 it's stored as 72057594037927941 !
 
-for t1, I computed 34 but Obj says it's 30
-[1]
+testing `t1`
+it's a block !
+it's pointing to 0x3ffffbe13910 !
+it has tag 0 (0) !
+it has size 3 !
+
+testing `field 0 of t1`
+it's a block !
+it's pointing to 0x3ffffbe13920 !
+it has tag 0 (0) !
+it has size 2 !
+
+testing `field 0 of field 0 of t1`
+it's an int !
+it's 0 !
+it's stored as 1 !
+
+testing `field 1 of field 0 of t1`
+it's a block !
+it's pointing to 0x3ffffbe1392c !
+it has tag 0 (0) !
+it has size 2 !
+
+testing `field 0 of field 1 of field 0 of t1`
+it's an int !
+it's 1 !
+it's stored as 3 !
+
+testing `field 1 of field 1 of field 0 of t1`
+it's a block !
+it's pointing to 0x3ffffbe13938 !
+it has tag 0 (0) !
+it has size 2 !
+
+testing `field 0 of field 1 of field 1 of field 0 of t1`
+it's an int !
+it's 2 !
+it's stored as 5 !
+
+testing `field 1 of field 1 of field 1 of field 0 of t1`
+it's a block !
+it's pointing to 0x3ffffbe13944 !
+it has tag 0 (0) !
+it has size 2 !
+
+testing `field 0 of field 1 of field 1 of field 1 of field 0 of t1`
+it's an int !
+it's 3 !
+it's stored as 7 !
+
+testing `field 1 of field 1 of field 1 of field 1 of field 0 of t1`
+it's a block !
+it's pointing to 0x3ffffbe13950 !
+it has tag 0 (0) !
+it has size 2 !
+
+testing `field 0 of field 1 of field 1 of field 1 of field 1 of field 0 of t1`
+it's an int !
+it's 4 !
+it's stored as 9 !
+
+testing `field 1 of field 1 of field 1 of field 1 of field 1 of field 0 of t1`
+it's a block !
+it's pointing to 0x3ffffbe1395c !
+it has tag 0 (0) !
+it has size 2 !
+
+testing `field 0 of field 1 of field 1 of field 1 of field 1 of field 1 of field 0 of t1`
+it's an int !
+it's 5 !
+it's stored as 11 !
+
+testing `field 1 of field 1 of field 1 of field 1 of field 1 of field 1 of field 0 of t1`
+it's a block !
+it's pointing to 0x3ffffbe13968 !
+it has tag 0 (0) !
+it has size 2 !
+
+testing `field 0 of field 1 of field 1 of field 1 of field 1 of field 1 of field 1 of field 0 of t1`
+it's an int !
+it's 6 !
+it's stored as 13 !
+
+testing `field 1 of field 1 of field 1 of field 1 of field 1 of field 1 of field 1 of field 0 of t1`
+it's a block !
+it's pointing to 0x3ffffbe13974 !
+it has tag 0 (0) !
+it has size 2 !
+
+testing `field 0 of field 1 of field 1 of field 1 of field 1 of field 1 of field 1 of field 1 of field 0 of t1`
+it's an int !
+it's 7 !
+it's stored as 15 !
+
+testing `field 1 of field 1 of field 1 of field 1 of field 1 of field 1 of field 1 of field 1 of field 0 of t1`
+it's a block !
+it's pointing to 0x3ffffbe13980 !
+it has tag 0 (0) !
+it has size 2 !
+
+testing `field 0 of field 1 of field 1 of field 1 of field 1 of field 1 of field 1 of field 1 of field 1 of field 0 of t1`
+it's an int !
+it's 8 !
+it's stored as 17 !
+
+testing `field 1 of field 1 of field 1 of field 1 of field 1 of field 1 of field 1 of field 1 of field 1 of field 0 of t1`
+it's a block !
+it's pointing to 0x3ffffbe1398c !
+it has tag 0 (0) !
+it has size 2 !
+
+testing `field 0 of field 1 of field 1 of field 1 of field 1 of field 1 of field 1 of field 1 of field 1 of field 1 of field 0 of t1`
+it's an int !
+it's 9 !
+it's stored as 19 !
+
+testing `field 1 of field 1 of field 1 of field 1 of field 1 of field 1 of field 1 of field 1 of field 1 of field 1 of field 0 of t1`
+it's an int !
+it's 0 !
+it's stored as 1 !
+
+testing `field 1 of t1`
+it's an int !
+it's 0 !
+it's stored as 1 !
+
+testing `field 2 of t1`
+it's an int !
+it's 0 !
+it's stored as 1 !
+
+rw_l = 30
+reachable_words(l) = 30
+reachable_words(t1) = 34
+reachable_words(t2) = 38
+reachable_words(t3) = 42
+reachable_words(cycle) = 3
+reachable_words(fun) = 4
 ```
 
 ### MDX test