blob: aa3f3e28a45e8d5fb2fc2b211c01355e7b1b2c4a (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
|
(* TEST *)
(***
This test evaluate boolean formula composed by conjunction and
disjunction using ephemeron:
- true == alive, false == garbage collected
- and == an n-ephemeron, or == many 1-ephemeron
*)
let nb_test = 4
let max_level = 10
(** probability that a branch is not linked to a previous one *)
let proba_no_shared = 0.2
let arity_max = 4
let proba_new = proba_no_shared ** (1./.(float_of_int max_level))
open Format
open Ephemeron
let is_true test s b = printf "%s %s: %s\n" test s (if b then "OK" else "FAIL")
let is_false test s b = is_true test s (not b)
type varephe = int ref
type ephe = (varephe,varephe) Kn.t
type formula =
| Constant of bool
| And of var array
| Or of var array
and var = {
form: formula;
value: bool;
ephe: varephe Weak.t;
}
let print_short_bool fmt b =
if b
then pp_print_string fmt "t"
else pp_print_string fmt "f"
let rec pp_form fmt = function
| Constant b ->
fprintf fmt "%B" b
| And a ->
fprintf fmt "And[@[%a@]]" (fun fmt -> Array.iter (pp_var fmt)) a
| Or a ->
fprintf fmt "Or[@[%a@]]" (fun fmt -> Array.iter (pp_var fmt)) a
and pp_var fmt v =
fprintf fmt "%a%a:%a;@ "
print_short_bool v.value
print_short_bool (Weak.check v.ephe 0)
pp_form v.form
type env = {
(** resizable array for cheap *)
vars : (int,var) Hashtbl.t;
(** the ephemerons must be alive *)
ephes : ephe Stack.t;
(** keep alive the true constant *)
varephe_true : varephe Stack.t;
(** keep temporarily alive the false constant *)
varephe_false : varephe Stack.t;
}
let new_env () = {
vars = Hashtbl.create 100;
ephes = Stack.create ();
varephe_true = Stack.create ();
varephe_false = Stack.create ();
}
let evaluate = function
| Constant b -> b
| And a -> Array.fold_left (fun acc e -> acc && e.value) true a
| Or a -> Array.fold_left (fun acc e -> acc || e.value) false a
let get_ephe v =
match Weak.get v.ephe 0 with
| None ->
invalid_arg "Error: weak dead but nothing have been released"
| Some r -> r
(** create a variable and its definition in the boolean world and
ephemerons world *)
let rec create env rem_level (** remaining level *) =
let varephe = ref 1 in
let form =
if rem_level = 0 then (** Constant *)
if Random.bool ()
then (Stack.push varephe env.varephe_true ; Constant true )
else (Stack.push varephe env.varephe_false; Constant false)
else
let size = (Random.int (arity_max - 1)) + 2 in
let new_link _ =
if (Hashtbl.length env.vars) = 0 || Random.float 1. < proba_new
then create env (rem_level -1)
else Hashtbl.find env.vars (Random.int (Hashtbl.length env.vars))
in
let args = Array.init size new_link in
if Random.bool ()
then begin (** Or *)
Array.iter (fun v ->
let r = get_ephe v in
let e = Kn.make [| r |] varephe in
Stack.push e env.ephes
) args; Or args
end
else begin (** And *)
let e = Kn.make (Array.map get_ephe args) varephe in
Stack.push e env.ephes;
And args
end
in
let create_weak e =
let w = Weak.create 1 in
Weak.set w 0 (Some e);
w
in
let v = {form; value = evaluate form;
ephe = create_weak varephe;
} in
Hashtbl.add env.vars (Hashtbl.length env.vars) v;
v
let check_var v = v.value = Weak.check v.ephe 0
let run test init =
Random.init init;
let env = new_env () in
let _top = create env max_level in
(** release false ref *)
Stack.clear env.varephe_false;
Gc.full_major ();
let res = Hashtbl.fold (fun _ v acc -> acc && check_var v) env.vars true in
is_true test "check" res;
env (* Keep env.varephe_true alive. *)
let () =
for i = 0 to nb_test do
ignore (run ("test"^(Int.to_string i)) i);
done
|
